diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/directed_graphs.adb | 299 | ||||
| -rw-r--r-- | src/directed_graphs.ads | 101 |
2 files changed, 306 insertions, 94 deletions
diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index bacb040..d7185e4 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -370,27 +370,20 @@ package body Directed_Graphs is function Contains (Container : in Graph; - Node : in Extended_Node_ID_Type) + Node : in Node_ID_Type) return Boolean is begin - if Node = No_Node then - return False; - end if; return Container.Connections.Contains (Node); end Contains; function Contains (Container : in Graph; - Node : in Extended_Node_ID_Type; - Label : in Node_Label_Type) + LNode : in Labeled_Node_Type) return Boolean is begin - if Node = No_Node then - return False; - end if; - return Container.Contains (Node) and then - Container.Node_Labels.Contains (Node) and then - Container.Node_Labels.Constant_Reference (Node) = Label; + return Container.Contains (LNode.Node) and then + Container.Node_Labels.Contains (LNode.Node) and then + Container.Node_Labels.Constant_Reference (LNode.Node) = LNode.Label; end Contains; function Contains @@ -420,13 +413,12 @@ package body Directed_Graphs is function Contains (Container : in Graph; - Edge : in Edge_Type; - Label : in Edge_Label_Type) + LEdge : in Labeled_Edge_Type) return Boolean is begin - return Container.Contains (Edge) and then - Container.Edge_Labels.Contains (Edge) and then - Container.Edge_Labels.Constant_Reference (Edge) = Label; + return Container.Contains (LEdge.Edge) and then + Container.Edge_Labels.Contains (LEdge.Edge) and then + Container.Edge_Labels.Constant_Reference (LEdge.Edge) = LEdge.Label; end Contains; @@ -438,10 +430,10 @@ package body Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Node : in Extended_Node_ID_Type) + Node : in Node_ID_Type) return Boolean is begin - if Position.Container = null or Node = No_Node then + if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop @@ -454,16 +446,15 @@ package body Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Node : in Extended_Node_ID_Type; - Label : in Node_Label_Type) + LNode : in Labeled_Node_Type) return Boolean is begin - if Position.Container = null or Node = No_Node then + if Position.Container = null then return False; end if; - return Contains_In_Subgraph (Position, Node) and then - Position.Container.Has_Label (Node) and then - Position.Container.Constant_Label_Reference (Node) = Label; + return Contains_In_Subgraph (Position, LNode.Node) and then + Position.Container.Has_Label (LNode.Node) and then + Position.Container.Constant_Label_Reference (LNode.Node) = LNode.Label; end Contains_In_Subgraph; function Contains_In_Subgraph @@ -504,8 +495,7 @@ package body Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Edge : in Edge_Type; - Label : in Edge_Label_Type) + LEdge : in Labeled_Edge_Type) return Boolean is Parent_Check, Child_Check : Boolean := False; @@ -513,9 +503,9 @@ package body Directed_Graphs is if Position.Container = null then return False; end if; - return Contains_In_Subgraph (Position, Edge) and then - Position.Container.Has_Label (Edge) and then - Position.Container.Constant_Label_Reference (Edge) = Label; + return Contains_In_Subgraph (Position, LEdge.Edge) and then + Position.Container.Has_Label (LEdge.Edge) and then + Position.Container.Constant_Label_Reference (LEdge.Edge) = LEdge.Label; end Contains_In_Subgraph; @@ -609,6 +599,144 @@ package body Directed_Graphs is + ------------------- + -- Contains_Path -- + ------------------- + + function Contains_Path + (Container : in Graph; + Path : in Node_Path) + return Boolean is + begin + for Node of Path loop + if not Container.Contains (Node) then + return False; + end if; + end loop; + for Index in Path'First .. Path'Last - 1 loop + if not Container.Has_Edge (Path (Index), Path (Index + 1)) then + return False; + end if; + end loop; + return True; + end Contains_Path; + + function Contains_Path + (Container : in Cursor; + Path : in Node_Path) + return Boolean is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Contains_Path (Path); + end Contains_Path; + + function Contains_Path + (Container : in Graph; + Path : in Edge_Path) + return Boolean is + begin + for Edge of Path loop + if not Container.Contains (Edge) then + return False; + end if; + end loop; + for Index in Path'First .. Path'Last - 1 loop + if Path (Index).To /= Path (Index + 1).From then + return False; + end if; + end loop; + return True; + end Contains_Path; + + function Contains_Path + (Container : in Cursor; + Path : in Edge_Path) + return Boolean is + begin + if Impl.Checks and then Container.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + return Container.Container.Contains_Path (Path); + end Contains_Path; + + + + + ------------------------------- + -- Contains_Path_In_Subgraph -- + ------------------------------- + + function Contains_Path_In_Subgraph + (Position : in Cursor; + Path : in Node_Path) + return Boolean is + begin + if Impl.Checks and then Position.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + declare + Node_List : Node_Array := Nodes_In_Subgraph (Position); + Has_Node : Boolean; + begin + for Node of Path loop + Has_Node := False; + for Subgraph_Node of Node_List loop + if Node = Subgraph_Node then + Has_Node := True; + exit; + end if; + end loop; + if not Has_Node then + return False; + end if; + end loop; + for Index in Path'First .. Path'Last - 1 loop + if not Position.Container.Has_Edge (Path (Index), Path (Index + 1)) then + return False; + end if; + end loop; + return True; + end; + end Contains_Path_In_Subgraph; + + function Contains_Path_In_Subgraph + (Position : in Cursor; + Path : in Edge_Path) + return Boolean is + begin + if Impl.Checks and then Position.Container = null then + raise Constraint_Error with "Graph does not exist"; + end if; + declare + Edge_List : Edge_Array := Edges_In_Subgraph (Position); + Has_Edge : Boolean; + begin + for Edge of Path loop + Has_Edge := False; + for Subgraph_Edge of Edge_List loop + if Edge = Subgraph_Edge then + Has_Edge := True; + exit; + end if; + end loop; + if not Has_Edge then + return False; + end if; + end loop; + for Index in Path'First .. Path'Last - 1 loop + if Path (Index).To /= Path (Index + 1).From then + return False; + end if; + end loop; + return True; + end; + end Contains_Path_In_Subgraph; + + + + ---------- -- Copy -- ---------- @@ -1183,32 +1311,6 @@ package body Directed_Graphs is - ------------ - -- Follow -- - ------------ - - function Follow - (Position : in Cursor; - Edge : in Edge_Type) - return Cursor 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; - if Element (Position) /= Edge.From then - raise Constraint_Error with "Cursor is not at tail of edge"; - end if; - end if; - return Position.Container.To_Cursor (Edge.To); - end Follow; - - - - -------------- -- Has_Edge -- -------------- @@ -1519,11 +1621,10 @@ package body Directed_Graphs is procedure Insert (Container : in out Graph; - Node : in Node_ID_Type; - Label : in Node_Label_Type) is + LNode : in Labeled_Node_Type) is begin - Container.Insert (Node); - Container.Node_Labels.Insert (Node, Label); + Container.Insert (LNode.Node); + Container.Node_Labels.Insert (LNode.Node, LNode.Label); end Insert; procedure Insert @@ -1538,13 +1639,12 @@ package body Directed_Graphs is procedure Insert (Container : in Cursor; - Node : in Node_ID_Type; - Label : in Node_Label_Type) is + LNode : in Labeled_Node_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); + Container.Container.Insert (Labeled_Node_Type'(LNode.Node, LNode.Label)); end Insert; procedure Insert @@ -1558,6 +1658,15 @@ package body Directed_Graphs is procedure Insert (Container : in out Graph; + LNodes : in Labeled_Node_Array) is + begin + for N of LNodes loop + Container.Insert (N); + end loop; + end Insert; + + procedure Insert + (Container : in out Graph; Edge : in Edge_Type) is begin if Impl.Checks then @@ -1574,11 +1683,10 @@ package body Directed_Graphs is procedure Insert (Container : in out Graph; - Edge : in Edge_Type; - Label : in Edge_Label_Type) is + LEdge : in Labeled_Edge_Type) is begin - Container.Insert (Edge); - Container.Edge_Labels.Insert (Edge, Label); + Container.Insert (LEdge.Edge); + Container.Edge_Labels.Insert (LEdge.Edge, LEdge.Label); end Insert; procedure Insert @@ -1593,13 +1701,12 @@ package body Directed_Graphs is procedure Insert (Container : in Cursor; - Edge : in Edge_Type; - Label : in Edge_Label_Type) is + LEdge : in Labeled_Edge_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 (Edge, Label); + Container.Container.Insert (Labeled_Edge_Type'(LEdge.Edge, LEdge.Label)); end Insert; procedure Insert @@ -1611,6 +1718,15 @@ package body Directed_Graphs is end loop; end Insert; + procedure Insert + (Container : in out Graph; + LEdges : in Labeled_Edge_Array) is + begin + for E of LEdges loop + Container.Insert (E); + end loop; + end Insert; + @@ -2637,6 +2753,49 @@ package body Directed_Graphs is Connections => Adj_Map, others => <>); end To_Graph; + function To_Graph + (LNodes : in Labeled_Node_Array; + LEdges : in Labeled_Edge_Array) + return Graph + is + Adj_Map : Node_Maps.Map; + NLabel_Map : Node_Label_Maps.Map; + ELabel_Map : Edge_Label_Maps.Map; + begin + if LNodes'Length = 0 and LEdges'Length = 0 then + return Empty_Graph; + end if; + + for I in Positive range LNodes'First .. LNodes'Last loop + if Impl.Checks then + for J in Positive range I + 1 .. LNodes'Last loop + if LNodes (I).Node = LNodes (J).Node then + raise Constraint_Error with "Duplicate nodes in node array"; + end if; + end loop; + end if; + Adj_Map.Insert (LNodes (I).Node, Adj_Vectors.Empty_Vector); + NLabel_Map.Insert (LNodes (I).Node, LNodes (I).Label); + end loop; + + for E of LEdges loop + if Impl.Checks and then + (not Adj_Map.Contains (E.Edge.From) or not Adj_Map.Contains (E.Edge.To)) + then + raise Constraint_Error with "Edge uses nodes not in graph"; + end if; + Adj_Map.Reference (E.Edge.From).Append ((E.Edge.ID, E.Edge.To)); + ELabel_Map.Insert (E.Edge, E.Label); + end loop; + + return G : Graph := + (Ada.Finalization.Controlled with + Connections => Adj_Map, + Node_Labels => NLabel_Map, + Edge_Labels => ELabel_Map, + others => <>); + end To_Graph; + diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads index 3154f75..8be31a3 100644 --- a/src/directed_graphs.ads +++ b/src/directed_graphs.ads @@ -56,11 +56,18 @@ package Directed_Graphs is subtype Extended_Node_ID_Type is Node_ID_Type'Base range Node_ID_Type'Pred (Node_ID_Type'First) .. Node_ID_Type'Last; + type Labeled_Node_Type is record + Node : Node_ID_Type; + Label : Node_Label_Type; + end record; + No_Node : constant Extended_Node_ID_Type := Extended_Node_ID_Type'First; type Node_Array is array (Positive range <>) of Node_ID_Type; - subtype Path is Node_Array; + type Labeled_Node_Array is array (Positive range <>) of Labeled_Node_Type; + + subtype Node_Path is Node_Array; @@ -71,8 +78,20 @@ package Directed_Graphs is To : Node_ID_Type; end record; + type Labeled_Edge_Type is record + Edge : Edge_Type; + Label : Edge_Label_Type; + end record; + type Edge_Array is array (Positive range <>) of Edge_Type; + type Labeled_Edge_Array is array (Positive range <>) of Labeled_Edge_Type; + + subtype Edge_Path is Edge_Array + with Dynamic_Predicate => + (for all Index in Edge_Path'First .. Edge_Path'Last - 1 => + Edge_Path (Index).To = Edge_Path (Index + 1).From); + function "<" (Left, Right : in Edge_Type) return Boolean; @@ -109,6 +128,11 @@ package Directed_Graphs is Edges : in Edge_Array) return Graph; + function To_Graph + (LNodes : in Labeled_Node_Array; + LEdges : in Labeled_Edge_Array) + return Graph; + function To_Cursor (Container : in Graph; Node : in Node_ID_Type) @@ -227,8 +251,7 @@ package Directed_Graphs is procedure Insert (Container : in out Graph; - Node : in Node_ID_Type; - Label : in Node_Label_Type); + LNode : in Labeled_Node_Type); procedure Insert (Container : in Cursor; @@ -236,8 +259,7 @@ package Directed_Graphs is procedure Insert (Container : in Cursor; - Node : in Node_ID_Type; - Label : in Node_Label_Type); + LNode : in Labeled_Node_Type); procedure Insert (Container : in out Graph; @@ -245,12 +267,15 @@ package Directed_Graphs is procedure Insert (Container : in out Graph; + LNodes : in Labeled_Node_Array); + + procedure Insert + (Container : in out Graph; Edge : in Edge_Type); procedure Insert (Container : in out Graph; - Edge : in Edge_Type; - Label : in Edge_Label_Type); + LEdge : in Labeled_Edge_Type); procedure Insert (Container : in Cursor; @@ -258,13 +283,16 @@ package Directed_Graphs is procedure Insert (Container : in Cursor; - Edge : in Edge_Type; - Label : in Edge_Label_Type); + LEdge : in Labeled_Edge_Type); procedure Insert (Container : in out Graph; Edges : in Edge_Array); + procedure Insert + (Container : in out Graph; + LEdges : in Labeled_Edge_Array); + procedure Delete (Container : in out Graph; Node : in Node_ID_Type); @@ -582,13 +610,12 @@ package Directed_Graphs is function Contains (Container : in Graph; - Node : in Extended_Node_ID_Type) + Node : in Node_ID_Type) return Boolean; function Contains (Container : in Graph; - Node : in Extended_Node_ID_Type; - Label : in Node_Label_Type) + LNode : in Labeled_Node_Type) return Boolean; function Contains @@ -603,8 +630,7 @@ package Directed_Graphs is function Contains (Container : in Graph; - Edge : in Edge_Type; - Label : in Edge_Label_Type) + LEdge : in Labeled_Edge_Type) return Boolean; function Contains_Label @@ -619,13 +645,12 @@ package Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Node : in Extended_Node_ID_Type) + Node : in Node_ID_Type) return Boolean; function Contains_In_Subgraph (Position : in Cursor; - Node : in Extended_Node_ID_Type; - Label : in Node_Label_Type) + LNode : in Labeled_Node_Type) return Boolean; function Contains_In_Subgraph @@ -640,8 +665,7 @@ package Directed_Graphs is function Contains_In_Subgraph (Position : in Cursor; - Edge : in Edge_Type; - Label : in Edge_Label_Type) + LEdge : in Labeled_Edge_Type) return Boolean; function Contains_Label_In_Subgraph @@ -654,6 +678,36 @@ package Directed_Graphs is Label : in Edge_Label_Type) return Boolean; + function Contains_Path + (Container : in Graph; + Path : in Node_Path) + return Boolean; + + function Contains_Path + (Container : in Cursor; + Path : in Node_Path) + return Boolean; + + function Contains_Path + (Container : in Graph; + Path : in Edge_Path) + return Boolean; + + function Contains_Path + (Container : in Cursor; + Path : in Edge_Path) + return Boolean; + + function Contains_Path_In_Subgraph + (Position : in Cursor; + Path : in Node_Path) + return Boolean; + + function Contains_Path_In_Subgraph + (Position : in Cursor; + Path : in Edge_Path) + return Boolean; + @@ -678,6 +732,10 @@ package Directed_Graphs is (Position : in Cursor) return Boolean; + -- This will continue iterating until the Choice_Function returns a + -- No_Element Cursor, and any Cursors that the Filter_Function returns + -- False for are skipped over, so this can easily lead to infinite loops. + -- Be careful of which functions you select. function Iterate_By (Container : in Graph; Start : in Cursor; @@ -707,11 +765,6 @@ package Directed_Graphs is procedure Previous (Position : in out Cursor); - function Follow - (Position : in Cursor; - Edge : in Edge_Type) - return Cursor; - function Cursor_To (Position : in Cursor; Node : in Node_ID_Type) |