File : bc-graphs-undirected.adb
-- Copyright (C) 1994-1999 Grady Booch and Simon Wright.
-- All Rights Reserved.
--
-- This program is free software; you can redistribute it
-- and/or modify it under the terms of the Ada Community
-- License which comes with this Library.
--
-- This program is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-- PURPOSE. See the Ada Community License for more details.
-- You should have received a copy of the Ada Community
-- License with this library, in the file named "Ada Community
-- License" or "ACL". If not, contact the author of this library
-- for a copy.
--
-- $Id: bc-graphs-undirected.adb,v 1.5 1999/04/10 14:38:20 simon Exp $
with BC.Support.Exceptions;
with System.Address_To_Access_Conversions;
package body BC.Graphs.Undirected is
package BSE renames BC.Support.Exceptions;
procedure Assert
is new BSE.Assert ("BC.Graphs.Undirected");
---------------------------------
-- Undirected_Graph operations --
---------------------------------
procedure Create_Arc (G : in out Undirected_Graph;
A : in out Undirected_Arc'Class;
I : Arc_Item;
First : in out Undirected_Vertex'Class;
Second : in out Undirected_Vertex'Class) is
begin
Clear (A);
A.Rep := new Arc_Node'(Ada.Finalization.Controlled with
Item => I,
Enclosing => G'Unchecked_Access,
From => First.Rep,
To => Second.Rep,
Next_Incoming => null,
Next_Outgoing => null,
Count => 1);
if Second.Rep /= null then
A.Rep.Next_Incoming := Second.Rep.Incoming;
Second.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
Second.Rep.Count := Second.Rep.Count + 1;
end if;
if First.Rep /= null then
A.Rep.Next_Outgoing := First.Rep.Outgoing;
First.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
First.Rep.Count := First.Rep.Count + 1;
end if;
end Create_Arc;
----------------------------------
-- Undirected_Vertex operations --
----------------------------------
function Arity (V : Undirected_Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Arity",
BSE.Is_Null);
Curr := V.Rep.Incoming;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Incoming;
end loop;
Curr := V.Rep.Outgoing;
while Curr /= null loop
if Curr.From /= Curr.To then
Count := Count + 1;
end if;
Curr := Curr.Next_Outgoing;
end loop;
return Count;
end Arity;
-------------------------------
-- Undirected_Arc operations --
-------------------------------
procedure Set_First_Vertex (A : in out Undirected_Arc;
V : access Undirected_Vertex'Class) is
Prev, Curr : Arc_Node_Ptr;
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Set_First_Vertex",
BSE.Is_Null);
if A.Rep.From /= null then
Prev := null;
Curr := A.Rep.From.Outgoing;
while Curr /= A.Rep loop
Prev := Curr;
Curr := Curr.Next_Outgoing;
end loop;
if Prev = null then
A.Rep.From.Outgoing := Curr.Next_Outgoing;
else
Prev.Next_Outgoing := Curr.Next_Outgoing;
end if;
A.Rep.From.Count := A.Rep.From.Count - 1;
A.Rep.Count := A.Rep.Count - 1;
end if;
if V.Rep /= null then
A.Rep.Next_Outgoing := V.Rep.Outgoing;
V.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
V.Rep.Count := V.Rep.Count + 1;
end if;
A.Rep.From := V.Rep;
end Set_First_Vertex;
procedure Set_Second_Vertex (A : in out Undirected_Arc;
V : access Undirected_Vertex'Class) is
Prev, Curr : Arc_Node_Ptr;
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Set_From_Vertex",
BSE.Is_Null);
if A.Rep.To /= null then
Prev := null;
Curr := A.Rep.To.Incoming;
while Curr /= A.Rep loop
Prev := Curr;
Curr := Curr.Next_Incoming;
end loop;
if Prev = null then
A.Rep.To.Incoming := Curr.Next_Incoming;
else
Prev.Next_Incoming := Curr.Next_Incoming;
end if;
A.Rep.To.Count := A.Rep.To.Count - 1;
A.Rep.Count := A.Rep.Count - 1;
end if;
if V.Rep /= null then
A.Rep.Next_Incoming := V.Rep.Incoming;
V.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
V.Rep.Count := V.Rep.Count + 1;
end if;
A.Rep.To := V.Rep;
end Set_Second_Vertex;
procedure First_Vertex (A : Undirected_Arc;
V : in out Undirected_Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"First_Vertex",
BSE.Is_Null);
Clear (V);
V.Rep := A.Rep.From;
if V.Rep /= null then
V.Rep.Count := V.Rep.Count + 1;
end if;
end First_Vertex;
procedure Second_Vertex (A : Undirected_Arc;
V : in out Undirected_Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Second_Vertex",
BSE.Is_Null);
Clear (V);
V.Rep := A.Rep.To;
if V.Rep /= null then
V.Rep.Count := V.Rep.Count + 1;
end if;
end Second_Vertex;
--------------------------------
-- Undirected_Graph iterators --
--------------------------------
package Graph_Address_Conversions
is new System.Address_To_Access_Conversions (Undirected_Graph);
function New_Graph_Iterator
(For_The_Graph : Undirected_Graph) return Graph_Iterator is
P : Graph_Address_Conversions.Object_Pointer
:= Graph_Address_Conversions.To_Pointer (For_The_Graph'Address);
begin
return Graph_Iterator (GSP.Create (new Undirected_Graph_Iterator (P)));
end New_Graph_Iterator;
package Vertex_Address_Conversions
is new System.Address_To_Access_Conversions (Undirected_Vertex);
function New_Vertex_Iterator
(For_The_Vertex : Undirected_Vertex) return Vertex_Iterator is
P : Vertex_Address_Conversions.Object_Pointer
:= Vertex_Address_Conversions.To_Pointer (For_The_Vertex'Address);
begin
return Vertex_Iterator (VSP.Create (new Undirected_Vertex_Iterator (P)));
end New_Vertex_Iterator;
-------------------------------
-- Private iteration support --
-------------------------------
procedure Initialize (It : in out Undirected_Graph_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Undirected_Graph_Iterator) is
begin
It.Index := It.U.Rep;
end Reset;
procedure Next (It : in out Undirected_Graph_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next;
end if;
end Next;
function Is_Done (It : Undirected_Graph_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Vertex (It : Undirected_Graph_Iterator) return Vertex'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Item(Undirected_Graph_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Undirected_Vertex'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Vertex;
---------------------------------
-- Undirected_Vertex iterators --
---------------------------------
procedure Initialize (It : in out Undirected_Vertex_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Undirected_Vertex_Iterator) is
begin
It.First := True;
if It.U.Rep /= null then
It.Index := It.U.Rep.Outgoing;
if It.Index = null then
It.First := False;
It.Index := It.U.Rep.Incoming;
while It.Index /= null and then (It.Index.From = It.Index.To) loop
It.Index := It.Index.Next_Incoming;
end loop;
end if;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Undirected_Vertex_Iterator) is
begin
-- XXX I think we ought to check here that there is an Index!
if It.First then
It.Index := It.Index.Next_Outgoing;
if It.Index = null then
It.First := False;
It.Index := It.U.Rep.Incoming;
while It.Index /= null and then (It.Index.From = It.Index.To) loop
It.Index := It.Index.Next_Incoming;
end loop;
end if;
elsif It.Index /= null then
It.Index := It.Index.Next_Incoming;
while It.Index /= null and then (It.Index.From = It.Index.To) loop
It.Index := It.Index.Next_Incoming;
end loop;
end if;
end Next;
function Is_Done (It : Undirected_Vertex_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Arc (It : Undirected_Vertex_Iterator) return Arc'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Item(Undirected_Arc_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Undirected_Arc'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Arc;
end BC.Graphs.Undirected;