File : bc-graphs-directed.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-directed.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.Directed is
package BSE renames BC.Support.Exceptions;
procedure Assert
is new BSE.Assert ("BC.Graphs.Directed");
-------------------------------
-- Directed_Graph operations --
-------------------------------
procedure Create_Arc (G : in out Directed_Graph;
A : in out Directed_Arc'Class;
I : Arc_Item;
From : in out Directed_Vertex'Class;
To : in out Directed_Vertex'Class) is
begin
Clear (A);
A.Rep := new Arc_Node'(Ada.Finalization.Controlled with
Item => I,
Enclosing => G'Unchecked_Access,
From => From.Rep,
To => To.Rep,
Next_Incoming => null,
Next_Outgoing => null,
Count => 1);
if To.Rep /= null then
A.Rep.Next_Incoming := To.Rep.Incoming;
To.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
To.Rep.Count := To.Rep.Count + 1;
end if;
if From.Rep /= null then
A.Rep.Next_Outgoing := From.Rep.Outgoing;
From.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
From.Rep.Count := From.Rep.Count + 1;
end if;
end Create_Arc;
--------------------------------
-- Directed_Vertex operations --
--------------------------------
function Number_Of_Incoming_Arcs (V : Directed_Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Number_Of_Incoming_Arcs",
BSE.Is_Null);
Curr := V.Rep.Incoming;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Incoming;
end loop;
return Count;
end Number_Of_Incoming_Arcs;
function Number_Of_Outgoing_Arcs (V : Directed_Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Number_Of_Outgoing_Arcs",
BSE.Is_Null);
Curr := V.Rep.Outgoing;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Outgoing;
end loop;
return Count;
end Number_Of_Outgoing_Arcs;
-----------------------------
-- Directed_Arc operations --
-----------------------------
procedure Set_From_Vertex (A : in out Directed_Arc;
V : access Directed_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.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_From_Vertex;
procedure Set_To_Vertex (A : in out Directed_Arc;
V : access Directed_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_To_Vertex;
procedure From_Vertex (A : Directed_Arc; V : in out Directed_Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"From_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 From_Vertex;
procedure To_Vertex (A : Directed_Arc; V : in out Directed_Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"To_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 To_Vertex;
------------------------------
-- Directed_Graph iterators --
------------------------------
package Graph_Address_Conversions
is new System.Address_To_Access_Conversions (Directed_Graph);
function New_Graph_Iterator
(For_The_Graph : Directed_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 Directed_Graph_Iterator (P)));
end New_Graph_Iterator;
package Vertex_Address_Conversions
is new System.Address_To_Access_Conversions (Directed_Vertex);
function New_Vertex_Iterator
(For_The_Vertex : Directed_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 Directed_Vertex_Bothways_Iterator (P)));
end New_Vertex_Iterator;
function New_Vertex_Incoming_Iterator
(For_The_Vertex : Directed_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 Directed_Vertex_Incoming_Iterator (P)));
end New_Vertex_Incoming_Iterator;
function New_Vertex_Outgoing_Iterator
(For_The_Vertex : Directed_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 Directed_Vertex_Outgoing_Iterator (P)));
end New_Vertex_Outgoing_Iterator;
-------------------------------
-- Private iteration support --
-------------------------------
procedure Initialize (It : in out Directed_Graph_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Directed_Graph_Iterator) is
begin
It.Index := It.D.Rep;
end Reset;
procedure Next (It : in out Directed_Graph_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next;
end if;
end Next;
function Is_Done (It : Directed_Graph_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Vertex (It : Directed_Graph_Iterator) return Vertex'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Item(Directed_Graph_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Directed_Vertex'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Vertex;
-------------------------------
-- Directed_Vertex iterators --
-------------------------------
--------------
-- Abstract --
--------------
function Is_Done (It : Directed_Vertex_Abstract_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Arc (It : Directed_Vertex_Abstract_Iterator)
return Arc'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Item(Directed_Vertex_Outgoing_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Directed_Arc'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Arc;
--------------
-- Bothways --
--------------
procedure Initialize (It : in out Directed_Vertex_Bothways_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Directed_Vertex_Bothways_Iterator) is
begin
It.First := True;
if It.D.Rep /= null then
It.Index := It.D.Rep.Outgoing;
if It.Index = null then
It.First := False;
It.Index := It.D.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 Directed_Vertex_Bothways_Iterator) is
begin
if It.First then
It.Index := It.Index.Next_Outgoing;
if It.Index = null then
It.First := False;
It.Index := It.D.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;
--------------
-- Outgoing --
--------------
procedure Initialize (It : in out Directed_Vertex_Outgoing_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Directed_Vertex_Outgoing_Iterator) is
begin
if It.D.Rep /= null then
It.Index := It.D.Rep.Outgoing;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Directed_Vertex_Outgoing_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next_Outgoing;
end if;
end Next;
--------------
-- Incoming --
--------------
procedure Initialize (It : in out Directed_Vertex_Incoming_Iterator) is
begin
Reset (It);
end Initialize;
procedure Reset (It : in out Directed_Vertex_Incoming_Iterator) is
begin
if It.D.Rep /= null then
It.Index := It.D.Rep.Incoming;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Directed_Vertex_Incoming_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next_Incoming;
end if;
end Next;
end BC.Graphs.Directed;