summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/directed_graphs.adb1337
-rw-r--r--src/directed_graphs.ads55
2 files changed, 1170 insertions, 222 deletions
diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb
index 00d8f03..61d704a 100644
--- a/src/directed_graphs.adb
+++ b/src/directed_graphs.adb
@@ -1,5 +1,69 @@
+-- Done list:
+--
+-- "="
+-- Append
+-- Append_Label
+-- Assign
+-- Children
+-- Clear
+-- Clear_Labels
+-- Constant_Label_Reference
+-- Contains
+-- Contains_In_Subgraph
+-- Contains_Label
+-- Contains_Label_In_Subgraph
+-- Context
+-- Copy
+-- Degree
+-- Delete
+-- Delete_Label
+-- Delete_Subgraph
+-- Edge_Count
+-- Edges
+-- Element
+-- Finalize
+-- Find
+-- Find_In_Subgraph
+-- First
+-- Has_Edge
+-- Has_Element
+-- Has_Label
+-- Has_Labeled_Edge
+-- Has_Neighbor
+-- Inbound
+-- Indegree
+-- Insert
+-- Is_Empty
+-- Iterate
+-- Iterate_Subgraph
+-- Keys
+-- Label
+-- Label_Reference
+-- Labeled_Context
+-- Last
+-- Move
+-- Neighbors
+-- Next
+-- Node_Count
+-- Node_Range
+-- Nodes
+-- Outbound
+-- Outdegree
+-- Parents
+-- Previous
+-- Read
+-- Replace_Label
+-- Swap
+-- To_Cursor
+-- To_Graph
+-- To_Hash
+-- Unused_Nodes
+-- Vector_To_Array
+-- Write
+
+
package body Directed_Graphs is
@@ -10,42 +74,86 @@ package body Directed_Graphs is
+ function Keys
+ (My_Map : in Node_Maps.Map)
+ return Node_Vectors.Vector;
+
+ function Keys
+ (My_Map : in Node_Label_Maps.Map)
+ return Node_Vectors.Vector;
+
+ function Keys
+ (My_Map : in Edge_Label_Maps.Map)
+ return Edge_Vectors.Vector;
+
+ -- generic
+ -- type Base_Type is private;
+ -- with package Type_Vectors is new Ada.Containers.Vectors
+ -- (Index_Type => Positive,
+ -- Element_Type => Base_Type);
+ -- type Array_Type is array (Positive range <>) of Base_Type;
+ -- function Vector_To_Array
+ -- (Input : in Type_Vectors.Vector)
+ -- return Array_Type;
+
+ function Vector_To_Array
+ (Input : in Node_Vectors.Vector)
+ return Node_Array;
+
+ function Vector_To_Array
+ (Input : in Edge_Vectors.Vector)
+ return Edge_Array;
+
+
+
+
---------
-- "=" --
---------
overriding function "="
(Left, Right : in Graph)
- return Boolean is
- begin
- return False;
+ return Boolean
+ is
+ use type Node_Maps.Map;
+ use type Node_Label_Maps.Map;
+ use type Edge_Label_Maps.Map;
+ begin
+ if Left.Is_Empty and Right.Is_Empty then
+ return True;
+ end if;
+ declare
+ Lock_Left : Impl.With_Lock (Left.Tamper_Info'Unrestricted_Access);
+ Lock_Right : Impl.With_Lock (Right.Tamper_Info'Unrestricted_Access);
+ begin
+ return Left.Connections = Right.Connections and then
+ Left.Node_Labels = Right.Node_Labels and then
+ Left.Edge_Labels = Right.Edge_Labels;
+ end;
end "=";
------------
- -- Adjust --
- ------------
-
- procedure Adjust
- (Container : in out Graph) is
- begin
- null;
- end Adjust;
-
-
-
-
- ------------
-- Append --
------------
procedure Append
(Container : in out Graph;
- Position : out Cursor) is
- begin
- null;
+ Position : out Cursor)
+ is
+ Node : Node_Type := Node_Type'First;
+ begin
+ while Container.Connections.Contains (Node) loop
+ if Impl.Checks and then Node = Node_Type'Last then
+ raise Constraint_Error with "Graph has no unused nodes";
+ end if;
+ Node := Node_Type'Succ (Node);
+ end loop;
+ Container.Connections.Insert (Node, Node_Vectors.Empty_Vector);
+ Position.Container := Container'Unrestricted_Access;
+ Position.Node := Node;
end Append;
procedure Append
@@ -53,7 +161,8 @@ package body Directed_Graphs is
Label : in Node_Label_Type;
Position : out Cursor) is
begin
- null;
+ Container.Append (Position);
+ Container.Node_Labels.Insert (Position.Node, Label);
end Append;
@@ -68,14 +177,21 @@ package body Directed_Graphs is
Node : in Node_Type;
Label : in Node_Label_Type) is
begin
- null;
+ if Impl.Checks then
+ if not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ elsif Container.Has_Label (Node) then
+ raise Constraint_Error with "Node already has label";
+ end if;
+ end if;
+ Container.Node_Labels.Insert (Node, Label);
end Append_Label;
procedure Append_Label
(Position : in out Cursor;
Label : in Node_Label_Type) is
begin
- null;
+ Position.Container.Append_Label (Position.Node, Label);
end Append_Label;
procedure Append_Label
@@ -83,7 +199,14 @@ package body Directed_Graphs is
Edge : in Edge_Type;
Label : in Edge_Label_Type) is
begin
- null;
+ if Impl.Checks then
+ if not Container.Contains (Edge) then
+ raise Constraint_Error with "Graph does not contain edge";
+ elsif Container.Has_Label (Edge) then
+ raise Constraint_Error with "Edge already has label";
+ end if;
+ end if;
+ Container.Edge_Labels.Insert (Edge, Label);
end Append_Label;
@@ -97,7 +220,7 @@ package body Directed_Graphs is
(Target : in out Graph;
Source : in Graph) is
begin
- null;
+ Target := Source;
end Assign;
@@ -110,16 +233,22 @@ package body Directed_Graphs is
function Children
(Container : in Graph;
Node : in Node_Type)
- return Node_Array is
- begin
- return N : Node_Array (1 .. 0);
+ return Node_Array
+ is
+ Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access);
+ -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array);
+ begin
+ if Impl.Checks and then not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ end if;
+ return Vector_To_Array (Container.Connections.Constant_Reference (Node));
end Children;
function Children
(Position : in Cursor)
return Node_Array is
begin
- return N : Node_Array (1 .. 0);
+ return Position.Container.Children (Position.Node);
end Children;
@@ -132,7 +261,10 @@ package body Directed_Graphs is
procedure Clear
(Container : in out Graph) is
begin
- null;
+ Impl.TC_Check (Container.Tamper_Info);
+ Container.Connections.Clear;
+ Container.Node_Labels.Clear;
+ Container.Edge_Labels.Clear;
end Clear;
@@ -145,7 +277,9 @@ package body Directed_Graphs is
procedure Clear_Labels
(Container : in out Graph) is
begin
- null;
+ Impl.TC_Check (Container.Tamper_Info);
+ Container.Node_Labels.Clear;
+ Container.Edge_Labels.Clear;
end Clear_Labels;
@@ -160,18 +294,31 @@ package body Directed_Graphs is
Node : in Node_Type)
return Node_Label_Constant_Reference is
begin
- return R : Node_Label_Constant_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ if Impl.Checks then
+ if not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ elsif not Container.Has_Label (Node) then
+ raise Constraint_Error with "Node does not have a label";
+ end if;
+ end if;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Container.Tamper_Info'Unrestricted_Access;
+ begin
+ return Ref : constant Node_Label_Constant_Reference :=
+ (Element => Container.Node_Labels.Constant_Reference (Node).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
end Constant_Label_Reference;
function Constant_Label_Reference
(Position : in Cursor)
return Node_Label_Constant_Reference is
begin
- return R : Node_Label_Constant_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ return Position.Container.Constant_Label_Reference (Position.Node);
end Constant_Label_Reference;
function Constant_Label_Reference
@@ -179,9 +326,24 @@ package body Directed_Graphs is
Edge : in Edge_Type)
return Edge_Label_Constant_Reference is
begin
- return R : Edge_Label_Constant_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ if Impl.Checks then
+ if not Container.Contains (Edge) then
+ raise Constraint_Error with "Graph does not contain edge";
+ elsif not Container.Has_Label (Edge) then
+ raise Constraint_Error with "Edge does not have a label";
+ end if;
+ end if;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Container.Tamper_Info'Unrestricted_Access;
+ begin
+ return Ref : constant Edge_Label_Constant_Reference :=
+ (Element => Container.Edge_Labels.Constant_Reference (Edge).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
end Constant_Label_Reference;
@@ -196,7 +358,7 @@ package body Directed_Graphs is
Node : in Node_Type)
return Boolean is
begin
- return False;
+ return Container.Connections.Contains (Node);
end Contains;
function Contains
@@ -205,7 +367,9 @@ package body Directed_Graphs is
Label : in Node_Label_Type)
return Boolean is
begin
- return False;
+ return Container.Contains (Node) and then
+ Container.Node_Labels.Contains (Node) and then
+ Container.Node_Labels.Constant_Reference (Node) = Label;
end Contains;
function Contains
@@ -213,7 +377,8 @@ package body Directed_Graphs is
Edge : in Edge_Type)
return Boolean is
begin
- return False;
+ return Container.Connections.Contains (Edge.From) and then
+ Container.Connections.Constant_Reference (Edge.From).Contains (Edge.To);
end Contains;
function Contains
@@ -222,7 +387,9 @@ package body Directed_Graphs is
Label : in Edge_Label_Type)
return Boolean is
begin
- return False;
+ return Container.Contains (Edge) and then
+ Container.Edge_Labels.Contains (Edge) and then
+ Container.Edge_Labels.Constant_Reference (Edge) = Label;
end Contains;
@@ -237,6 +404,14 @@ package body Directed_Graphs is
Node : in Node_Type)
return Boolean is
begin
+ if Position.Container = null then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if C.Node = Node then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_In_Subgraph;
@@ -246,14 +421,40 @@ package body Directed_Graphs is
Label : in Node_Label_Type)
return Boolean is
begin
+ if Position.Container = null then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if C.Node = Node and Constant_Label_Reference (C) = Label then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_In_Subgraph;
function Contains_In_Subgraph
(Position : in Cursor;
Edge : in Edge_Type)
- return Boolean is
- begin
+ return Boolean
+ is
+ Parent_Check, Child_Check : Boolean := False;
+ begin
+ if Position.Container = null or else
+ not Position.Container.Contains (Edge)
+ then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if C.Node = Edge.From then
+ Parent_Check := True;
+ end if;
+ if C.Node = Edge.To then
+ Child_Check := True;
+ end if;
+ if Parent_Check and Child_Check then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_In_Subgraph;
@@ -261,8 +462,26 @@ package body Directed_Graphs is
(Position : in Cursor;
Edge : in Edge_Type;
Label : in Edge_Label_Type)
- return Boolean is
- begin
+ return Boolean
+ is
+ Parent_Check, Child_Check : Boolean := False;
+ begin
+ if Position.Container = null or else
+ not Position.Container.Contains (Edge, Label)
+ then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if C.Node = Edge.From then
+ Parent_Check := True;
+ end if;
+ if C.Node = Edge.To then
+ Child_Check := True;
+ end if;
+ if Parent_Check and Child_Check then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_In_Subgraph;
@@ -278,6 +497,11 @@ package body Directed_Graphs is
Label : in Node_Label_Type)
return Boolean is
begin
+ for C in Container.Node_Labels.Iterate loop
+ if Node_Label_Maps.Element (C) = Label then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_Label;
@@ -286,6 +510,11 @@ package body Directed_Graphs is
Label : in Edge_Label_Type)
return Boolean is
begin
+ for C in Container.Edge_Labels.Iterate loop
+ if Edge_Label_Maps.Element (C) = Label then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_Label;
@@ -301,14 +530,44 @@ package body Directed_Graphs is
Label : in Node_Label_Type)
return Boolean is
begin
+ if Position.Container = null or else
+ Position.Container.Node_Labels.Is_Empty
+ then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if Position.Container.Node_Labels.Contains (C.Node) then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_Label_In_Subgraph;
function Contains_Label_In_Subgraph
(Position : in Cursor;
Label : in Edge_Label_Type)
- return Boolean is
- begin
+ return Boolean
+ is
+ Inside : Node_Vectors.Vector;
+ Check : Edge_Type;
+ begin
+ if Position.Container = null or else
+ Position.Container.Edge_Labels.Is_Empty
+ then
+ return False;
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ Inside.Append (C.Node);
+ end loop;
+ for E in Position.Container.Edge_Labels.Iterate loop
+ Check := Edge_Label_Maps.Key (E);
+ if Inside.Contains (Check.From) and then
+ Inside.Contains (Check.To) and then
+ Edge_Label_Maps.Element (E) = Label
+ then
+ return True;
+ end if;
+ end loop;
return False;
end Contains_Label_In_Subgraph;
@@ -325,7 +584,8 @@ package body Directed_Graphs is
Parents : out Node_Array;
Children : out Node_Array) is
begin
- null;
+ Parents := Container.Parents (Node);
+ Children := Container.Children (Node);
end Context;
procedure Context
@@ -333,7 +593,7 @@ package body Directed_Graphs is
Parents : out Node_Array;
Children : out Node_Array) is
begin
- null;
+ Position.Container.Context (Position.Node, Parents, Children);
end Context;
@@ -347,7 +607,11 @@ package body Directed_Graphs is
(Source : in Graph)
return Graph is
begin
- return Empty_Graph;
+ return G : Graph do
+ G.Connections := Source.Connections;
+ G.Node_Labels := Source.Node_Labels;
+ G.Edge_Labels := Source.Edge_Labels;
+ end return;
end Copy;
@@ -360,16 +624,18 @@ package body Directed_Graphs is
function Degree
(Container : in Graph;
Node : in Node_Type)
- return Ada.Containers.Count_Type is
+ return Ada.Containers.Count_Type
+ is
+ use type Ada.Containers.Count_Type;
begin
- return Ada.Containers.Count_Type'First;
+ return Container.Indegree (Node) + Container.Outdegree (Node);
end Degree;
function Degree
(Position : in Cursor)
return Ada.Containers.Count_Type is
begin
- return Ada.Containers.Count_Type'First;
+ return Position.Container.Degree (Position.Node);
end Degree;
@@ -383,34 +649,68 @@ package body Directed_Graphs is
(Container : in out Graph;
Node : in Node_Type) is
begin
- null;
+ if Impl.Checks and then not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ end if;
+ for N of Container.Connections.Constant_Reference (Node) loop
+ Container.Edge_Labels.Exclude ((From => Node, To => N));
+ end loop;
+ Container.Connections.Delete (Node);
+ Container.Node_Labels.Exclude (Node);
+ for C in Container.Connections.Iterate loop
+ declare
+ Ref : Node_Maps.Reference_Type :=
+ Container.Connections.Reference (C);
+ begin
+ for I in reverse 1 .. Ref.Last_Index loop
+ if Ref (I) = Node then
+ Container.Edge_Labels.Exclude
+ ((From => Node_Maps.Key (C), To => Node));
+ Ref.Delete (I);
+ end if;
+ end loop;
+ end;
+ end loop;
end Delete;
procedure Delete
(Position : in out Cursor) is
begin
- null;
+ Position.Container.Delete (Position.Node);
end Delete;
procedure Delete
(Container : in out Graph;
Nodes : in Node_Array) is
begin
- null;
+ for N of Nodes loop
+ Container.Delete (N);
+ end loop;
end Delete;
procedure Delete
(Container : in out Graph;
Edge : in Edge_Type) is
begin
- null;
+ if Impl.Checks and then not Container.Contains (Edge) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ Container.Edge_Labels.Exclude (Edge);
+ declare
+ Ref : Node_Maps.Reference_Type :=
+ Container.Connections.Reference (Edge.From);
+ begin
+ Ref.Delete (Ref.Find_Index (Edge.To));
+ end;
end Delete;
procedure Delete
(Container : in out Graph;
Edges : in Edge_Array) is
begin
- null;
+ for E of Edges loop
+ Container.Delete (E);
+ end loop;
end Delete;
@@ -424,20 +724,20 @@ package body Directed_Graphs is
(Container : in out Graph;
Node : in Node_Type) is
begin
- null;
+ Container.Node_Labels.Delete (Node);
end Delete_Label;
procedure Delete_Label
(Position : in out Cursor) is
begin
- null;
+ Position.Container.Delete_Label (Position.Node);
end Delete_Label;
procedure Delete_Label
(Container : in out Graph;
Edge : in Edge_Type) is
begin
- null;
+ Container.Edge_Labels.Delete (Edge);
end Delete_Label;
@@ -448,9 +748,17 @@ package body Directed_Graphs is
---------------------
procedure Delete_Subgraph
- (Position : in out Cursor) is
- begin
- null;
+ (Position : in out Cursor)
+ is
+ Nodes : Node_Vectors.Vector;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ Nodes.Append (C.Node);
+ end loop;
+ Position.Container.Delete (Vector_To_Array (Nodes));
end Delete_Subgraph;
@@ -462,9 +770,31 @@ package body Directed_Graphs is
function Edge_Count
(Container : in Graph)
- return Ada.Containers.Count_Type is
- begin
- return Ada.Containers.Count_Type'First;
+ return Ada.Containers.Count_Type
+ is
+ use type Ada.Containers.Count_Type;
+ Result : Ada.Containers.Count_Type := 0;
+ begin
+ for C of Container.Connections loop
+ Result := Result + C.Length;
+ end loop;
+ return Result;
+ end Edge_Count;
+
+ function Edge_Count
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ is
+ use type Ada.Containers.Count_Type;
+ Result : Ada.Containers.Count_Type := 0;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ Result := Result + Outdegree (Position);
+ end loop;
+ return Result;
end Edge_Count;
@@ -476,11 +806,55 @@ package body Directed_Graphs is
function Edges
(Container : in Graph)
- return Edge_Array is
- begin
- return E : Edge_Array (1 .. 0);
+ return Edge_Array
+ is
+ Tos : Edge_Vectors.Vector;
+ -- function Convert is new Vector_To_Array (Edge_Type, Edge_Vectors, Edge_Array);
+ begin
+ for C in Container.Connections.Iterate loop
+ for N of Container.Connections.Constant_Reference (C) loop
+ Tos.Append
+ ((From => Node_Maps.Key (C),
+ To => N));
+ end loop;
+ end loop;
+ return Vector_To_Array (Tos);
end Edges;
+ function Edges
+ (Position : in Cursor)
+ return Edge_Array
+ is
+ Tos : Edge_Vectors.Vector;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ for E of Outbound (Position) loop
+ Tos.Append (E);
+ end loop;
+ end loop;
+ return Vector_To_Array (Tos);
+ end Edges;
+
+
+
+
+ -------------
+ -- Element --
+ -------------
+
+ function Element
+ (Position : in Cursor)
+ return Node_Type is
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ return Position.Node;
+ end Element;
+
@@ -491,19 +865,19 @@ package body Directed_Graphs is
procedure Finalize
(Container : in out Graph) is
begin
- null;
+ Impl.TC_Check (Container.Tamper_Info);
end Finalize;
procedure Finalize
(Object : in out Iterator) is
begin
- null;
+ Impl.Unbusy (Object.Container.Tamper_Info);
end Finalize;
procedure Finalize
(Object : in out Subgraph_Iterator) is
begin
- null;
+ Impl.Unbusy (Object.Container.Tamper_Info);
end Finalize;
@@ -516,17 +890,31 @@ package body Directed_Graphs is
function Find
(Container : in Graph;
Label : in Node_Label_Type)
- return Node_Array is
- begin
- return N : Node_Array (1 .. 0);
+ return Node_Array
+ is
+ Result : Node_Vectors.Vector;
+ begin
+ for C in Container.Node_Labels.Iterate loop
+ if Container.Node_Labels.Constant_Reference (C) = Label then
+ Result.Append (Node_Label_Maps.Key (C));
+ end if;
+ end loop;
+ return Vector_To_Array (Result);
end Find;
function Find
(Container : in Graph;
Label : in Edge_Label_Type)
- return Edge_Array is
- begin
- return E : Edge_Array (1 .. 0);
+ return Edge_Array
+ is
+ Result : Edge_Vectors.Vector;
+ begin
+ for C in Container.Edge_Labels.Iterate loop
+ if Container.Edge_Labels.Constant_Reference (C) = Label then
+ Result.Append (Edge_Label_Maps.Key (C));
+ end if;
+ end loop;
+ return Vector_To_Array (Result);
end Find;
@@ -539,17 +927,44 @@ package body Directed_Graphs is
function Find_In_Subgraph
(Position : in Cursor;
Label : in Node_Label_Type)
- return Node_Array is
- begin
- return N : Node_Array (1 .. 0);
+ return Node_Array
+ is
+ Result : Node_Vectors.Vector;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ if Position.Container.Node_Labels.Constant_Reference (C.Node) = Label then
+ Result.Append (C.Node);
+ end if;
+ end loop;
+ return Vector_To_Array (Result);
end Find_In_Subgraph;
function Find_In_Subgraph
(Position : in Cursor;
Label : in Edge_Label_Type)
- return Edge_Array is
- begin
- return E : Edge_Array (1 .. 0);
+ return Edge_Array
+ is
+ Nodes : Node_Vectors.Vector;
+ Result : Edge_Vectors.Vector;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ Nodes.Append (C.Node);
+ end loop;
+ for E of Keys (Position.Container.Edge_Labels) loop
+ if Nodes.Contains (E.From) and then
+ Nodes.Contains (E.To) and then
+ Position.Container.Edge_Labels.Constant_Reference (E) = Label
+ then
+ Result.Append (E);
+ end if;
+ end loop;
+ return Vector_To_Array (Result);
end Find_In_Subgraph;
@@ -561,23 +976,42 @@ package body Directed_Graphs is
function First
(Container : in Graph)
- return Cursor is
- begin
- return No_Element;
+ return Cursor
+ is
+ use type Ada.Containers.Count_Type;
+ Node : Node_Type := Node_Type'Last;
+ begin
+ if Impl.Checks and then Container.Node_Count = 0 then
+ raise Constraint_Error with "Graph is empty";
+ end if;
+ for N of Keys (Container.Connections) loop
+ if N < Node then
+ Node := N;
+ end if;
+ end loop;
+ return
+ (Container => Container'Unrestricted_Access,
+ Node => Node,
+ Visited => Node_Vectors.Empty_Vector,
+ Path_Up => Node_Vectors.Empty_Vector);
end First;
function First
(Object : in Iterator)
return Cursor is
begin
- return No_Element;
+ return Object.Container.First;
end First;
function First
(Object : in Subgraph_Iterator)
return Cursor is
begin
- return No_Element;
+ return
+ (Container => Object.Container,
+ Node => Object.Root_Node,
+ Visited => Node_Vectors.Empty_Vector,
+ Path_Up => Node_Vectors.Empty_Vector);
end First;
@@ -592,14 +1026,21 @@ package body Directed_Graphs is
Parent, Child : in Node_Type)
return Boolean is
begin
- return False;
+ if Impl.Checks then
+ if not Container.Contains (Parent) then
+ raise Constraint_Error with "Graph does not contain parent node";
+ elsif not Container.Contains (Child) then
+ raise Constraint_Error with "Graph does not contain child node";
+ end if;
+ end if;
+ return Container.Contains ((From => Parent, To => Child));
end Has_Edge;
function Has_Edge
(Parent, Child : in Cursor)
return Boolean is
begin
- return False;
+ return Parent.Container.Has_Edge (Parent.Node, Child.Node);
end Has_Edge;
@@ -613,7 +1054,8 @@ package body Directed_Graphs is
(Position : in Cursor)
return Boolean is
begin
- return False;
+ return Position.Container /= null and then
+ Position.Container.Contains (Position.Node);
end Has_Element;
@@ -628,14 +1070,14 @@ package body Directed_Graphs is
Node : in Node_Type)
return Boolean is
begin
- return False;
+ return Container.Node_Labels.Contains (Node);
end Has_Label;
function Has_Label
(Position : in Cursor)
return Boolean is
begin
- return False;
+ return Position.Container.Has_Label (Position.Node);
end Has_Label;
function Has_Label
@@ -643,7 +1085,7 @@ package body Directed_Graphs is
Edge : in Edge_Type)
return Boolean is
begin
- return False;
+ return Container.Edge_Labels.Contains (Edge);
end Has_Label;
@@ -658,14 +1100,15 @@ package body Directed_Graphs is
Parent, Child : Node_Type)
return Boolean is
begin
- return False;
+ return Container.Has_Edge (Parent, Child) and
+ Container.Has_Label ((From => Parent, To => Child));
end Has_Labeled_Edge;
function Has_Labeled_Edge
(Parent, Child : in Cursor)
return Boolean is
begin
- return False;
+ return Parent.Container.Has_Labeled_Edge (Parent.Node, Child.Node);
end Has_Labeled_Edge;
@@ -680,14 +1123,15 @@ package body Directed_Graphs is
Left, Right : in Node_Type)
return Boolean is
begin
- return False;
+ return Container.Has_Edge (Left, Right) and
+ Container.Has_Edge (Right, Left);
end Has_Neighbor;
function Has_Neighbor
(Left, Right : in Cursor)
return Boolean is
begin
- return False;
+ return Left.Container.Has_Neighbor (Left.Node, Right.Node);
end Has_Neighbor;
@@ -700,16 +1144,28 @@ package body Directed_Graphs is
function Inbound
(Container : in Graph;
Node : in Node_Type)
- return Edge_Array is
- begin
- return E : Edge_Array (1 .. 0);
+ return Edge_Array
+ is
+ Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access);
+ Edges : Edge_Vectors.Vector;
+ begin
+ for C in Container.Connections.Iterate loop
+ for N of Container.Connections.Constant_Reference (C) loop
+ if N = Node then
+ Edges.Append
+ ((From => Node_Maps.Key (C),
+ To => N));
+ end if;
+ end loop;
+ end loop;
+ return Vector_To_Array (Edges);
end Inbound;
function Inbound
(Position : in Cursor)
return Edge_Array is
begin
- return E : Edge_Array (1 .. 0);
+ return Position.Container.Inbound (Position.Node);
end Inbound;
@@ -722,16 +1178,27 @@ package body Directed_Graphs is
function Indegree
(Container : in Graph;
Node : in Node_Type)
- return Ada.Containers.Count_Type is
- begin
- return Ada.Containers.Count_Type'First;
+ return Ada.Containers.Count_Type
+ is
+ use type Ada.Containers.Count_Type;
+ Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access);
+ Count : Ada.Containers.Count_Type := 0;
+ begin
+ for C of Container.Connections loop
+ for N of C loop
+ if N = Node then
+ Count := Count + 1;
+ end if;
+ end loop;
+ end loop;
+ return Count;
end Indegree;
function Indegree
(Position : in Cursor)
return Ada.Containers.Count_Type is
begin
- return Ada.Containers.Count_Type'First;
+ return Position.Container.Indegree (Position.Node);
end Indegree;
@@ -745,7 +1212,10 @@ package body Directed_Graphs is
(Container : in out Graph;
Node : in Node_Type) is
begin
- null;
+ if Impl.Checks and then Container.Contains (Node) then
+ raise Constraint_Error with "Graph already contains node";
+ end if;
+ Container.Connections.Insert (Node, Node_Vectors.Empty_Vector);
end Insert;
procedure Insert
@@ -753,21 +1223,32 @@ package body Directed_Graphs is
Node : in Node_Type;
Label : in Node_Label_Type) is
begin
- null;
+ Container.Insert (Node);
+ Container.Node_Labels.Insert (Node, Label);
end Insert;
procedure Insert
(Container : in out Graph;
Nodes : in Node_Array) is
begin
- null;
+ for N of Nodes loop
+ Container.Insert (N);
+ end loop;
end Insert;
procedure Insert
(Container : in out Graph;
Edge : in Edge_Type) is
begin
- null;
+ if Impl.Checks then
+ if not Container.Contains (Edge.From) then
+ raise Constraint_Error with "Graph does not contain tail node of edge";
+ end if;
+ if not Container.Contains (Edge.To) then
+ raise Constraint_Error with "Graph does not contain head node of edge";
+ end if;
+ end if;
+ Container.Connections.Reference (Edge.From).Append (Edge.To);
end Insert;
procedure Insert
@@ -775,14 +1256,17 @@ package body Directed_Graphs is
Edge : in Edge_Type;
Label : in Edge_Label_Type) is
begin
- null;
+ Container.Insert (Edge);
+ Container.Edge_Labels.Insert (Edge, Label);
end Insert;
procedure Insert
(Container : in out Graph;
Edges : in Edge_Array) is
begin
- null;
+ for E of Edges loop
+ Container.Insert (E);
+ end loop;
end Insert;
@@ -796,12 +1280,26 @@ package body Directed_Graphs is
(Container : in Graph)
return Boolean is
begin
- return True;
+ return Container.Connections.Is_Empty;
end Is_Empty;
+ ----------------
+ -- Isomorphic --
+ ----------------
+
+ function Isomorphic
+ (Left, Right : in Cursor)
+ return Boolean is
+ begin
+ return False;
+ end Isomorphic;
+
+
+
+
-------------
-- Iterate --
-------------
@@ -810,10 +1308,9 @@ package body Directed_Graphs is
(Container : in Graph)
return Graph_Iterator_Interfaces.Reversible_Iterator'Class is
begin
- return It : Iterator :=
- (Ada.Finalization.Limited_Controlled with
- Container => null,
- Node => Extended_Node_Type'First);
+ return It : Iterator do
+ It.Container := Container'Unrestricted_Access;
+ end return;
end Iterate;
@@ -828,17 +1325,55 @@ package body Directed_Graphs is
Position : in Cursor)
return Graph_Iterator_Interfaces.Forward_Iterator'Class is
begin
- return It : Subgraph_Iterator :=
- (Ada.Finalization.Limited_Controlled with
- Container => null,
- Root_Node => Node_Type'First,
- Visited => Node_Vectors.Empty_Vector,
- Current => Extended_Node_Type'First);
+ return It : Subgraph_Iterator do
+ It.Container := Container'Unrestricted_Access;
+ It.Root_Node := Position.Node;
+ end return;
end Iterate_Subgraph;
+ ----------
+ -- Keys --
+ ----------
+
+ function Keys
+ (My_Map : in Node_Maps.Map)
+ return Node_Vectors.Vector is
+ begin
+ return My_Vector : Node_Vectors.Vector do
+ for C in My_Map.Iterate loop
+ My_Vector.Append (Node_Maps.Key (C));
+ end loop;
+ end return;
+ end Keys;
+
+ function Keys
+ (My_Map : in Node_Label_Maps.Map)
+ return Node_Vectors.Vector is
+ begin
+ return My_Vector : Node_Vectors.Vector do
+ for C in My_Map.Iterate loop
+ My_Vector.Append (Node_Label_Maps.Key (C));
+ end loop;
+ end return;
+ end Keys;
+
+ function Keys
+ (My_Map : in Edge_Label_Maps.Map)
+ return Edge_Vectors.Vector is
+ begin
+ return My_Vector : Edge_Vectors.Vector do
+ for C in My_Map.Iterate loop
+ My_Vector.Append (Edge_Label_Maps.Key (C));
+ end loop;
+ end return;
+ end Keys;
+
+
+
+
-----------
-- Label --
-----------
@@ -848,14 +1383,21 @@ package body Directed_Graphs is
Node : in Node_Type)
return Node_Label_Type is
begin
- return N : Node_Label_Type;
+ if Impl.Checks then
+ if not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ elsif not Container.Has_Label (Node) then
+ raise Constraint_Error with "Node does not have label";
+ end if;
+ end if;
+ return Container.Node_Labels.Element (Node);
end Label;
function Label
(Position : in Cursor)
return Node_Label_Type is
begin
- return N : Node_Label_Type;
+ return Position.Container.Label (Position.Node);
end Label;
function Label
@@ -863,7 +1405,14 @@ package body Directed_Graphs is
Edge : in Edge_Type)
return Edge_Label_Type is
begin
- return E : Edge_Label_Type;
+ if Impl.Checks then
+ if not Container.Contains (Edge) then
+ raise Constraint_Error with "Graph does not contain edge";
+ elsif not Container.Has_Label (Edge) then
+ raise Constraint_Error with "Edge does not have label";
+ end if;
+ end if;
+ return Container.Edge_Labels.Element (Edge);
end Label;
@@ -874,32 +1423,60 @@ package body Directed_Graphs is
---------------------
function Label_Reference
- (Container : in Graph;
- Node : in Node_Type)
+ (Container : aliased in out Graph;
+ Node : in Node_Type)
return Node_Label_Reference is
begin
- return R : Node_Label_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ if Impl.Checks then
+ if not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ elsif not Container.Has_Label (Node) then
+ raise Constraint_Error with "Node does not have label";
+ end if;
+ end if;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Container.Tamper_Info'Unrestricted_Access;
+ begin
+ return Ref : constant Node_Label_Reference :=
+ (Element => Container.Node_Labels.Reference (Node).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
end Label_Reference;
function Label_Reference
(Position : in Cursor)
return Node_Label_Reference is
begin
- return R : Node_Label_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ return Position.Container.Label_Reference (Position.Node);
end Label_Reference;
function Label_Reference
- (Container : in Graph;
- Edge : in Edge_Type)
+ (Container : aliased in out Graph;
+ Edge : in Edge_Type)
return Edge_Label_Reference is
begin
- return R : Edge_Label_Reference :=
- (Element => null,
- Control => (Ada.Finalization.Controlled with null));
+ if Impl.Checks then
+ if not Container.Contains (Edge) then
+ raise Constraint_Error with "Graph does not contain edge";
+ elsif not Container.Has_Label (Edge) then
+ raise Constraint_Error with "Edge does not have label";
+ end if;
+ end if;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Container.Tamper_Info'Unrestricted_Access;
+ begin
+ return Ref : constant Edge_Label_Reference :=
+ (Element => Container.Edge_Labels.Reference (Edge).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
end Label_Reference;
@@ -916,7 +1493,9 @@ package body Directed_Graphs is
Children : out Node_Array;
Label : out Node_Label_Type) is
begin
- null;
+ Parents := Container.Parents (Node);
+ Children := Container.Children (Node);
+ Label := Container.Label (Node);
end Labeled_Context;
procedure Labeled_Context
@@ -925,7 +1504,7 @@ package body Directed_Graphs is
Children : out Node_Array;
Label : out Node_Label_Type) is
begin
- null;
+ Position.Container.Labeled_Context (Position.Node, Parents, Children, Label);
end Labeled_Context;
@@ -937,16 +1516,31 @@ package body Directed_Graphs is
function Last
(Container : in Graph)
- return Cursor is
- begin
- return No_Element;
+ return Cursor
+ is
+ use type Ada.Containers.Count_Type;
+ Node : Node_Type := Node_Type'First;
+ begin
+ if Impl.Checks and then Container.Node_Count = 0 then
+ raise Constraint_Error with "Graph is empty";
+ end if;
+ for N of Keys (Container.Connections) loop
+ if N > Node then
+ Node := N;
+ end if;
+ end loop;
+ return
+ (Container => Container'Unrestricted_Access,
+ Node => Node,
+ Visited => Node_Vectors.Empty_Vector,
+ Path_Up => Node_Vectors.Empty_Vector);
end Last;
function Last
(Object : in Iterator)
return Cursor is
begin
- return No_Element;
+ return Object.Container.Last;
end Last;
@@ -959,7 +1553,10 @@ package body Directed_Graphs is
procedure Move
(Target, Source : in out Graph) is
begin
- null;
+ Node_Maps.Move (Target.Connections, Source.Connections);
+ Node_Label_Maps.Move (Target.Node_Labels, Source.Node_Labels);
+ Edge_Label_Maps.Move (Target.Edge_Labels, Source.Edge_Labels);
+ -- does anything have to be done with tamper checks here?
end Move;
@@ -972,16 +1569,28 @@ package body Directed_Graphs is
function Neighbors
(Container : in Graph;
Node : in Node_Type)
- return Node_Array is
- begin
- return N : Node_Array (1 .. 0);
+ return Node_Array
+ is
+ Nodes : Node_Vectors.Vector;
+ Ref : Node_Maps.Constant_Reference_Type :=
+ Container.Connections.Constant_Reference (Node);
+ begin
+ for C in Container.Connections.Iterate loop
+ for N of Container.Connections.Constant_Reference (C) loop
+ if N = Node and Ref.Contains (Node_Maps.Key (C)) then
+ Nodes.Append (N);
+ exit;
+ end if;
+ end loop;
+ end loop;
+ return Vector_To_Array (Nodes);
end Neighbors;
function Neighbors
(Position : in Cursor)
return Node_Array is
begin
- return N : Node_Array (1 .. 0);
+ return Position.Container.Neighbors (Position.Node);
end Neighbors;
@@ -993,31 +1602,76 @@ package body Directed_Graphs is
function Next
(Position : in Cursor)
- return Cursor is
+ return Cursor
+ is
+ Cursor_Copy : Cursor := Position;
begin
- return No_Element;
+ Next (Cursor_Copy);
+ return Cursor_Copy;
end Next;
procedure Next
- (Position : in out Cursor) is
- begin
- null;
+ (Position : in out Cursor)
+ is
+ Select_From : Node_Vectors.Vector;
+ Current_Index : Natural;
+ begin
+ if Position.Container = null then
+ Position := No_Element;
+ return;
+ end if;
+ Select_From := Keys (Position.Container.Connections);
+ Vector_Sort.Sort (Select_From);
+ Current_Index := Select_From.Find_Index (Position.Node);
+ if Current_Index = Node_Vectors.No_Index or
+ Current_Index = Select_From.Last_Index
+ then
+ Position := No_Element;
+ else
+ Position.Node := Select_From (Current_Index + 1);
+ end if;
end Next;
function Next
(Object : in Iterator;
Position : in Cursor)
- return Cursor is
+ return Cursor
+ is
+ Cursor_Copy : Cursor := Position;
begin
- return No_Element;
+ Next (Cursor_Copy);
+ return Cursor_Copy;
end Next;
function Next
(Object : in Subgraph_Iterator;
Position : in Cursor)
- return Cursor is
- begin
- return No_Element;
+ return Cursor
+ is
+ Next_Cursor : Cursor := Position;
+ Consider : Node_Vectors.Vector;
+ begin
+ if Position.Container = null then
+ return No_Element;
+ end if;
+ Next_Cursor.Visited.Append (Position.Node);
+ loop
+ Consider := Next_Cursor.Container.Connections.Constant_Reference (Next_Cursor.Node);
+ Vector_Sort.Sort (Consider);
+ for N of Consider loop
+ if not Next_Cursor.Visited.Contains (N) then
+ Next_Cursor.Path_Up.Append (Next_Cursor.Node);
+ Next_Cursor.Node := N;
+ return Next_Cursor;
+ end if;
+ end loop;
+ if Next_Cursor.Path_Up.Is_Empty then
+ return No_Element;
+ else
+ Next_Cursor.Node := Next_Cursor.Path_Up.Last_Element;
+ Next_Cursor.Path_Up.Delete_Last;
+ end if;
+ end loop;
end Next;
@@ -1031,7 +1685,23 @@ package body Directed_Graphs is
(Container : in Graph)
return Ada.Containers.Count_Type is
begin
- return Ada.Containers.Count_Type'First;
+ return Container.Connections.Length;
+ end Node_Count;
+
+ function Node_Count
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ is
+ use type Ada.Containers.Count_Type;
+ Result : Ada.Containers.Count_Type := 0;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for N in Position.Container.Iterate_Subgraph (Position) loop
+ Result := Result + 1;
+ end loop;
+ return Result;
end Node_Count;
@@ -1046,7 +1716,19 @@ package body Directed_Graphs is
Minimum : out Node_Type;
Maximum : out Node_Type) is
begin
- null;
+ if Impl.Checks and then Container.Is_Empty then
+ raise Constraint_Error with "Graph is empty";
+ end if;
+ Minimum := Node_Type'Last;
+ Maximum := Node_Type'First;
+ for C in Container.Connections.Iterate loop
+ if Node_Maps.Key (C) < Minimum then
+ Minimum := Node_Maps.Key (C);
+ end if;
+ if Node_Maps.Key (C) > Maximum then
+ Maximum := Node_Maps.Key (C);
+ end if;
+ end loop;
end Node_Range;
@@ -1058,9 +1740,26 @@ package body Directed_Graphs is
function Nodes
(Container : in Graph)
- return Node_Array is
+ return Node_Array
+ is
+ -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array);
begin
- return N : Node_Array (1 .. 0);
+ return Vector_To_Array (Keys (Container.Connections));
+ end Nodes;
+
+ function Nodes
+ (Position : in Cursor)
+ return Node_Array
+ is
+ Result : Node_Vectors.Vector;
+ begin
+ if Impl.Checks and then Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ for C in Position.Container.Iterate_Subgraph (Position) loop
+ Result.Append (C.Node);
+ end loop;
+ return Vector_To_Array (Result);
end Nodes;
@@ -1075,14 +1774,28 @@ package body Directed_Graphs is
Node : in Node_Type)
return Edge_Array is
begin
- return E : Edge_Array (1 .. 0);
+ if Impl.Checks and then not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ end if;
+ declare
+ Ref : Node_Maps.Constant_Reference_Type :=
+ Container.Connections.Constant_Reference (Node);
+ Result : Edge_Array (1 .. Ref.Last_Index);
+ begin
+ for I in Result'Range loop
+ Result (I) :=
+ (From => Node,
+ To => Node_Vectors.Element (Ref, I));
+ end loop;
+ return Result;
+ end;
end Outbound;
function Outbound
(Position : in Cursor)
return Edge_Array is
begin
- return E : Edge_Array (1 .. 0);
+ return Position.Container.Outbound (Position.Node);
end Outbound;
@@ -1097,14 +1810,18 @@ package body Directed_Graphs is
Node : in Node_Type)
return Ada.Containers.Count_Type is
begin
- return Ada.Containers.Count_Type'First;
+ if Impl.Checks and then not Container.Contains (Node) then
+ raise Constraint_Error with "Graph does not contain node";
+ else
+ return Container.Connections.Constant_Reference (Node).Length;
+ end if;
end Outdegree;
function Outdegree
(Position : in Cursor)
return Ada.Containers.Count_Type is
begin
- return Ada.Containers.Count_Type'First;
+ return Position.Container.Outdegree (Position.Node);
end Outdegree;
@@ -1117,16 +1834,28 @@ package body Directed_Graphs is
function Parents
(Container : in Graph;
Node : in Node_Type)
- return Node_Array is
- begin
- return N : Node_Array (1 .. 0);
+ return Node_Array
+ is
+ Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access);
+ Froms : Node_Vectors.Vector;
+ -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array);
+ begin
+ for C in Container.Connections.Iterate loop
+ for N of Container.Connections.Constant_Reference (C) loop
+ if N = Node then
+ Froms.Append (Node_Maps.Key (C));
+ exit;
+ end if;
+ end loop;
+ end loop;
+ return Vector_To_Array (Froms);
end Parents;
function Parents
(Position : in Cursor)
return Node_Array is
begin
- return N : Node_Array (1 .. 0);
+ return Position.Container.Parents (Position.Node);
end Parents;
@@ -1138,23 +1867,45 @@ package body Directed_Graphs is
function Previous
(Position : in Cursor)
- return Cursor is
+ return Cursor
+ is
+ Cursor_Copy : Cursor := Position;
begin
- return No_Element;
+ Previous (Cursor_Copy);
+ return Cursor_Copy;
end Previous;
procedure Previous
- (Position : in out Cursor) is
- begin
- null;
+ (Position : in out Cursor)
+ is
+ Select_From : Node_Vectors.Vector;
+ Current_Index : Natural;
+ begin
+ if Position.Container = null then
+ Position := No_Element;
+ return;
+ end if;
+ Select_From := Keys (Position.Container.Connections);
+ Vector_Sort.Sort (Select_From);
+ Current_Index := Select_From.Find_Index (Position.Node);
+ if Current_Index = Node_Vectors.No_Index or
+ Current_Index = Select_From.First_Index
+ then
+ Position := No_Element;
+ else
+ Position.Node := Select_From (Current_Index - 1);
+ end if;
end Previous;
function Previous
(Object : in Iterator;
Position : in Cursor)
- return Cursor is
+ return Cursor
+ is
+ Cursor_Copy : Cursor := Position;
begin
- return No_Element;
+ Previous (Cursor_Copy);
+ return Cursor_Copy;
end Previous;
@@ -1168,42 +1919,45 @@ package body Directed_Graphs is
(Stream : not null access Streams.Root_Stream_Type'Class;
Container : out Graph) is
begin
- null;
+ Container.Clear;
+ Node_Maps.Map'Read (Stream, Container.Connections);
+ Node_Label_Maps.Map'Read (Stream, Container.Node_Labels);
+ Edge_Label_Maps.Map'Read (Stream, Container.Edge_Labels);
end Read;
procedure Read
(Stream : not null access Streams.Root_Stream_Type'Class;
Position : out Cursor) is
begin
- null;
+ raise Program_Error with "Attempt to stream Graph cursor";
end Read;
procedure Read
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : out Node_Label_Constant_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Read;
procedure Read
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : out Node_Label_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Read;
procedure Read
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : out Edge_Label_Constant_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Read;
procedure Read
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : out Edge_Label_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Read;
@@ -1218,14 +1972,14 @@ package body Directed_Graphs is
Node : in Node_Type;
Label : in Node_Label_Type) is
begin
- null;
+ Container.Node_Labels.Replace (Node, Label);
end Replace_Label;
procedure Replace_Label
(Position : in out Cursor;
Label : in Node_Label_Type) is
begin
- null;
+ Position.Container.Replace_Label (Position.Node, Label);
end Replace_Label;
procedure Replace_Label
@@ -1233,7 +1987,7 @@ package body Directed_Graphs is
Edge : in Edge_Type;
Label : in Edge_Label_Type) is
begin
- null;
+ Container.Edge_Labels.Replace (Edge, Label);
end Replace_Label;
@@ -1245,15 +1999,63 @@ package body Directed_Graphs is
procedure Swap
(Container : in out Graph;
- Left, Right : in Node_Type) is
- begin
- null;
+ Left, Right : in Node_Type)
+ is
+ Temp_Label : Node_Label_Type;
+ Temp_Vector : Node_Vectors.Vector;
+ begin
+ if Impl.Checks then
+ if not Container.Contains (Left) then
+ raise Constraint_Error with "Graph does not contain left operand";
+ end if;
+ if not Container.Contains (Right) then
+ raise Constraint_Error with "Graph does not contain right operand";
+ end if;
+ end if;
+ -- Switch labels around, if present
+ if Container.Node_Labels.Contains (Left) then
+ Temp_Label := Container.Node_Labels.Element (Left);
+ if Container.Node_Labels.Contains (Right) then
+ Container.Node_Labels.Replace (Left, Container.Node_Labels.Element (Right));
+ Container.Node_Labels.Replace (Right, Temp_Label);
+ else
+ Container.Node_Labels.Insert (Right, Temp_Label);
+ Container.Node_Labels.Exclude (Left);
+ end if;
+ else
+ if Container.Node_Labels.Contains (Right) then
+ Container.Node_Labels.Insert (Left, Container.Node_Labels.Element (Right));
+ Container.Node_Labels.Exclude (Right);
+ end if;
+ end if;
+ -- Switch the nodes themselves around
+ Temp_Vector := Container.Connections.Element (Left);
+ Container.Connections.Replace (Left, Container.Connections.Element (Right));
+ Container.Connections.Replace (Right, Temp_Vector);
+ -- Switch the edge connections around
+ for V of Container.Connections loop
+ for N of V loop
+ if N = Left then
+ N := Right;
+ elsif N = Right then
+ N := Left;
+ end if;
+ end loop;
+ end loop;
end Swap;
procedure Swap
(Left, Right : in out Cursor) is
begin
- null;
+ if Impl.Checks then
+ if Left.Container = null then
+ raise Constraint_Error with "Left operand graph does not exist";
+ end if;
+ if Right.Container = null then
+ raise Constraint_Error with "Right operand graph does not exist";
+ end if;
+ end if;
+ Left.Container.Swap (Left.Node, Right.Node);
end Swap;
@@ -1268,7 +2070,15 @@ package body Directed_Graphs is
Node : in Node_Type)
return Cursor is
begin
- return No_Element;
+ if not Container.Connections.Contains (Node) then
+ return No_Element;
+ else
+ return
+ (Container => Container'Unrestricted_Access,
+ Node => Node,
+ Visited => Node_Vectors.Empty_Vector,
+ Path_Up => Node_Vectors.Empty_Vector);
+ end if;
end To_Cursor;
@@ -1281,9 +2091,37 @@ package body Directed_Graphs is
function To_Graph
(Nodes : in Node_Array;
Edges : in Edge_Array)
- return Graph is
- begin
- return Empty_Graph;
+ return Graph
+ is
+ Adj_Map : Node_Maps.Map;
+ begin
+ if Nodes'Length = 0 and Edges'Length = 0 then
+ return Empty_Graph;
+ end if;
+
+ for I in Positive range Nodes'First .. Nodes'Last loop
+ if Impl.Checks then
+ for J in Positive range I + 1 .. Nodes'Last loop
+ if Nodes (I) = Nodes (J) then
+ raise Constraint_Error with "Duplicate nodes in node array";
+ end if;
+ end loop;
+ end if;
+ Adj_Map.Insert (Nodes (I), Node_Vectors.Empty_Vector);
+ end loop;
+
+ for E of Edges loop
+ if Impl.Checks and then
+ (not Adj_Map.Contains (E.From) or not Adj_Map.Contains (E.To))
+ then
+ raise Constraint_Error with "Edge uses nodes not in graph";
+ end if;
+ Adj_Map.Reference (E.From).Append (E.To);
+ end loop;
+
+ return G : Graph :=
+ (Ada.Finalization.Controlled with
+ Connections => Adj_Map, others => <>);
end To_Graph;
@@ -1297,14 +2135,17 @@ package body Directed_Graphs is
(Node : in Node_Type)
return Ada.Containers.Hash_Type is
begin
- return Ada.Containers.Hash_Type'First;
+ return Ada.Containers.Hash_Type (Node_Type'Pos (Node));
end To_Hash;
function To_Hash
(Edge : in Edge_Type)
- return Ada.Containers.Hash_Type is
+ return Ada.Containers.Hash_Type
+ is
+ use type Ada.Containers.Hash_Type;
begin
- return Ada.Containers.Hash_Type'First;
+ return Ada.Containers.Hash_Type (Node_Type'Pos (Edge.From)) +
+ Ada.Containers.Hash_Type (Node_Type'Pos (Edge.To));
end To_Hash;
@@ -1317,10 +2158,82 @@ package body Directed_Graphs is
function Unused_Nodes
(Container : in Graph;
Count : in Positive := 1)
+ return Node_Array
+ is
+ Nodes : Node_Array (1 .. Count);
+ Used : Node_Vectors.Vector := Keys (Container.Connections);
+ Next_Node : Node_Type := Node_Type'First;
+ Vector_Index : Positive := 1;
+ Result_Index : Positive := 1;
+ begin
+ Vector_Sort.Sort (Used);
+ while Result_Index <= Nodes'Last loop
+ if Vector_Index > Used.Last_Index or else
+ Next_Node < Used (Vector_Index)
+ then
+ Nodes (Result_Index) := Next_Node;
+ if Impl.Checks and then
+ (Next_Node = Node_Type'Last and Result_Index < Nodes'Last)
+ then
+ raise Constraint_Error with "Not enough unused nodes";
+ else
+ Next_Node := Node_Type'Succ (Next_Node);
+ Result_Index := Result_Index + 1;
+ end if;
+ elsif Next_Node > Used (Vector_Index) then
+ Vector_Index := Vector_Index + 1;
+ else -- Next_Node = Used (Vector_Index
+ if Impl.Checks and then
+ Next_Node = Node_Type'Last
+ then
+ raise Constraint_Error with "Not enough unused nodes";
+ else
+ Next_Node := Node_Type'Succ (Next_Node);
+ end if;
+ end if;
+ end loop;
+ return Nodes;
+ end Unused_Nodes;
+
+
+
+
+ ---------------------
+ -- Vector_To_Array --
+ ---------------------
+
+ -- function Vector_To_Array
+ -- (Input : in Type_Vectors.Vector)
+ -- return Array_Type is
+ -- begin
+ -- return Result : Array_Type (1 .. Input.Last_Index) do
+ -- for I in Result'Range loop
+ -- Result (I) := Input (I);
+ -- end loop;
+ -- end return;
+ -- end Vector_To_Array;
+
+ function Vector_To_Array
+ (Input : in Node_Vectors.Vector)
return Node_Array is
begin
- return N : Node_Array (1 .. 0);
- end Unused_Nodes;
+ return Result : Node_Array (1 .. Input.Last_Index) do
+ for I in Result'Range loop
+ Result (I) := Input (I);
+ end loop;
+ end return;
+ end Vector_To_Array;
+
+ function Vector_To_Array
+ (Input : in Edge_Vectors.Vector)
+ return Edge_Array is
+ begin
+ return Result : Edge_Array (1 .. Input.Last_Index) do
+ for I in Result'Range loop
+ Result (I) := Input (I);
+ end loop;
+ end return;
+ end Vector_To_Array;
@@ -1333,42 +2246,44 @@ package body Directed_Graphs is
(Stream : not null access Streams.Root_Stream_Type'Class;
Container : in Graph) is
begin
- null;
+ Node_Maps.Map'Write (Stream, Container.Connections);
+ Node_Label_Maps.Map'Write (Stream, Container.Node_Labels);
+ Edge_Label_Maps.Map'Write (Stream, Container.Edge_Labels);
end Write;
procedure Write
(Stream : not null access Streams.Root_Stream_Type'Class;
Position : in Cursor) is
begin
- null;
+ raise Program_Error with "Attempt to stream Graph cursor";
end Write;
procedure Write
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : in Node_Label_Constant_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Write;
procedure Write
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : in Node_Label_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Write;
procedure Write
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : in Edge_Label_Constant_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Write;
procedure Write
(Stream : not null access Streams.Root_Stream_Type'Class;
Item : in Edge_Label_Reference) is
begin
- null;
+ raise Program_Error with "Attempt to stream reference";
end Write;
diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads
index 98b19af..73e34ff 100644
--- a/src/directed_graphs.ads
+++ b/src/directed_graphs.ads
@@ -63,6 +63,10 @@ package Directed_Graphs is
(Position : in Cursor)
return Boolean;
+ function Element
+ (Position : in Cursor)
+ return Node_Type;
+
package Graph_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
@@ -72,6 +76,10 @@ package Directed_Graphs is
(Left, Right : in Graph)
return Boolean;
+ function Isomorphic
+ (Left, Right : in Cursor)
+ return Boolean;
+
function To_Graph
(Nodes : in Node_Array;
Edges : in Edge_Array)
@@ -116,18 +124,34 @@ package Directed_Graphs is
(Container : in Graph)
return Ada.Containers.Count_Type;
+ function Node_Count
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type;
+
function Edge_Count
(Container : in Graph)
return Ada.Containers.Count_Type;
+ function Edge_Count
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type;
+
function Nodes
(Container : in Graph)
return Node_Array;
+ function Nodes
+ (Position : in Cursor)
+ return Node_Array;
+
function Edges
(Container : in Graph)
return Edge_Array;
+ function Edges
+ (Position : in Cursor)
+ return Edge_Array;
+
procedure Node_Range
(Container : in Graph;
Minimum : out Node_Type;
@@ -317,8 +341,8 @@ package Directed_Graphs is
with Implicit_Dereference => Element;
function Label_Reference
- (Container : in Graph;
- Node : in Node_Type)
+ (Container : aliased in out Graph;
+ Node : in Node_Type)
return Node_Label_Reference;
function Label_Reference
@@ -339,8 +363,8 @@ package Directed_Graphs is
with Implicit_Dereference => Element;
function Label_Reference
- (Container : in Graph;
- Edge : in Edge_Type)
+ (Container : aliased in out Graph;
+ Edge : in Edge_Type)
return Edge_Label_Reference;
function Neighbors
@@ -572,14 +596,23 @@ private
+ -- These need to be replaced with my own nested packages with
+ -- separate bodies, as Ada.Containers.Helpers is GNAT-specific
package Help renames Ada.Containers.Helpers;
package Impl is new Help.Generic_Implementation;
+
package Streams renames Ada.Streams;
package Node_Vectors is new Ada.Containers.Vectors
(Index_Type => Positive,
Element_Type => Node_Type);
+ package Vector_Sort is new Node_Vectors.Generic_Sorting;
+
+ package Edge_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Edge_Type);
+
function To_Hash
(Node : in Node_Type)
return Ada.Containers.Hash_Type;
@@ -619,9 +652,6 @@ private
Tamper_Info : aliased Help.Tamper_Counts;
end record;
- overriding procedure Adjust
- (Container : in out Graph);
-
overriding procedure Finalize
(Container : in out Graph);
@@ -645,6 +675,8 @@ private
type Cursor is record
Container : Graph_Access;
Node : Node_Type := Node_Type'First;
+ Visited : Node_Vectors.Vector;
+ Path_Up : Node_Vectors.Vector;
end record;
procedure Write
@@ -657,7 +689,11 @@ private
Position : out Cursor);
for Cursor'Read use Read;
- No_Element : constant Cursor := Cursor'(null, Node_Type'First);
+ No_Element : constant Cursor :=
+ (Container => null,
+ Node => Node_Type'First,
+ Visited => Node_Vectors.Empty_Vector,
+ Path_Up => Node_Vectors.Empty_Vector);
@@ -739,7 +775,6 @@ private
Graph_Iterator_Interfaces.Reversible_Iterator with
record
Container : Graph_Access;
- Node : Extended_Node_Type;
end record
with Disable_Controlled => not Impl.T_Check;
@@ -772,8 +807,6 @@ private
record
Container : Graph_Access;
Root_Node : Node_Type;
- Visited : Node_Vectors.Vector;
- Current : Extended_Node_Type;
end record
with Disable_Controlled => not Impl.T_Check;