From 65c9afbdc7daf588aaff505b2c148c4218f231d5 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 5 May 2020 21:14:51 +1000 Subject: Edges now have unique identifiers --- src/directed_graphs.adb | 761 +++++++++++++++++++++++++++--------------------- 1 file changed, 422 insertions(+), 339 deletions(-) (limited to 'src/directed_graphs.adb') diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index 4acf0fa..8b59051 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -25,7 +25,11 @@ package body Directed_Graphs is return Boolean is begin if Left.From = Right.From then - return Left.To < Right.To; + if Left.To = Right.To then + return Left.ID < Right.ID; + else + return Left.To < Right.To; + end if; else return Left.From < Right.From; end if; @@ -75,52 +79,13 @@ package body Directed_Graphs is - ------------ - -- Append -- - ------------ - - procedure Append - (Container : in out Graph; - Position : out Cursor) - is - Node : Node_Type := Node_Type'First; - Insert_Success : Boolean; - 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; - Impl.TC_Check (Container.Tamper_Info); - Container.Connections.Insert - (Node, Node_Vectors.Empty_Vector, Position.Place, Insert_Success); - if Impl.Checks and then not Insert_Success then - raise Program_Error with "Graph Insert failed"; - end if; - Position.Container := Container'Unrestricted_Access; - Position.Sub_Index := Node_Vectors.Extended_Index'First; - end Append; - - procedure Append - (Container : in out Graph; - Label : in Node_Label_Type; - Position : out Cursor) is - begin - Container.Append (Position); - Container.Node_Labels.Insert (Element (Position), Label); - end Append; - - - - ------------------ -- Append_Label -- ------------------ procedure Append_Label (Container : in out Graph; - Node : in Node_Type; + Node : in Node_ID_Type; Label : in Node_Label_Type) is begin if Impl.Checks then @@ -134,8 +99,8 @@ package body Directed_Graphs is end Append_Label; procedure Append_Label - (Position : in out Cursor; - Label : in Node_Label_Type) is + (Position : in Cursor; + Label : in Node_Label_Type) is begin if Impl.Checks then if Position.Container = null then @@ -164,28 +129,14 @@ package body Directed_Graphs is end Append_Label; procedure Append_Label - (Parent, Child : in out Cursor; - Label : in Edge_Label_Type) is + (Container : in Cursor; + Edge : in Edge_Type; + Label : in Edge_Label_Type) is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; - if Has_Label (Parent, Child) then - raise Constraint_Error with "Edge already has label"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - Parent.Container.Edge_Labels.Insert - ((From => Element (Parent), To => Element (Child)), Label); + Container.Container.Append_Label (Edge, Label); end Append_Label; @@ -211,22 +162,73 @@ package body Directed_Graphs is + ------------- + -- Between -- + ------------- + + function Between + (Container : in Graph; + Parent, Child : in Node_ID_Type) + return Edge_Array + is + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); + Result : Edge_Vectors.Vector; + begin + for E of Container.Outbound (Parent) loop + if E.To = Child then + Result.Append (E); + end if; + end loop; + return V2A (Result); + end Between; + + function Between + (Parent, Child : in Cursor) + return Edge_Array is + begin + if Impl.Checks then + if Parent.Container = null then + raise Constraint_Error with "Graph for parent cursor does not exist"; + end if; + if Child.Container = null then + raise Constraint_Error with "Graph for child cursor does not exist"; + end if; + if Parent.Container /= Child.Container then + raise Constraint_Error with "Parent and child cursors refer to different graphs"; + end if; + if not Has_Element (Parent) then + raise Constraint_Error with "Parent cursor points to nothing"; + end if; + if not Has_Element (Child) then + raise Constraint_Error with "Child cursor points to nothing"; + end if; + end if; + return Parent.Container.Between (Element (Parent), Element (Child)); + end Between; + + + + -------------- -- Children -- -------------- function Children (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Array is + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + Result : Node_Vectors.Vector; begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; - return V2A (Container.Connections.Constant_Reference (Node)); + for A of Container.Connections.Element (Node) loop + Result.Append (A.Node_ID); + end loop; + return V2A (Result); end Children; function Children @@ -283,7 +285,7 @@ package body Directed_Graphs is function Constant_Label_Reference (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Label_Constant_Reference is begin if Impl.Checks then @@ -347,38 +349,14 @@ package body Directed_Graphs is end Constant_Label_Reference; function Constant_Label_Reference - (Parent, Child : in Cursor) + (Container : in Cursor; + Edge : in Edge_Type) return Edge_Label_Constant_Reference is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; - if not Has_Label (Parent, Child) then - raise Constraint_Error with "Edge does not have a label"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - declare - Tamper : constant Help.Tamper_Counts_Access := - Parent.Container.Tamper_Info'Unrestricted_Access; - Edge : Edge_Type := ((From => Element (Parent), To => Element (Child))); - begin - return Ref : constant Edge_Label_Constant_Reference := - (Element => Parent.Container.Edge_Labels.Constant_Reference (Edge).Element, - Control => (Ada.Finalization.Controlled with Tamper)) - do - Impl.Lock (Tamper.all); - end return; - end; + return Container.Container.Constant_Label_Reference (Edge); end Constant_Label_Reference; @@ -390,7 +368,7 @@ package body Directed_Graphs is function Contains (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Boolean is begin return Container.Connections.Contains (Node); @@ -398,7 +376,7 @@ package body Directed_Graphs is function Contains (Container : in Graph; - Node : in Node_Type; + Node : in Node_ID_Type; Label : in Node_Label_Type) return Boolean is begin @@ -407,13 +385,29 @@ package body Directed_Graphs is Container.Node_Labels.Constant_Reference (Node) = Label; end Contains; + function Contains + (Container : in Graph; + Edge_ID : in Edge_ID_Type) + return Boolean is + begin + for N of Container.Connections loop + for A of N loop + if A.Edge_ID = Edge_ID then + return True; + end if; + end loop; + end loop; + return False; + end Contains; + function Contains (Container : in Graph; Edge : in Edge_Type) return Boolean is begin return Container.Connections.Contains (Edge.From) and then - Container.Connections.Constant_Reference (Edge.From).Contains (Edge.To); + Container.Connections.Constant_Reference (Edge.From).Contains + ((Edge_ID => Edge.ID, Node_ID => Edge.To)); end Contains; function Contains @@ -436,7 +430,7 @@ package body Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Node : in Node_Type) + Node : in Node_ID_Type) return Boolean is begin if Position.Container = null then @@ -452,7 +446,7 @@ package body Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Node : in Node_Type; + Node : in Node_ID_Type; Label : in Node_Label_Type) return Boolean is begin @@ -463,26 +457,38 @@ package body Directed_Graphs is Position.Container.Constant_Label_Reference (Node) = Label; end Contains_In_Subgraph; + function Contains_In_Subgraph + (Position : in Cursor; + Edge_ID : in Edge_ID_Type) + return Boolean is + begin + if Position.Container = null then + return False; + end if; + for C in Position.Container.Iterate_Subgraph (Position) loop + for E of Position.Container.Outbound (Element (C)) loop + if E.ID = Edge_ID then + return True; + end if; + end loop; + end loop; + return False; + end Contains_In_Subgraph; + function Contains_In_Subgraph (Position : in Cursor; Edge : in Edge_Type) - return Boolean - is - Parent_Check, Child_Check : Boolean := False; + return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if Element (C) = Edge.From then - Parent_Check := True; - end if; - if Element (C) = Edge.To then - Child_Check := True; - end if; - if Parent_Check and Child_Check then - return Position.Container.Contains (Edge); - end if; + for E of Position.Container.Outbound (Element (C)) loop + if E = Edge then + return True; + end if; + end loop; end loop; return False; end Contains_In_Subgraph; @@ -615,7 +621,7 @@ package body Directed_Graphs is function Cursor_To (Position : in Cursor; - Node : in Node_Type) + Node : in Node_ID_Type) return Cursor is begin if Impl.Checks then @@ -638,7 +644,7 @@ package body Directed_Graphs is function Degree (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Ada.Containers.Count_Type is begin return Container.Indegree (Node) + Container.Outdegree (Node); @@ -668,14 +674,14 @@ package body Directed_Graphs is procedure Delete (Container : in out Graph; - Node : in Node_Type) is + Node : in Node_ID_Type) is begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; Impl.TC_Check (Container.Tamper_Info); for N of Container.Connections.Constant_Reference (Node) loop - Container.Edge_Labels.Exclude ((From => Node, To => N)); + Container.Edge_Labels.Exclude ((ID => N.Edge_ID, From => Node, To => N.Node_ID)); end loop; Container.Connections.Delete (Node); Container.Node_Labels.Exclude (Node); @@ -685,9 +691,9 @@ package body Directed_Graphs is Container.Connections.Reference (C); begin for I in reverse 1 .. Ref.Last_Index loop - if Ref (I) = Node then + if Ref (I).Node_ID = Node then Container.Edge_Labels.Exclude - ((From => Node_Maps.Key (C), To => Node)); + ((ID => Ref (I).Edge_ID, From => Node_Maps.Key (C), To => Node)); Ref.Delete (I); end if; end loop; @@ -707,6 +713,7 @@ package body Directed_Graphs is end if; end if; Position.Container.Delete (Element (Position)); + Position := No_Element; end Delete; procedure Delete @@ -730,29 +737,18 @@ package body Directed_Graphs is Ref : Node_Maps.Reference_Type := Container.Connections.Reference (Edge.From); begin - Ref.Delete (Ref.Find_Index (Edge.To)); + Ref.Delete (Ref.Find_Index ((Edge_ID => Edge.ID, Node_ID => Edge.To))); end; end Delete; procedure Delete - (Parent, Child : in out Cursor) is + (Container : in Cursor; + Edge : in Edge_Type) is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - declare - Edge : Edge_Type := (From => Element (Parent), To => Element (Child)); - begin - Parent.Container.Delete (Edge); - end; + Container.Container.Delete (Edge); end Delete; procedure Delete @@ -773,7 +769,7 @@ package body Directed_Graphs is procedure Delete_Label (Container : in out Graph; - Node : in Node_Type) is + Node : in Node_ID_Type) is begin if Impl.Checks and then not Container.Node_Labels.Contains (Node) then raise Constraint_Error with "Node does not have label"; @@ -782,7 +778,7 @@ package body Directed_Graphs is end Delete_Label; procedure Delete_Label - (Position : in out Cursor) is + (Position : in Cursor) is begin if Impl.Checks then if Position.Container = null then @@ -806,24 +802,13 @@ package body Directed_Graphs is end Delete_Label; procedure Delete_Label - (Parent, Child : in out Cursor) is + (Container : in Cursor; + Edge : in Edge_Type) is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - Parent.Container.Delete_Label - ((From => Element (Parent), To => Element (Child))); + Container.Container.Delete_Label (Edge); end Delete_Label; @@ -875,6 +860,23 @@ package body Directed_Graphs is end Edge_Count; function Edge_Count + (Container : in Cursor) + return Ada.Containers.Count_Type is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Edge_Count; + end Edge_Count; + + + + + ---------------------------- + -- Edge_Count_In_Subgraph -- + ---------------------------- + + function Edge_Count_In_Subgraph (Position : in Cursor) return Ada.Containers.Count_Type is @@ -892,7 +894,7 @@ package body Directed_Graphs is Result := Result + Outdegree (Position); end loop; return Result; - end Edge_Count; + end Edge_Count_In_Subgraph; @@ -911,14 +913,32 @@ package body Directed_Graphs is 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)); + ((ID => N.Edge_ID, + From => Node_Maps.Key (C), + To => N.Node_ID)); end loop; end loop; return V2A (Tos); end Edges; function Edges + (Container : in Cursor) + return Edge_Array is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Edges; + end Edges; + + + + + ----------------------- + -- Edges_In_Subgraph -- + ----------------------- + + function Edges_In_Subgraph (Position : in Cursor) return Edge_Array is @@ -939,7 +959,7 @@ package body Directed_Graphs is end loop; end loop; return V2A (Tos); - end Edges; + end Edges_In_Subgraph; @@ -950,17 +970,20 @@ package body Directed_Graphs is function Element (Position : in Cursor) - return Node_Type is + return Extended_Node_ID_Type + is + use type Node_Maps.Cursor; begin - if Impl.Checks then - if Position.Container = null then - raise Constraint_Error with "Graph does not exist"; - end if; - if not Has_Element (Position) then - raise Constraint_Error with "Cursor points to nothing"; - end if; + if Impl.Checks and then Position.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + if Position.Place = Node_Maps.No_Element or else + not Position.Container.Contains (Node_Maps.Key (Position.Place)) + then + return No_Node; + else + return Node_Maps.Key (Position.Place); end if; - return Node_Maps.Key (Position.Place); end Element; @@ -1001,7 +1024,7 @@ package body Directed_Graphs is return Node_Array is Result : Node_Vectors.Vector; - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); begin for C in Container.Node_Labels.Iterate loop if Container.Node_Labels.Constant_Reference (C) = Label then @@ -1040,7 +1063,7 @@ package body Directed_Graphs is return Node_Array is Result : Node_Vectors.Vector; - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); begin if Impl.Checks then if Position.Container = null then @@ -1165,7 +1188,7 @@ package body Directed_Graphs is function Has_Edge (Container : in Graph; - Parent, Child : in Node_Type) + Parent, Child : in Node_ID_Type) return Boolean is begin if Impl.Checks then @@ -1175,7 +1198,12 @@ package body Directed_Graphs is raise Constraint_Error with "Graph does not contain child node"; end if; end if; - return Container.Contains ((From => Parent, To => Child)); + for N of Container.Connections.Constant_Reference (Parent) loop + if N.Node_ID = Child then + return True; + end if; + end loop; + return False; end Has_Edge; function Has_Edge @@ -1192,11 +1220,11 @@ package body Directed_Graphs is if Parent.Container /= Child.Container then raise Constraint_Error with "Parent and Child Graph mismatch"; end if; - if not Parent.Container.Contains (Element (Parent)) then - raise Constraint_Error with "Graph does not contain parent node"; + if not Has_Element (Parent) then + raise Constraint_Error with "Parent cursor points to nothing"; end if; - if not Child.Container.Contains (Element (Child)) then - raise Constraint_Error with "Graph does not contain child node"; + if not Has_Element (Child) then + raise Constraint_Error with "Child cursor points to nothing"; end if; end if; return Parent.Container.Has_Edge (Element (Parent), Element (Child)); @@ -1226,7 +1254,7 @@ package body Directed_Graphs is function Has_Label (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Boolean is begin return Container.Node_Labels.Contains (Node); @@ -1256,28 +1284,14 @@ package body Directed_Graphs is end Has_Label; function Has_Label - (Parent, Child : in Cursor) + (Container : in Cursor; + Edge : in Edge_Type) return Boolean is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Element (Parent) then - raise Constraint_Error with "Parent cursor points to nothing"; - end if; - if not Has_Element (Child) then - raise Constraint_Error with "Child cursor points to nothing"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - return Parent.Container.Edge_Labels.Contains - ((From => Element (Parent), To => Element (Child))); + return Container.Container.Edge_Labels.Contains (Edge); end Has_Label; @@ -1289,11 +1303,19 @@ package body Directed_Graphs is function Has_Labeled_Edge (Container : in Graph; - Parent, Child : Node_Type) + Parent, Child : Node_ID_Type) return Boolean is begin - return Container.Has_Edge (Parent, Child) and - Container.Has_Label ((From => Parent, To => Child)); + if Container.Has_Edge (Parent, Child) then + for C in Container.Edge_Labels.Iterate loop + if Edge_Label_Maps.Key (C).From = Parent and + Edge_Label_Maps.Key (C).To = Child + then + return True; + end if; + end loop; + end if; + return False; end Has_Labeled_Edge; function Has_Labeled_Edge @@ -1310,6 +1332,12 @@ package body Directed_Graphs is if Parent.Container /= Child.Container then raise Constraint_Error with "Parent and Child Graph mismatch"; end if; + if not Has_Element (Parent) then + raise Constraint_Error with "Parent cursor points to nothing"; + end if; + if not Has_Element (Child) then + raise Constraint_Error with "Child cursor points to nothing"; + end if; if not Parent.Container.Contains (Element (Parent)) then raise Constraint_Error with "Graph does not contain parent node"; end if; @@ -1329,7 +1357,7 @@ package body Directed_Graphs is function Has_Neighbor (Container : in Graph; - Left, Right : in Node_Type) + Left, Right : in Node_ID_Type) return Boolean is begin return Container.Has_Edge (Left, Right) and @@ -1369,7 +1397,7 @@ package body Directed_Graphs is function Inbound (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Edge_Array is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); @@ -1378,10 +1406,11 @@ package body Directed_Graphs is begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop - if N = Node then + if N.Node_ID = Node then Edges.Append - ((From => Node_Maps.Key (C), - To => N)); + ((ID => N.Edge_ID, + From => Node_Maps.Key (C), + To => N.Node_ID)); end if; end loop; end loop; @@ -1412,7 +1441,7 @@ package body Directed_Graphs is function Indegree (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Ada.Containers.Count_Type is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); @@ -1420,7 +1449,7 @@ package body Directed_Graphs is begin for C of Container.Connections loop for N of C loop - if N = Node then + if N.Node_ID = Node then Count := Count + 1; end if; end loop; @@ -1452,24 +1481,45 @@ package body Directed_Graphs is procedure Insert (Container : in out Graph; - Node : in Node_Type) is + Node : in Node_ID_Type) is begin if Impl.Checks and then Container.Contains (Node) then raise Constraint_Error with "Graph already contains node"; end if; Impl.TC_Check (Container.Tamper_Info); - Container.Connections.Insert (Node, Node_Vectors.Empty_Vector); + Container.Connections.Insert (Node, Adj_Vectors.Empty_Vector); end Insert; procedure Insert (Container : in out Graph; - Node : in Node_Type; + Node : in Node_ID_Type; Label : in Node_Label_Type) is begin Container.Insert (Node); Container.Node_Labels.Insert (Node, Label); end Insert; + procedure Insert + (Container : in Cursor; + Node : in Node_ID_Type) is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + Container.Container.Insert (Node); + end Insert; + + procedure Insert + (Container : in Cursor; + Node : in Node_ID_Type; + Label : in Node_Label_Type) is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + Container.Container.Insert (Node, Label); + end Insert; + procedure Insert (Container : in out Graph; Nodes : in Node_Array) is @@ -1491,7 +1541,8 @@ package body Directed_Graphs is raise Constraint_Error with "Graph does not contain head node of edge"; end if; end if; - Container.Connections.Reference (Edge.From).Append (Edge.To); + Container.Connections.Reference (Edge.From).Append + ((Edge_ID => Edge.ID, Node_ID => Edge.To)); end Insert; procedure Insert @@ -1504,35 +1555,24 @@ package body Directed_Graphs is end Insert; procedure Insert - (Parent, Child : in out Cursor) is + (Container : in Cursor; + Edge : in Edge_Type) is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Element (Parent) then - raise Constraint_Error with "Parent cursor points to nothing"; - end if; - if not Has_Element (Child) then - raise Constraint_Error with "Child cursor points to nothing"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - Parent.Container.Connections.Reference (Element (Parent)).Append (Element (Child)); + Container.Container.Insert (Edge); end Insert; procedure Insert - (Parent, Child : in out Cursor; - Label : in Edge_Label_Type) is + (Container : in Cursor; + Edge : in Edge_Type; + Label : in Edge_Label_Type) is begin - Insert (Parent, Child); - Parent.Container.Edge_Labels.Insert - ((From => Element (Parent), To => Element (Child)), Label); + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + Container.Container.Insert (Edge, Label); end Insert; procedure Insert @@ -1587,7 +1627,7 @@ package body Directed_Graphs is Position : in Cursor) return Graph_Iterator_Interfaces.Reversible_Iterator'Class is - Root_Node, Current_Node : Node_Type; + Root_Node, Current_Node : Node_ID_Type; Path_Up : Node_Vectors.Vector; Visited : Node_Vectors.Vector; begin @@ -1631,7 +1671,7 @@ package body Directed_Graphs is function Label (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Label_Type is begin if Impl.Checks then @@ -1675,25 +1715,14 @@ package body Directed_Graphs is end Label; function Label - (Parent, Child : in Cursor) + (Container : in Cursor; + Edge : in Edge_Type) return Edge_Label_Type is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - return Parent.Container.Edge_Labels.Element - ((From => Element (Parent), To => Element (Child))); + return Container.Container.Label (Edge); end Label; @@ -1705,7 +1734,7 @@ package body Directed_Graphs is function Label_Reference (Container : aliased in out Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Label_Reference is begin if Impl.Checks then @@ -1769,38 +1798,14 @@ package body Directed_Graphs is end Label_Reference; function Label_Reference - (Parent, Child : in Cursor) + (Container : in Cursor; + Edge : in Edge_Type) return Edge_Label_Reference is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors are for different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; - if not Has_Label (Parent, Child) then - raise Constraint_Error with "Edge does not have a label"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - declare - Tamper : constant Help.Tamper_Counts_Access := - Parent.Container.Tamper_Info'Unrestricted_Access; - Edge : Edge_Type := ((From => Element (Parent), To => Element (Child))); - begin - return Ref : constant Edge_Label_Reference := - (Element => Parent.Container.Edge_Labels.Reference (Edge).Element, - Control => (Ada.Finalization.Controlled with Tamper)) - do - Impl.Lock (Tamper.all); - end return; - end; + return Container.Container.Label_Reference (Edge); end Label_Reference; @@ -1876,23 +1881,31 @@ package body Directed_Graphs is function Neighbors (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Array is - Nodes : Node_Vectors.Vector; - Ref : Node_Maps.Constant_Reference_Type := - Container.Connections.Constant_Reference (Node); - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + Result : Node_Vectors.Vector; + To_Del : Boolean; + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); 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); + for N of Container.Connections.Constant_Reference (Node) loop + if not Result.Contains (N.Node_ID) then + Result.Append (N.Node_ID); + end if; + end loop; + for I in reverse 1 .. Result.Last_Index loop + To_Del := True; + for N of Container.Connections.Constant_Reference (Result (I)) loop + if N.Node_ID = Node then + To_Del := False; exit; end if; end loop; + if To_Del then + Result.Delete (I); + end if; end loop; - return V2A (Nodes); + return V2A (Result); end Neighbors; function Neighbors @@ -1997,6 +2010,23 @@ package body Directed_Graphs is end Node_Count; function Node_Count + (Container : in Cursor) + return Ada.Containers.Count_Type is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Connections.Length; + end Node_Count; + + + + + ---------------------------- + -- Node_Count_In_Subgraph -- + ---------------------------- + + function Node_Count_In_Subgraph (Position : in Cursor) return Ada.Containers.Count_Type is begin @@ -2014,7 +2044,7 @@ package body Directed_Graphs is begin return Subgraph_Iterator (It).Nodes.Length; end; - end Node_Count; + end Node_Count_In_Subgraph; @@ -2025,14 +2055,14 @@ package body Directed_Graphs is procedure Node_Range (Container : in Graph; - Minimum : out Node_Type; - Maximum : out Node_Type) is + Minimum : out Node_ID_Type; + Maximum : out Node_ID_Type) is begin 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; + Minimum := Node_ID_Type'Last; + Maximum := Node_ID_Type'First; for C in Container.Connections.Iterate loop if Node_Maps.Key (C) < Minimum then Minimum := Node_Maps.Key (C); @@ -2054,7 +2084,7 @@ package body Directed_Graphs is (Container : in Graph) return Node_Array is - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); Result : Node_Vectors.Vector; begin for C in Container.Connections.Iterate loop @@ -2064,11 +2094,28 @@ package body Directed_Graphs is end Nodes; function Nodes + (Container : in Cursor) + return Node_Array is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Nodes; + end Nodes; + + + + + ----------------------- + -- Nodes_In_Subgraph -- + ----------------------- + + function Nodes_In_Subgraph (Position : in Cursor) return Node_Array is Result : Node_Vectors.Vector; - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); begin if Impl.Checks then if Position.Container = null then @@ -2082,7 +2129,7 @@ package body Directed_Graphs is Result.Append (Element (C)); end loop; return V2A (Result); - end Nodes; + end Nodes_In_Subgraph; @@ -2093,7 +2140,7 @@ package body Directed_Graphs is function Outbound (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Edge_Array is begin if Impl.Checks and then not Container.Contains (Node) then @@ -2106,8 +2153,9 @@ package body Directed_Graphs is begin for I in Result'Range loop Result (I) := - (From => Node, - To => Node_Vectors.Element (Ref, I)); + (ID => Ref.Element.Element (I).Edge_ID, + From => Node, + To => Ref.Element.Element (I).Node_ID); end loop; return Result; end; @@ -2137,7 +2185,7 @@ package body Directed_Graphs is function Outdegree (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Ada.Containers.Count_Type is begin if Impl.Checks and then not Container.Contains (Node) then @@ -2171,16 +2219,16 @@ package body Directed_Graphs is function Parents (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Node_Array is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); Froms : Node_Vectors.Vector; - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop - if N = Node then + if N.Node_ID = Node and not Froms.Contains (Node_Maps.Key (C)) then Froms.Append (Node_Maps.Key (C)); exit; end if; @@ -2337,7 +2385,7 @@ package body Directed_Graphs is procedure Replace_Label (Container : in out Graph; - Node : in Node_Type; + Node : in Node_ID_Type; Label : in Node_Label_Type) is begin if Impl.Checks and then not Container.Contains (Node) then @@ -2347,8 +2395,8 @@ package body Directed_Graphs is end Replace_Label; procedure Replace_Label - (Position : in out Cursor; - Label : in Node_Label_Type) is + (Position : in Cursor; + Label : in Node_Label_Type) is begin if Impl.Checks then if Position.Container = null then @@ -2373,25 +2421,14 @@ package body Directed_Graphs is end Replace_Label; procedure Replace_Label - (Parent, Child : in out Cursor; - Label : in Edge_Label_Type) is + (Container : in Cursor; + Edge : in Edge_Type; + Label : in Edge_Label_Type) is begin - if Impl.Checks then - if Parent.Container = null then - raise Constraint_Error with "Graph for parent cursor does not exist"; - end if; - if Child.Container = null then - raise Constraint_Error with "Graph for child cursor does not exist"; - end if; - if Parent.Container /= Child.Container then - raise Constraint_Error with "Cursors belong to different graphs"; - end if; - if not Has_Edge (Parent, Child) then - raise Constraint_Error with "Graph does not contain edge"; - end if; + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; end if; - Parent.Container.Edge_Labels.Replace - ((From => Element (Parent), To => Element (Child)), Label); + Container.Container.Replace_Label (Edge, Label); end Replace_Label; @@ -2403,9 +2440,9 @@ package body Directed_Graphs is procedure Swap (Container : in out Graph; - Left, Right : in Node_Type) + Left, Right : in Node_ID_Type) is - Temp_Vector : Node_Vectors.Vector; + Temp_Vector : Adj_Vectors.Vector; begin if Impl.Checks then if not Container.Contains (Left) then @@ -2423,10 +2460,10 @@ package body Directed_Graphs is -- 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; + if N.Node_ID = Left then + N.Node_ID := Right; + elsif N.Node_ID = Right then + N.Node_ID := Left; end if; end loop; end loop; @@ -2458,7 +2495,7 @@ package body Directed_Graphs is function To_Cursor (Container : in Graph; - Node : in Node_Type) + Node : in Node_ID_Type) return Cursor is begin if not Container.Connections.Contains (Node) then @@ -2497,7 +2534,7 @@ package body Directed_Graphs is end if; end loop; end if; - Adj_Map.Insert (Nodes (I), Node_Vectors.Empty_Vector); + Adj_Map.Insert (Nodes (I), Adj_Vectors.Empty_Vector); end loop; for E of Edges loop @@ -2506,7 +2543,7 @@ package body Directed_Graphs is then raise Constraint_Error with "Edge uses nodes not in graph"; end if; - Adj_Map.Reference (E.From).Append (E.To); + Adj_Map.Reference (E.From).Append ((E.ID, E.To)); end loop; return G : Graph := @@ -2518,18 +2555,64 @@ package body Directed_Graphs is ------------------ - -- Unused_Nodes -- + -- Unused -- ------------------ - function Unused_Nodes + function Unused + (Container : in Graph) + return Node_ID_Type is + begin + for N in Node_ID_Type'First .. Node_ID_Type'Last loop + if not Container.Contains (N) then + return N; + end if; + end loop; + raise Constraint_Error with "No unused nodes available"; + return Extended_Node_ID_Type'First; + end Unused; + + function Unused + (Container : in Graph) + return Edge_ID_Type is + begin + for E in Edge_ID_Type'First .. Edge_ID_Type'Last loop + if not Container.Contains (E) then + return E; + end if; + end loop; + raise Constraint_Error with "No unused edges available"; + return Edge_ID_Type'First; + end Unused; + + function Unused + (Container : in Cursor) + return Node_ID_Type is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Unused (Container.Container.all); + end Unused; + + function Unused + (Container : in Cursor) + return Edge_ID_Type is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Unused (Container.Container.all); + end Unused; + + function Unused (Container : in Graph; Count : in Positive := 1) return Node_Array is - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); Nodes : Node_Vectors.Vector; begin - for N in Node_Type'First .. Node_Type'Last loop + for N in Node_ID_Type'First .. Node_ID_Type'Last loop if not Container.Contains (N) then Nodes.Append (N); end if; @@ -2539,7 +2622,7 @@ package body Directed_Graphs is end loop; raise Constraint_Error with "Not enough unused nodes"; return V2A (Nodes); - end Unused_Nodes; + end Unused; -- cgit