From 0966aadcc0e95ddb1fc5e3edfbefe0aaf64d2f76 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 29 Apr 2020 00:20:09 +1000 Subject: Rough refactor of Cursors and Iterators --- src/directed_graphs.adb | 329 +++++++++++++++++++++++++++++------------------- src/directed_graphs.ads | 25 ++-- 2 files changed, 217 insertions(+), 137 deletions(-) (limited to 'src') diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index a17f1d4..93ad2cb 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -92,6 +92,7 @@ package body Directed_Graphs is 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 @@ -99,9 +100,13 @@ package body Directed_Graphs is end if; Node := Node_Type'Succ (Node); end loop; - Container.Connections.Insert (Node, Node_Vectors.Empty_Vector); + 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.Node := Node; + Position.Sub_Index := Node_Vectors.Extended_Index'First; end Append; procedure Append @@ -110,7 +115,7 @@ package body Directed_Graphs is Position : out Cursor) is begin Container.Append (Position); - Container.Node_Labels.Insert (Position.Node, Label); + Container.Node_Labels.Insert (Element (Position), Label); end Append; @@ -139,7 +144,10 @@ package body Directed_Graphs is (Position : in out Cursor; Label : in Node_Label_Type) is begin - Position.Container.Append_Label (Position.Node, Label); + if Impl.Checks and then Position.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + Position.Container.Append_Label (Element (Position), Label); end Append_Label; procedure Append_Label @@ -196,7 +204,10 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array is begin - return Position.Container.Children (Position.Node); + if Impl.Checks and then Position.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Position.Container.Children (Element (Position)); end Children; @@ -266,7 +277,7 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Constant_Reference is begin - return Position.Container.Constant_Label_Reference (Position.Node); + return Position.Container.Constant_Label_Reference (Element (Position)); end Constant_Label_Reference; function Constant_Label_Reference @@ -356,7 +367,7 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if C.Node = Node then + if Element (C) = Node then return True; end if; end loop; @@ -373,7 +384,7 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if C.Node = Node and Constant_Label_Reference (C) = Label then + if Element (C) = Node and Constant_Label_Reference (C) = Label then return True; end if; end loop; @@ -393,10 +404,10 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if C.Node = Edge.From then + if Element (C) = Edge.From then Parent_Check := True; end if; - if C.Node = Edge.To then + if Element (C) = Edge.To then Child_Check := True; end if; if Parent_Check and Child_Check then @@ -420,10 +431,10 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if C.Node = Edge.From then + if Element (C) = Edge.From then Parent_Check := True; end if; - if C.Node = Edge.To then + if Element (C) = Edge.To then Child_Check := True; end if; if Parent_Check and Child_Check then @@ -484,7 +495,7 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if Position.Container.Node_Labels.Contains (C.Node) then + if Position.Container.Node_Labels.Contains (Element (C)) then return True; end if; end loop; @@ -505,7 +516,7 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - Inside.Append (C.Node); + Inside.Append (Element (C)); end loop; for E in Position.Container.Edge_Labels.Iterate loop Check := Edge_Label_Maps.Key (E); @@ -541,7 +552,15 @@ package body Directed_Graphs is Parents : out Node_Array; Children : out Node_Array) is begin - Position.Container.Context (Position.Node, Parents, Children); + 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; + end if; + Position.Container.Context (Element (Position), Parents, Children); end Context; @@ -583,7 +602,15 @@ package body Directed_Graphs is (Position : in Cursor) return Ada.Containers.Count_Type is begin - return Position.Container.Degree (Position.Node); + 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; + end if; + return Position.Container.Degree (Element (Position)); end Degree; @@ -624,7 +651,15 @@ package body Directed_Graphs is procedure Delete (Position : in out Cursor) is begin - Position.Container.Delete (Position.Node); + 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; + end if; + Position.Container.Delete (Element (Position)); end Delete; procedure Delete @@ -678,7 +713,15 @@ package body Directed_Graphs is procedure Delete_Label (Position : in out Cursor) is begin - Position.Container.Delete_Label (Position.Node); + 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; + end if; + Position.Container.Delete_Label (Element (Position)); end Delete_Label; procedure Delete_Label @@ -705,7 +748,7 @@ package body Directed_Graphs is raise Constraint_Error with "Graph does not exist"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - Nodes.Append (C.Node); + Nodes.Append (Element (C)); end loop; Position.Container.Delete (V2A (Nodes)); end Delete_Subgraph; @@ -799,10 +842,15 @@ package body Directed_Graphs is (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"; + 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; end if; - return Position.Node; + return Node_Maps.Key (Position.Place); end Element; @@ -888,8 +936,8 @@ package body Directed_Graphs is 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); + if Position.Container.Node_Labels.Constant_Reference (Element (C)) = Label then + Result.Append (Element (C)); end if; end loop; return V2A (Result); @@ -909,7 +957,7 @@ package body Directed_Graphs is raise Constraint_Error with "Graph does not exist"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - Nodes.Append (C.Node); + Nodes.Append (Element (C)); end loop; for E of Keys (Position.Container.Edge_Labels) loop if Nodes.Contains (E.From) and then @@ -934,22 +982,14 @@ package body Directed_Graphs is return Cursor is use type Ada.Containers.Count_Type; - Node : Node_Type := Node_Type'Last; - function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); 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); + Place => Container.Connections.First, + Sub_Index => Node_Vectors.Extended_Index'First); end First; function First @@ -963,11 +1003,14 @@ package body Directed_Graphs is (Object : in Subgraph_Iterator) return Cursor is begin - return - (Container => Object.Container, - Node => Object.Root_Node, - Visited => Node_Vectors.Empty_Vector, - Path_Up => Node_Vectors.Empty_Vector); + if Object.Nodes.Is_Empty then + return No_Element; + else + return + (Container => Object.Container, + Place => Object.Container.Connections.Find (Object.Nodes.First_Element), + Sub_Index => Object.Nodes.First_Index); + end if; end First; @@ -996,7 +1039,7 @@ package body Directed_Graphs is (Parent, Child : in Cursor) return Boolean is begin - return Parent.Container.Has_Edge (Parent.Node, Child.Node); + return Parent.Container.Has_Edge (Element (Parent), Element (Child)); end Has_Edge; @@ -1011,7 +1054,7 @@ package body Directed_Graphs is return Boolean is begin return Position.Container /= null and then - Position.Container.Contains (Position.Node); + Position.Container.Contains (Node_Maps.Key (Position.Place)); end Has_Element; @@ -1033,7 +1076,7 @@ package body Directed_Graphs is (Position : in Cursor) return Boolean is begin - return Position.Container.Has_Label (Position.Node); + return Position.Container.Has_Label (Element (Position)); end Has_Label; function Has_Label @@ -1064,7 +1107,7 @@ package body Directed_Graphs is (Parent, Child : in Cursor) return Boolean is begin - return Parent.Container.Has_Labeled_Edge (Parent.Node, Child.Node); + return Parent.Container.Has_Labeled_Edge (Element (Parent), Element (Child)); end Has_Labeled_Edge; @@ -1087,7 +1130,7 @@ package body Directed_Graphs is (Left, Right : in Cursor) return Boolean is begin - return Left.Container.Has_Neighbor (Left.Node, Right.Node); + return Left.Container.Has_Neighbor (Element (Left), Element (Right)); end Has_Neighbor; @@ -1122,7 +1165,7 @@ package body Directed_Graphs is (Position : in Cursor) return Edge_Array is begin - return Position.Container.Inbound (Position.Node); + return Position.Container.Inbound (Element (Position)); end Inbound; @@ -1155,7 +1198,7 @@ package body Directed_Graphs is (Position : in Cursor) return Ada.Containers.Count_Type is begin - return Position.Container.Indegree (Position.Node); + return Position.Container.Indegree (Element (Position)); end Indegree; @@ -1266,11 +1309,38 @@ package body Directed_Graphs is function Iterate_Subgraph (Container : in Graph; Position : in Cursor) - return Graph_Iterator_Interfaces.Forward_Iterator'Class is + return Graph_Iterator_Interfaces.Forward_Iterator'Class + is + Root_Node, Current_Node : Node_Type; + Path_Up : Node_Vectors.Vector; + Visited : Node_Vectors.Vector; begin + if Impl.Checks and then not Has_Element (Position) then + raise Constraint_Error with "Cursor points to nothing"; + end if; + Root_Node := Element (Position); + Current_Node := Root_Node; + Depth_First : loop + Visited.Append (Current_Node); + Select_Next : loop + for N of Container.Children (Current_Node) loop + if not Visited.Contains (N) then + Path_Up.Append (Current_Node); + Current_Node := N; + exit Select_Next; + end if; + end loop; + if Path_Up.Is_Empty then + exit Depth_First; + else + Current_Node := Path_Up.Last_Element; + Path_Up.Delete_Last; + end if; + end loop Select_Next; + end loop Depth_First; return It : Subgraph_Iterator do It.Container := Container'Unrestricted_Access; - It.Root_Node := Position.Node; + It.Nodes := Visited; end return; end Iterate_Subgraph; @@ -1318,7 +1388,7 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Type is begin - return Position.Container.Label (Position.Node); + return Position.Container.Label (Element (Position)); end Label; function Label @@ -1372,7 +1442,7 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Reference is begin - return Position.Container.Label_Reference (Position.Node); + return Position.Container.Label_Reference (Element (Position)); end Label_Reference; function Label_Reference @@ -1425,7 +1495,7 @@ package body Directed_Graphs is Children : out Node_Array; Label : out Node_Label_Type) is begin - Position.Container.Labeled_Context (Position.Node, Parents, Children, Label); + Position.Container.Labeled_Context (Element (Position), Parents, Children, Label); end Labeled_Context; @@ -1437,25 +1507,16 @@ package body Directed_Graphs is function Last (Container : in Graph) - return Cursor - is - use type Ada.Containers.Count_Type; - Node : Node_Type := Node_Type'First; - function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); + return Cursor is begin - if Impl.Checks and then Container.Node_Count = 0 then - raise Constraint_Error with "Graph is empty"; + if Container.Is_Empty then + return No_Element; + else + return + (Container => Container'Unrestricted_Access, + Place => Container.Connections.Last, + Sub_Index => Node_Vectors.Extended_Index'First); 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 @@ -1465,6 +1526,20 @@ package body Directed_Graphs is return Object.Container.Last; end Last; + function Last + (Object : in Subgraph_Iterator) + return Cursor is + begin + if Object.Nodes.Is_Empty then + return No_Element; + else + return + (Container => Object.Container, + Place => Object.Container.Connections.Find (Object.Nodes.Last_Element), + Sub_Index => Object.Nodes.Last_Index); + end if; + end Last; + @@ -1513,7 +1588,7 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array is begin - return Position.Container.Neighbors (Position.Node); + return Position.Container.Neighbors (Element (Position)); end Neighbors; @@ -1534,26 +1609,13 @@ package body Directed_Graphs is end Next; procedure Next - (Position : in out Cursor) - is - Select_From : Node_Vectors.Vector; - Current_Index : Natural; - function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); + (Position : in out Cursor) is begin if Position.Container = null then Position := No_Element; return; end if; - Select_From := Keys (Position.Container.Connections); - Node_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; + Node_Maps.Next (Position.Place); end Next; function Next @@ -1572,30 +1634,27 @@ package body Directed_Graphs is Position : in Cursor) return Cursor is - Next_Cursor : Cursor := Position; - Consider : Node_Vectors.Vector; + use type Node_Maps.Cursor; + Result : Cursor := Position; begin - if Position.Container = null then + if Position.Container = null or Position.Place = Node_Maps.No_Element then return No_Element; end if; - Next_Cursor.Visited.Append (Position.Node); - loop - Consider := Next_Cursor.Container.Connections.Constant_Reference (Next_Cursor.Node); - Node_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 + if Position.Sub_Index not in 1 .. Object.Nodes.Last_Index or else + Node_Maps.Key (Position.Place) /= Object.Nodes (Position.Sub_Index) + then + Result.Sub_Index := Object.Nodes.Find_Index (Node_Maps.Key (Position.Place)); + if Result.Sub_Index = Node_Vectors.No_Index 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 if; + if Result.Sub_Index = Object.Nodes.Last_Index then + return No_Element; + else + Result.Sub_Index := Result.Sub_Index + 1; + Result.Place := Result.Container.Connections.Find (Object.Nodes (Result.Sub_Index)); + return Result; + end if; end Next; @@ -1683,7 +1742,7 @@ package body Directed_Graphs is raise Constraint_Error with "Graph does not exist"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - Result.Append (C.Node); + Result.Append (Element (C)); end loop; return V2A (Result); end Nodes; @@ -1721,7 +1780,7 @@ package body Directed_Graphs is (Position : in Cursor) return Edge_Array is begin - return Position.Container.Outbound (Position.Node); + return Position.Container.Outbound (Element (Position)); end Outbound; @@ -1747,7 +1806,7 @@ package body Directed_Graphs is (Position : in Cursor) return Ada.Containers.Count_Type is begin - return Position.Container.Outdegree (Position.Node); + return Position.Container.Outdegree (Element (Position)); end Outdegree; @@ -1781,7 +1840,7 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array is begin - return Position.Container.Parents (Position.Node); + return Position.Container.Parents (Element (Position)); end Parents; @@ -1802,26 +1861,13 @@ package body Directed_Graphs is end Previous; procedure Previous - (Position : in out Cursor) - is - Select_From : Node_Vectors.Vector; - Current_Index : Natural; - function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); + (Position : in out Cursor) is begin if Position.Container = null then Position := No_Element; return; end if; - Select_From := Keys (Position.Container.Connections); - Node_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; + Node_Maps.Previous (Position.Place); end Previous; function Previous @@ -1835,6 +1881,34 @@ package body Directed_Graphs is return Cursor_Copy; end Previous; + function Previous + (Object : in Subgraph_Iterator; + Position : in Cursor) + return Cursor + is + use type Node_Maps.Cursor; + Result : Cursor := Position; + begin + if Position.Container = null or Position.Place = Node_Maps.No_Element then + return No_Element; + end if; + if Position.Sub_Index not in 1 .. Object.Nodes.Last_Index or else + Node_Maps.Key (Position.Place) /= Object.Nodes (Position.Sub_Index) + then + Result.Sub_Index := Object.Nodes.Find_Index (Node_Maps.Key (Position.Place)); + if Result.Sub_Index = Node_Vectors.No_Index then + return No_Element; + end if; + end if; + if Result.Sub_Index = Object.Nodes.First_Index then + return No_Element; + else + Result.Sub_Index := Result.Sub_Index - 1; + Result.Place := Result.Container.Connections.Find (Object.Nodes (Result.Sub_Index)); + return Result; + end if; + end Previous; + @@ -1906,7 +1980,7 @@ package body Directed_Graphs is (Position : in out Cursor; Label : in Node_Label_Type) is begin - Position.Container.Replace_Label (Position.Node, Label); + Position.Container.Replace_Label (Element (Position), Label); end Replace_Label; procedure Replace_Label @@ -1982,7 +2056,7 @@ package body Directed_Graphs is raise Constraint_Error with "Right operand graph does not exist"; end if; end if; - Left.Container.Swap (Left.Node, Right.Node); + Left.Container.Swap (Element (Left), Element (Right)); end Swap; @@ -2002,9 +2076,8 @@ package body Directed_Graphs is else return (Container => Container'Unrestricted_Access, - Node => Node, - Visited => Node_Vectors.Empty_Vector, - Path_Up => Node_Vectors.Empty_Vector); + Place => Container.Connections.Find (Node), + Sub_Index => Node_Vectors.Extended_Index'First); end if; end To_Cursor; diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads index 77d9850..7039d76 100644 --- a/src/directed_graphs.ads +++ b/src/directed_graphs.ads @@ -682,9 +682,8 @@ private type Cursor is record Container : Graph_Access; - Node : Node_Type := Node_Type'First; - Visited : Node_Vectors.Vector; - Path_Up : Node_Vectors.Vector; + Place : Node_Maps.Cursor; + Sub_Index : Node_Vectors.Extended_Index; end record; procedure Write @@ -698,10 +697,9 @@ private for Cursor'Read use Read; No_Element : constant Cursor := - (Container => null, - Node => Node_Type'First, - Visited => Node_Vectors.Empty_Vector, - Path_Up => Node_Vectors.Empty_Vector); + (Container => null, + Place => Node_Maps.No_Element, + Sub_Index => Node_Vectors.Extended_Index'First); @@ -811,10 +809,10 @@ private type Subgraph_Iterator is new Ada.Finalization.Limited_Controlled and - Graph_Iterator_Interfaces.Forward_Iterator with + Graph_Iterator_Interfaces.Reversible_Iterator with record Container : Graph_Access; - Root_Node : Node_Type; + Nodes : Node_Vectors.Vector; end record with Disable_Controlled => not Impl.T_Check; @@ -825,11 +823,20 @@ private (Object : in Subgraph_Iterator) return Cursor; + overriding function Last + (Object : in Subgraph_Iterator) + return Cursor; + overriding function Next (Object : in Subgraph_Iterator; Position : in Cursor) return Cursor; + overriding function Previous + (Object : in Subgraph_Iterator; + Position : in Cursor) + return Cursor; + end Directed_Graphs; -- cgit