diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/directed_graphs.adb | 1337 | ||||
| -rw-r--r-- | src/directed_graphs.ads | 55 |
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; |