diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/directed_graphs.adb | 371 | ||||
| -rw-r--r-- | src/directed_graphs.ads | 11 |
2 files changed, 276 insertions, 106 deletions
diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index 93ad2cb..3914137 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -144,8 +144,13 @@ package body Directed_Graphs is (Position : in out Cursor; Label : in Node_Label_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; Position.Container.Append_Label (Element (Position), Label); end Append_Label; @@ -204,8 +209,13 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array 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.Container.Children (Element (Position)); end Children; @@ -277,6 +287,14 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Constant_Reference is 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; + end if; return Position.Container.Constant_Label_Reference (Element (Position)); end Constant_Label_Reference; @@ -383,12 +401,8 @@ package body Directed_Graphs is if Position.Container = null then return False; end if; - for C in Position.Container.Iterate_Subgraph (Position) loop - if Element (C) = Node and Constant_Label_Reference (C) = Label then - return True; - end if; - end loop; - return False; + return Contains_In_Subgraph (Position, Node) and then + Position.Container.Constant_Label_Reference (Node) = Label; end Contains_In_Subgraph; function Contains_In_Subgraph @@ -398,9 +412,7 @@ package body Directed_Graphs is is Parent_Check, Child_Check : Boolean := False; begin - if Position.Container = null or else - not Position.Container.Contains (Edge) - then + if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop @@ -411,7 +423,7 @@ package body Directed_Graphs is Child_Check := True; end if; if Parent_Check and Child_Check then - return True; + return Position.Container.Contains (Edge); end if; end loop; return False; @@ -425,23 +437,11 @@ package body Directed_Graphs is is Parent_Check, Child_Check : Boolean := False; begin - if Position.Container = null or else - not Position.Container.Contains (Edge, Label) - then + 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 True; - end if; - end loop; - return False; + return Contains_In_Subgraph (Position, Edge) and then + Position.Container.Constant_Label_Reference (Edge) = Label; end Contains_In_Subgraph; @@ -495,7 +495,9 @@ package body Directed_Graphs is return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop - if Position.Container.Node_Labels.Contains (Element (C)) then + if Position.Container.Has_Label (Element (C)) and then + Position.Container.Constant_Label_Reference (Element (C)) = Label + then return True; end if; end loop; @@ -522,7 +524,7 @@ package body Directed_Graphs is 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 + Position.Container.Edge_Labels.Constant_Reference (E) = Label then return True; end if; @@ -591,9 +593,7 @@ package body Directed_Graphs is function Degree (Container : in Graph; Node : in Node_Type) - return Ada.Containers.Count_Type - is - use type Ada.Containers.Count_Type; + return Ada.Containers.Count_Type is begin return Container.Indegree (Node) + Container.Outdegree (Node); end Degree; @@ -707,6 +707,9 @@ package body Directed_Graphs is (Container : in out Graph; Node : in Node_Type) is begin + if Impl.Checks and then not Container.Node_Labels.Contains (Node) then + raise Constraint_Error with "Node does not have label"; + end if; Container.Node_Labels.Delete (Node); end Delete_Label; @@ -728,6 +731,9 @@ package body Directed_Graphs is (Container : in out Graph; Edge : in Edge_Type) is begin + if Impl.Checks and then not Container.Edge_Labels.Contains (Edge) then + raise Constraint_Error with "Edge does not have label"; + end if; Container.Edge_Labels.Delete (Edge); end Delete_Label; @@ -742,7 +748,6 @@ package body Directed_Graphs is (Position : in out Cursor) is Nodes : Node_Vectors.Vector; - function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -750,7 +755,9 @@ package body Directed_Graphs is for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (Element (C)); end loop; - Position.Container.Delete (V2A (Nodes)); + for N of Nodes loop + Position.Container.Delete (N); + end loop; end Delete_Subgraph; @@ -764,7 +771,6 @@ package body Directed_Graphs is (Container : in Graph) 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 @@ -777,11 +783,15 @@ package body Directed_Graphs is (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"; + 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; for C in Position.Container.Iterate_Subgraph (Position) loop Result := Result + Outdegree (Position); @@ -820,11 +830,16 @@ package body Directed_Graphs is Tos : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop - for E of Outbound (Position) loop + for E of Outbound (C) loop Tos.Append (E); end loop; end loop; @@ -932,8 +947,13 @@ package body Directed_Graphs is Result : Node_Vectors.Vector; function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop if Position.Container.Node_Labels.Constant_Reference (Element (C)) = Label then @@ -951,20 +971,24 @@ package body Directed_Graphs is Nodes : Node_Vectors.Vector; Result : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); - function Keys is new Key_Vector (Edge_Type, Edge_Label_Type, Edge_Label_Maps, Edge_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (Element (C)); end loop; - for E of Keys (Position.Container.Edge_Labels) loop - if Nodes.Contains (E.From) and then - Nodes.Contains (E.To) and then + for E in Position.Container.Edge_Labels.Iterate loop + if Nodes.Contains (Edge_Label_Maps.Key (E).From) and then + Nodes.Contains (Edge_Label_Maps.Key (E).To) and then Position.Container.Edge_Labels.Constant_Reference (E) = Label then - Result.Append (E); + Result.Append (Edge_Label_Maps.Key (E)); end if; end loop; return V2A (Result); @@ -979,11 +1003,9 @@ package body Directed_Graphs is function First (Container : in Graph) - return Cursor - is - use type Ada.Containers.Count_Type; + return Cursor is begin - if Impl.Checks and then Container.Node_Count = 0 then + if Impl.Checks and then Container.Is_Empty then raise Constraint_Error with "Graph is empty"; end if; return @@ -1039,6 +1061,23 @@ package body Directed_Graphs is (Parent, Child : in Cursor) return Boolean is begin + if Impl.Checks then + if Parent.Container = null then + raise Constraint_Error with "Parent Graph does not exist"; + end if; + if Child.Container = null then + raise Constraint_Error with "Child Graph does not exist"; + end if; + 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"; + end if; + if not Child.Container.Contains (Element (Child)) then + raise Constraint_Error with "Graph does not contain child node"; + end if; + end if; return Parent.Container.Has_Edge (Element (Parent), Element (Child)); end Has_Edge; @@ -1076,6 +1115,14 @@ package body Directed_Graphs is (Position : in Cursor) return Boolean is 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; + end if; return Position.Container.Has_Label (Element (Position)); end Has_Label; @@ -1107,6 +1154,23 @@ package body Directed_Graphs is (Parent, Child : in Cursor) return Boolean is begin + if Impl.Checks then + if Parent.Container = null then + raise Constraint_Error with "Parent Graph does not exist"; + end if; + if Child.Container = null then + raise Constraint_Error with "Child Graph does not exist"; + end if; + 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"; + end if; + if not Child.Container.Contains (Element (Child)) then + raise Constraint_Error with "Graph does not contain child node"; + end if; + end if; return Parent.Container.Has_Labeled_Edge (Element (Parent), Element (Child)); end Has_Labeled_Edge; @@ -1130,6 +1194,23 @@ package body Directed_Graphs is (Left, Right : in Cursor) return Boolean is begin + 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; + if Left.Container /= Right.Container then + raise Constraint_Error with "Left and right operand Graph mismatch"; + end if; + if not Left.Container.Contains (Element (Left)) then + raise Constraint_Error with "Graph does not contain left operand node"; + end if; + if not Right.Container.Contains (Element (Right)) then + raise Constraint_Error with "Graph does not contain right operand node"; + end if; + end if; return Left.Container.Has_Neighbor (Element (Left), Element (Right)); end Has_Neighbor; @@ -1165,6 +1246,14 @@ package body Directed_Graphs is (Position : in Cursor) return Edge_Array is 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; + end if; return Position.Container.Inbound (Element (Position)); end Inbound; @@ -1180,7 +1269,6 @@ package body Directed_Graphs is Node : in Node_Type) 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 @@ -1198,6 +1286,14 @@ package body Directed_Graphs is (Position : in Cursor) return Ada.Containers.Count_Type is 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; + end if; return Position.Container.Indegree (Element (Position)); end Indegree; @@ -1309,7 +1405,7 @@ package body Directed_Graphs is function Iterate_Subgraph (Container : in Graph; Position : in Cursor) - return Graph_Iterator_Interfaces.Forward_Iterator'Class + return Graph_Iterator_Interfaces.Reversible_Iterator'Class is Root_Node, Current_Node : Node_Type; Path_Up : Node_Vectors.Vector; @@ -1338,6 +1434,7 @@ package body Directed_Graphs is end if; end loop Select_Next; end loop Depth_First; + Node_Sort.Sort (Visited); return It : Subgraph_Iterator do It.Container := Container'Unrestricted_Access; It.Nodes := Visited; @@ -1388,6 +1485,14 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Type is 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; + end if; return Position.Container.Label (Element (Position)); end Label; @@ -1442,6 +1547,14 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Label_Reference is 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; + end if; return Position.Container.Label_Reference (Element (Position)); end Label_Reference; @@ -1495,6 +1608,14 @@ package body Directed_Graphs is Children : out Node_Array; Label : out Node_Label_Type) is 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; + end if; Position.Container.Labeled_Context (Element (Position), Parents, Children, Label); end Labeled_Context; @@ -1588,6 +1709,14 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array is 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; + end if; return Position.Container.Neighbors (Element (Position)); end Neighbors; @@ -1625,6 +1754,9 @@ package body Directed_Graphs is is Cursor_Copy : Cursor := Position; begin + if Impl.Checks and then Object.Container /= Position.Container then + raise Constraint_Error with "Iterator and Cursor refer to different Graphs"; + end if; Next (Cursor_Copy); return Cursor_Copy; end Next; @@ -1637,6 +1769,9 @@ package body Directed_Graphs is use type Node_Maps.Cursor; Result : Cursor := Position; begin + if Impl.Checks and then Object.Container /= Position.Container then + raise Constraint_Error with "Iterator and Cursor refer to different Graphs"; + end if; if Position.Container = null or Position.Place = Node_Maps.No_Element then return No_Element; end if; @@ -1673,18 +1808,22 @@ package body Directed_Graphs is function Node_Count (Position : in Cursor) - return Ada.Containers.Count_Type - is - use type Ada.Containers.Count_Type; - Result : Ada.Containers.Count_Type := 0; + return Ada.Containers.Count_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; - for N in Position.Container.Iterate_Subgraph (Position) loop - Result := Result + 1; - end loop; - return Result; + declare + It : Graph_Iterator_Interfaces.Reversible_Iterator'Class := + Position.Container.Iterate_Subgraph (Position); + begin + return Subgraph_Iterator (It).Nodes.Length; + end; end Node_Count; @@ -1738,8 +1877,13 @@ package body Directed_Graphs is Result : Node_Vectors.Vector; function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop Result.Append (Element (C)); @@ -1780,6 +1924,14 @@ package body Directed_Graphs is (Position : in Cursor) return Edge_Array is 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; + end if; return Position.Container.Outbound (Element (Position)); end Outbound; @@ -1806,6 +1958,14 @@ package body Directed_Graphs is (Position : in Cursor) return Ada.Containers.Count_Type is 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; + end if; return Position.Container.Outdegree (Element (Position)); end Outdegree; @@ -1840,6 +2000,14 @@ package body Directed_Graphs is (Position : in Cursor) return Node_Array is 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; + end if; return Position.Container.Parents (Element (Position)); end Parents; @@ -1877,6 +2045,9 @@ package body Directed_Graphs is is Cursor_Copy : Cursor := Position; begin + if Impl.Checks and then Object.Container /= Position.Container then + raise Constraint_Error with "Iterator and Cursor refer to different Graphs"; + end if; Previous (Cursor_Copy); return Cursor_Copy; end Previous; @@ -1889,6 +2060,9 @@ package body Directed_Graphs is use type Node_Maps.Cursor; Result : Cursor := Position; begin + if Impl.Checks and then Object.Container /= Position.Container then + raise Constraint_Error with "Iterator and Cursor refer to different Graphs"; + end if; if Position.Container = null or Position.Place = Node_Maps.No_Element then return No_Element; end if; @@ -1973,6 +2147,9 @@ package body Directed_Graphs is Node : in Node_Type; Label : in Node_Label_Type) is begin + if Impl.Checks and then not Container.Contains (Node) then + raise Constraint_Error with "Graph does not contain node"; + end if; Container.Node_Labels.Replace (Node, Label); end Replace_Label; @@ -1980,6 +2157,14 @@ package body Directed_Graphs is (Position : in out Cursor; Label : in Node_Label_Type) is 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; + end if; Position.Container.Replace_Label (Element (Position), Label); end Replace_Label; @@ -1988,6 +2173,9 @@ package body Directed_Graphs is Edge : in Edge_Type; Label : in Edge_Label_Type) is begin + if Impl.Checks and then not Container.Contains (Edge) then + raise Constraint_Error with "Graph does not contain edge"; + end if; Container.Edge_Labels.Replace (Edge, Label); end Replace_Label; @@ -2136,40 +2324,19 @@ package body Directed_Graphs is Count : in Positive := 1) return Node_Array is - function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); - 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 - Node_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; + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + Nodes : Node_Vectors.Vector; + begin + for N in Node_Type'First .. Node_Type'Last loop + if not Container.Contains (N) then + Nodes.Append (N); + end if; + if Integer (Nodes.Length) = Count then + return V2A (Nodes); end if; end loop; - return Nodes; + raise Constraint_Error with "Not enough unused nodes"; + return V2A (Nodes); end Unused_Nodes; diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads index 7039d76..c4d48f7 100644 --- a/src/directed_graphs.ads +++ b/src/directed_graphs.ads @@ -560,14 +560,18 @@ package Directed_Graphs is + -- Iterates through all Nodes in the Graph in order of Node_Type. function Iterate (Container : in Graph) return Graph_Iterator_Interfaces.Reversible_Iterator'Class; + -- Iterates through all reachable Nodes in the subgraph in order + -- of Node_Type. Note that this is NOT the same as the order of + -- either breadth first or depth first search. function Iterate_Subgraph (Container : in Graph; Position : in Cursor) - return Graph_Iterator_Interfaces.Forward_Iterator'Class; + return Graph_Iterator_Interfaces.Reversible_Iterator'Class; function First (Container : in Graph) @@ -627,9 +631,8 @@ private (Index_Type => Positive, Element_Type => Node_Type); - function "=" - (Left, Right : in Node_Vectors.Vector) - return Boolean renames Node_Vectors."="; + use type Node_Vectors.Vector; + use type Ada.Containers.Count_Type; package Node_Sort is new Node_Vectors.Generic_Sorting; |