summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/directed_graphs.adb299
-rw-r--r--src/directed_graphs.ads101
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)