package body Directed_Graphs is pragma Warnings (Off, "variable ""Busy*"" is not referenced"); pragma Warnings (Off, "variable ""Lock*"" is not referenced"); -- See comment in Ada.Containers.Helpers generic type Base_Type is private; type Ignore_Element is private; with package Key_Maps is new Ada.Containers.Ordered_Maps (Key_Type => Base_Type, Element_Type => Ignore_Element, others => <>); with package Type_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Base_Type); function Key_Vector (My_Map : in Key_Maps.Map) return Type_Vectors.Vector; generic type Base_Type is private; type Array_Type is array (Positive range <>) of Base_Type; with package Type_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Base_Type); function Vector_To_Array (Input : in Type_Vectors.Vector) return Array_Type; --------- -- "<" -- --------- function "<" (Left, Right : in Edge_Type) return Boolean is begin if Left.From = Right.From then return Left.To < Right.To; else return Left.From < Right.From; end if; end "<"; --------- -- "=" -- --------- overriding function "=" (Left, Right : in Graph) return Boolean is use type Node_Maps.Map; use type Node_Label_Maps.Map; use type Edge_Label_Maps.Map; begin if Left.Is_Empty and Right.Is_Empty then return True; end if; declare Lock_Left : Impl.With_Lock (Left.Tamper_Info'Unrestricted_Access); Lock_Right : Impl.With_Lock (Right.Tamper_Info'Unrestricted_Access); begin return Left.Connections = Right.Connections and then Left.Node_Labels = Right.Node_Labels and then Left.Edge_Labels = Right.Edge_Labels; end; end "="; ------------ -- Append -- ------------ procedure Append (Container : in out Graph; Position : out Cursor) is Node : Node_Type := Node_Type'First; 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; Container.Connections.Insert (Node, Node_Vectors.Empty_Vector); Position.Container := Container'Unrestricted_Access; Position.Node := Node; 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 (Position.Node, Label); end Append; ------------------ -- Append_Label -- ------------------ procedure Append_Label (Container : in out Graph; Node : in Node_Type; Label : in Node_Label_Type) is begin if Impl.Checks then if not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; elsif Container.Has_Label (Node) then raise Constraint_Error with "Node already has label"; end if; end if; Container.Node_Labels.Insert (Node, Label); end Append_Label; procedure Append_Label (Position : in out Cursor; Label : in Node_Label_Type) is begin Position.Container.Append_Label (Position.Node, Label); end Append_Label; procedure Append_Label (Container : in out Graph; Edge : in Edge_Type; Label : in Edge_Label_Type) is begin if Impl.Checks then if not Container.Contains (Edge) then raise Constraint_Error with "Graph does not contain edge"; elsif Container.Has_Label (Edge) then raise Constraint_Error with "Edge already has label"; end if; end if; Container.Edge_Labels.Insert (Edge, Label); end Append_Label; ------------ -- Assign -- ------------ procedure Assign (Target : in out Graph; Source : in Graph) is begin Target := Source; end Assign; -------------- -- Children -- -------------- function Children (Container : in Graph; Node : in Node_Type) return Node_Array is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); 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)); end Children; function Children (Position : in Cursor) return Node_Array is begin return Position.Container.Children (Position.Node); end Children; ----------- -- Clear -- ----------- procedure Clear (Container : in out Graph) is begin Impl.TC_Check (Container.Tamper_Info); Container.Connections.Clear; Container.Node_Labels.Clear; Container.Edge_Labels.Clear; end Clear; ------------------ -- Clear_Labels -- ------------------ procedure Clear_Labels (Container : in out Graph) is begin Impl.TC_Check (Container.Tamper_Info); Container.Node_Labels.Clear; Container.Edge_Labels.Clear; end Clear_Labels; ------------------------------ -- Constant_Label_Reference -- ------------------------------ function Constant_Label_Reference (Container : in Graph; Node : in Node_Type) return Node_Label_Constant_Reference is begin if Impl.Checks then if not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; elsif not Container.Has_Label (Node) then raise Constraint_Error with "Node does not have a label"; end if; end if; declare Tamper : constant Help.Tamper_Counts_Access := Container.Tamper_Info'Unrestricted_Access; begin return Ref : constant Node_Label_Constant_Reference := (Element => Container.Node_Labels.Constant_Reference (Node).Element, Control => (Ada.Finalization.Controlled with Tamper)) do Impl.Lock (Tamper.all); end return; end; end Constant_Label_Reference; function Constant_Label_Reference (Position : in Cursor) return Node_Label_Constant_Reference is begin return Position.Container.Constant_Label_Reference (Position.Node); end Constant_Label_Reference; function Constant_Label_Reference (Container : in Graph; Edge : in Edge_Type) return Edge_Label_Constant_Reference is begin if Impl.Checks then if not Container.Contains (Edge) then raise Constraint_Error with "Graph does not contain edge"; elsif not Container.Has_Label (Edge) then raise Constraint_Error with "Edge does not have a label"; end if; end if; declare Tamper : constant Help.Tamper_Counts_Access := Container.Tamper_Info'Unrestricted_Access; begin return Ref : constant Edge_Label_Constant_Reference := (Element => Container.Edge_Labels.Constant_Reference (Edge).Element, Control => (Ada.Finalization.Controlled with Tamper)) do Impl.Lock (Tamper.all); end return; end; end Constant_Label_Reference; -------------- -- Contains -- -------------- function Contains (Container : in Graph; Node : in Node_Type) return Boolean is begin return Container.Connections.Contains (Node); end Contains; function Contains (Container : in Graph; Node : in Node_Type; Label : in Node_Label_Type) return Boolean is begin return Container.Contains (Node) and then Container.Node_Labels.Contains (Node) and then Container.Node_Labels.Constant_Reference (Node) = Label; 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); end Contains; function Contains (Container : in Graph; Edge : in Edge_Type; Label : in Edge_Label_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; end Contains; -------------------------- -- Contains_In_Subgraph -- -------------------------- function Contains_In_Subgraph (Position : in Cursor; Node : in Node_Type) return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if C.Node = Node then return True; end if; end loop; return False; end Contains_In_Subgraph; function Contains_In_Subgraph (Position : in Cursor; Node : in Node_Type; Label : in Node_Label_Type) return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if C.Node = Node and Constant_Label_Reference (C) = Label then return True; end if; 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; begin if Position.Container = null or else not Position.Container.Contains (Edge) then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if C.Node = Edge.From then Parent_Check := True; end if; if C.Node = Edge.To then Child_Check := True; end if; if Parent_Check and Child_Check then return True; end if; end loop; return False; end Contains_In_Subgraph; function Contains_In_Subgraph (Position : in Cursor; Edge : in Edge_Type; Label : in Edge_Label_Type) return Boolean is Parent_Check, Child_Check : Boolean := False; begin if Position.Container = null or else not Position.Container.Contains (Edge, Label) then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if C.Node = Edge.From then Parent_Check := True; end if; if C.Node = Edge.To then Child_Check := True; end if; if Parent_Check and Child_Check then return True; end if; end loop; return False; end Contains_In_Subgraph; -------------------- -- Contains_Label -- -------------------- function Contains_Label (Container : in Graph; Label : in Node_Label_Type) return Boolean is begin for C in Container.Node_Labels.Iterate loop if Node_Label_Maps.Element (C) = Label then return True; end if; end loop; return False; end Contains_Label; function Contains_Label (Container : in Graph; Label : in Edge_Label_Type) return Boolean is begin for C in Container.Edge_Labels.Iterate loop if Edge_Label_Maps.Element (C) = Label then return True; end if; end loop; return False; end Contains_Label; -------------------------------- -- Contains_Label_In_Subgraph -- -------------------------------- function Contains_Label_In_Subgraph (Position : in Cursor; Label : in Node_Label_Type) return Boolean is begin if Position.Container = null or else Position.Container.Node_Labels.Is_Empty then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if Position.Container.Node_Labels.Contains (C.Node) then return True; end if; end loop; return False; end Contains_Label_In_Subgraph; function Contains_Label_In_Subgraph (Position : in Cursor; Label : in Edge_Label_Type) return Boolean is Inside : Node_Vectors.Vector; Check : Edge_Type; begin if Position.Container = null or else Position.Container.Edge_Labels.Is_Empty then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop Inside.Append (C.Node); end loop; for E in Position.Container.Edge_Labels.Iterate loop 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 then return True; end if; end loop; return False; end Contains_Label_In_Subgraph; ------------- -- Context -- ------------- procedure Context (Container : in Graph; Node : in Node_Type; Parents : out Node_Array; Children : out Node_Array) is begin Parents := Container.Parents (Node); Children := Container.Children (Node); end Context; procedure Context (Position : in Cursor; Parents : out Node_Array; Children : out Node_Array) is begin Position.Container.Context (Position.Node, Parents, Children); end Context; ---------- -- Copy -- ---------- function Copy (Source : in Graph) return Graph is begin return G : Graph do G.Connections := Source.Connections; G.Node_Labels := Source.Node_Labels; G.Edge_Labels := Source.Edge_Labels; end return; end Copy; ------------ -- Degree -- ------------ function Degree (Container : in Graph; Node : in Node_Type) return Ada.Containers.Count_Type is use type Ada.Containers.Count_Type; begin return Container.Indegree (Node) + Container.Outdegree (Node); end Degree; function Degree (Position : in Cursor) return Ada.Containers.Count_Type is begin return Position.Container.Degree (Position.Node); end Degree; ------------ -- Delete -- ------------ procedure Delete (Container : in out Graph; Node : in Node_Type) is begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; for N of Container.Connections.Constant_Reference (Node) loop Container.Edge_Labels.Exclude ((From => Node, To => N)); end loop; Container.Connections.Delete (Node); Container.Node_Labels.Exclude (Node); for C in Container.Connections.Iterate loop declare Ref : Node_Maps.Reference_Type := Container.Connections.Reference (C); begin for I in reverse 1 .. Ref.Last_Index loop if Ref (I) = Node then Container.Edge_Labels.Exclude ((From => Node_Maps.Key (C), To => Node)); Ref.Delete (I); end if; end loop; end; end loop; end Delete; procedure Delete (Position : in out Cursor) is begin Position.Container.Delete (Position.Node); end Delete; procedure Delete (Container : in out Graph; Nodes : in Node_Array) is begin for N of Nodes loop Container.Delete (N); end loop; end Delete; procedure Delete (Container : in out Graph; Edge : in Edge_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.Exclude (Edge); declare Ref : Node_Maps.Reference_Type := Container.Connections.Reference (Edge.From); begin Ref.Delete (Ref.Find_Index (Edge.To)); end; end Delete; procedure Delete (Container : in out Graph; Edges : in Edge_Array) is begin for E of Edges loop Container.Delete (E); end loop; end Delete; ------------------ -- Delete_Label -- ------------------ procedure Delete_Label (Container : in out Graph; Node : in Node_Type) is begin Container.Node_Labels.Delete (Node); end Delete_Label; procedure Delete_Label (Position : in out Cursor) is begin Position.Container.Delete_Label (Position.Node); end Delete_Label; procedure Delete_Label (Container : in out Graph; Edge : in Edge_Type) is begin Container.Edge_Labels.Delete (Edge); end Delete_Label; --------------------- -- Delete_Subgraph -- --------------------- procedure Delete_Subgraph (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"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (C.Node); end loop; Position.Container.Delete (V2A (Nodes)); end Delete_Subgraph; ---------------- -- Edge_Count -- ---------------- function Edge_Count (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 Result := Result + C.Length; end loop; return Result; end Edge_Count; function Edge_Count (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"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop Result := Result + Outdegree (Position); end loop; return Result; end Edge_Count; ----------- -- Edges -- ----------- function Edges (Container : in Graph) return Edge_Array is Tos : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin 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)); end loop; end loop; return V2A (Tos); end Edges; function Edges (Position : in Cursor) return Edge_Array 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"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop for E of Outbound (Position) loop Tos.Append (E); end loop; end loop; return V2A (Tos); end Edges; ------------- -- Element -- ------------- function Element (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"; end if; return Position.Node; end Element; -------------- -- Finalize -- -------------- procedure Finalize (Container : in out Graph) is begin Impl.TC_Check (Container.Tamper_Info); end Finalize; procedure Finalize (Object : in out Iterator) is begin Impl.Unbusy (Object.Container.Tamper_Info); end Finalize; procedure Finalize (Object : in out Subgraph_Iterator) is begin Impl.Unbusy (Object.Container.Tamper_Info); end Finalize; ---------- -- Find -- ---------- function Find (Container : in Graph; Label : in Node_Label_Type) return Node_Array is Result : Node_Vectors.Vector; function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin for C in Container.Node_Labels.Iterate loop if Container.Node_Labels.Constant_Reference (C) = Label then Result.Append (Node_Label_Maps.Key (C)); end if; end loop; return V2A (Result); end Find; function Find (Container : in Graph; Label : in Edge_Label_Type) return Edge_Array is Result : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin for C in Container.Edge_Labels.Iterate loop if Container.Edge_Labels.Constant_Reference (C) = Label then Result.Append (Edge_Label_Maps.Key (C)); end if; end loop; return V2A (Result); end Find; ---------------------- -- Find_In_Subgraph -- ---------------------- function Find_In_Subgraph (Position : in Cursor; Label : in Node_Label_Type) return Node_Array 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"; 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); end if; end loop; return V2A (Result); end Find_In_Subgraph; function Find_In_Subgraph (Position : in Cursor; Label : in Edge_Label_Type) return Edge_Array 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"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (C.Node); end loop; for E of Keys (Position.Container.Edge_Labels) loop if Nodes.Contains (E.From) and then Nodes.Contains (E.To) and then Position.Container.Edge_Labels.Constant_Reference (E) = Label then Result.Append (E); end if; end loop; return V2A (Result); end Find_In_Subgraph; ----------- -- First -- ----------- function First (Container : in Graph) 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); end First; function First (Object : in Iterator) return Cursor is begin return Object.Container.First; end First; function First (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); end First; -------------- -- Has_Edge -- -------------- function Has_Edge (Container : in Graph; Parent, Child : in Node_Type) return Boolean is begin if Impl.Checks then if not Container.Contains (Parent) then raise Constraint_Error with "Graph does not contain parent node"; elsif not Container.Contains (Child) then raise Constraint_Error with "Graph does not contain child node"; end if; end if; return Container.Contains ((From => Parent, To => Child)); end Has_Edge; function Has_Edge (Parent, Child : in Cursor) return Boolean is begin return Parent.Container.Has_Edge (Parent.Node, Child.Node); end Has_Edge; ----------------- -- Has_Element -- ----------------- function Has_Element (Position : in Cursor) return Boolean is begin return Position.Container /= null and then Position.Container.Contains (Position.Node); end Has_Element; --------------- -- Has_Label -- --------------- function Has_Label (Container : in Graph; Node : in Node_Type) return Boolean is begin return Container.Node_Labels.Contains (Node); end Has_Label; function Has_Label (Position : in Cursor) return Boolean is begin return Position.Container.Has_Label (Position.Node); end Has_Label; function Has_Label (Container : in Graph; Edge : in Edge_Type) return Boolean is begin return Container.Edge_Labels.Contains (Edge); end Has_Label; ---------------------- -- Has_Labeled_Edge -- ---------------------- function Has_Labeled_Edge (Container : in Graph; Parent, Child : Node_Type) return Boolean is begin return Container.Has_Edge (Parent, Child) and Container.Has_Label ((From => Parent, To => Child)); end Has_Labeled_Edge; function Has_Labeled_Edge (Parent, Child : in Cursor) return Boolean is begin return Parent.Container.Has_Labeled_Edge (Parent.Node, Child.Node); end Has_Labeled_Edge; ------------------ -- Has_Neighbor -- ------------------ function Has_Neighbor (Container : in Graph; Left, Right : in Node_Type) return Boolean is begin return Container.Has_Edge (Left, Right) and Container.Has_Edge (Right, Left); end Has_Neighbor; function Has_Neighbor (Left, Right : in Cursor) return Boolean is begin return Left.Container.Has_Neighbor (Left.Node, Right.Node); end Has_Neighbor; ------------- -- Inbound -- ------------- function Inbound (Container : in Graph; Node : in Node_Type) return Edge_Array is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); Edges : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop if N = Node then Edges.Append ((From => Node_Maps.Key (C), To => N)); end if; end loop; end loop; return V2A (Edges); end Inbound; function Inbound (Position : in Cursor) return Edge_Array is begin return Position.Container.Inbound (Position.Node); end Inbound; -------------- -- Indegree -- -------------- function Indegree (Container : in Graph; 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 for C of Container.Connections loop for N of C loop if N = Node then Count := Count + 1; end if; end loop; end loop; return Count; end Indegree; function Indegree (Position : in Cursor) return Ada.Containers.Count_Type is begin return Position.Container.Indegree (Position.Node); end Indegree; ------------ -- Insert -- ------------ procedure Insert (Container : in out Graph; Node : in Node_Type) is begin if Impl.Checks and then Container.Contains (Node) then raise Constraint_Error with "Graph already contains node"; end if; Container.Connections.Insert (Node, Node_Vectors.Empty_Vector); end Insert; procedure Insert (Container : in out Graph; Node : in Node_Type; Label : in Node_Label_Type) is begin Container.Insert (Node); Container.Node_Labels.Insert (Node, Label); end Insert; procedure Insert (Container : in out Graph; Nodes : in Node_Array) is begin for N of Nodes loop Container.Insert (N); end loop; end Insert; procedure Insert (Container : in out Graph; Edge : in Edge_Type) is begin if Impl.Checks then if not Container.Contains (Edge.From) then raise Constraint_Error with "Graph does not contain tail node of edge"; end if; if not Container.Contains (Edge.To) then raise Constraint_Error with "Graph does not contain head node of edge"; end if; end if; Container.Connections.Reference (Edge.From).Append (Edge.To); end Insert; procedure Insert (Container : in out Graph; Edge : in Edge_Type; Label : in Edge_Label_Type) is begin Container.Insert (Edge); Container.Edge_Labels.Insert (Edge, Label); end Insert; procedure Insert (Container : in out Graph; Edges : in Edge_Array) is begin for E of Edges loop Container.Insert (E); end loop; end Insert; -------------- -- Is_Empty -- -------------- function Is_Empty (Container : in Graph) return Boolean is begin return Container.Connections.Is_Empty; end Is_Empty; ------------- -- Iterate -- ------------- function Iterate (Container : in Graph) return Graph_Iterator_Interfaces.Reversible_Iterator'Class is begin return It : Iterator do It.Container := Container'Unrestricted_Access; end return; end Iterate; ---------------------- -- Iterate_Subgraph -- ---------------------- function Iterate_Subgraph (Container : in Graph; Position : in Cursor) return Graph_Iterator_Interfaces.Forward_Iterator'Class is begin return It : Subgraph_Iterator do It.Container := Container'Unrestricted_Access; It.Root_Node := Position.Node; end return; end Iterate_Subgraph; ---------------- -- Key_Vector -- ---------------- function Key_Vector (My_Map : in Key_Maps.Map) return Type_Vectors.Vector is begin return My_Vector : Type_Vectors.Vector do for C in My_Map.Iterate loop My_Vector.Append (Key_Maps.Key (C)); end loop; end return; end Key_Vector; ----------- -- Label -- ----------- function Label (Container : in Graph; Node : in Node_Type) return Node_Label_Type is begin if Impl.Checks then if not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; elsif not Container.Has_Label (Node) then raise Constraint_Error with "Node does not have label"; end if; end if; return Container.Node_Labels.Element (Node); end Label; function Label (Position : in Cursor) return Node_Label_Type is begin return Position.Container.Label (Position.Node); end Label; function Label (Container : in Graph; Edge : in Edge_Type) return Edge_Label_Type is begin if Impl.Checks then if not Container.Contains (Edge) then raise Constraint_Error with "Graph does not contain edge"; elsif not Container.Has_Label (Edge) then raise Constraint_Error with "Edge does not have label"; end if; end if; return Container.Edge_Labels.Element (Edge); end Label; --------------------- -- Label_Reference -- --------------------- function Label_Reference (Container : aliased in out Graph; Node : in Node_Type) return Node_Label_Reference is begin if Impl.Checks then if not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; elsif not Container.Has_Label (Node) then raise Constraint_Error with "Node does not have label"; end if; end if; declare Tamper : constant Help.Tamper_Counts_Access := Container.Tamper_Info'Unrestricted_Access; begin return Ref : constant Node_Label_Reference := (Element => Container.Node_Labels.Reference (Node).Element, Control => (Ada.Finalization.Controlled with Tamper)) do Impl.Lock (Tamper.all); end return; end; end Label_Reference; function Label_Reference (Position : in Cursor) return Node_Label_Reference is begin return Position.Container.Label_Reference (Position.Node); end Label_Reference; function Label_Reference (Container : aliased in out Graph; Edge : in Edge_Type) return Edge_Label_Reference is begin if Impl.Checks then if not Container.Contains (Edge) then raise Constraint_Error with "Graph does not contain edge"; elsif not Container.Has_Label (Edge) then raise Constraint_Error with "Edge does not have label"; end if; end if; declare Tamper : constant Help.Tamper_Counts_Access := Container.Tamper_Info'Unrestricted_Access; begin return Ref : constant Edge_Label_Reference := (Element => Container.Edge_Labels.Reference (Edge).Element, Control => (Ada.Finalization.Controlled with Tamper)) do Impl.Lock (Tamper.all); end return; end; end Label_Reference; --------------------- -- Labeled_Context -- --------------------- procedure Labeled_Context (Container : in Graph; Node : in Node_Type; Parents : out Node_Array; Children : out Node_Array; Label : out Node_Label_Type) is begin Parents := Container.Parents (Node); Children := Container.Children (Node); Label := Container.Label (Node); end Labeled_Context; procedure Labeled_Context (Position : in Cursor; Parents : out Node_Array; Children : out Node_Array; Label : out Node_Label_Type) is begin Position.Container.Labeled_Context (Position.Node, Parents, Children, Label); end Labeled_Context; ---------- -- Last -- ---------- 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); 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); end Last; function Last (Object : in Iterator) return Cursor is begin return Object.Container.Last; end Last; ---------- -- Move -- ---------- procedure Move (Target, Source : in out Graph) is begin Node_Maps.Move (Target.Connections, Source.Connections); Node_Label_Maps.Move (Target.Node_Labels, Source.Node_Labels); Edge_Label_Maps.Move (Target.Edge_Labels, Source.Edge_Labels); -- does anything have to be done with tamper checks here? end Move; --------------- -- Neighbors -- --------------- function Neighbors (Container : in Graph; Node : in Node_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); 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); exit; end if; end loop; end loop; return V2A (Nodes); end Neighbors; function Neighbors (Position : in Cursor) return Node_Array is begin return Position.Container.Neighbors (Position.Node); end Neighbors; ---------- -- Next -- ---------- function Next (Position : in Cursor) return Cursor is Cursor_Copy : Cursor := Position; begin Next (Cursor_Copy); return Cursor_Copy; 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); 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; end Next; function Next (Object : in Iterator; Position : in Cursor) return Cursor is Cursor_Copy : Cursor := Position; begin Next (Cursor_Copy); return Cursor_Copy; end Next; function Next (Object : in Subgraph_Iterator; Position : in Cursor) return Cursor is Next_Cursor : Cursor := Position; Consider : Node_Vectors.Vector; begin if Position.Container = null 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 return No_Element; else Next_Cursor.Node := Next_Cursor.Path_Up.Last_Element; Next_Cursor.Path_Up.Delete_Last; end if; end loop; end Next; ---------------- -- Node_Count -- ---------------- function Node_Count (Container : in Graph) return Ada.Containers.Count_Type is begin return Container.Connections.Length; end Node_Count; function Node_Count (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"; end if; for N in Position.Container.Iterate_Subgraph (Position) loop Result := Result + 1; end loop; return Result; end Node_Count; ---------------- -- Node_Range -- ---------------- procedure Node_Range (Container : in Graph; Minimum : out Node_Type; Maximum : out Node_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; for C in Container.Connections.Iterate loop if Node_Maps.Key (C) < Minimum then Minimum := Node_Maps.Key (C); end if; if Node_Maps.Key (C) > Maximum then Maximum := Node_Maps.Key (C); end if; end loop; end Node_Range; ----------- -- Nodes -- ----------- function Nodes (Container : in Graph) return Node_Array is function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin return V2A (Keys (Container.Connections)); end Nodes; function Nodes (Position : in Cursor) return Node_Array 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"; end if; for C in Position.Container.Iterate_Subgraph (Position) loop Result.Append (C.Node); end loop; return V2A (Result); end Nodes; -------------- -- Outbound -- -------------- function Outbound (Container : in Graph; Node : in Node_Type) return Edge_Array is begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; declare Ref : Node_Maps.Constant_Reference_Type := Container.Connections.Constant_Reference (Node); Result : Edge_Array (1 .. Ref.Last_Index); begin for I in Result'Range loop Result (I) := (From => Node, To => Node_Vectors.Element (Ref, I)); end loop; return Result; end; end Outbound; function Outbound (Position : in Cursor) return Edge_Array is begin return Position.Container.Outbound (Position.Node); end Outbound; --------------- -- Outdegree -- --------------- function Outdegree (Container : in Graph; Node : in Node_Type) return Ada.Containers.Count_Type is begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; else return Container.Connections.Constant_Reference (Node).Length; end if; end Outdegree; function Outdegree (Position : in Cursor) return Ada.Containers.Count_Type is begin return Position.Container.Outdegree (Position.Node); end Outdegree; ------------- -- Parents -- ------------- function Parents (Container : in Graph; Node : in Node_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); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop if N = Node then Froms.Append (Node_Maps.Key (C)); exit; end if; end loop; end loop; return V2A (Froms); end Parents; function Parents (Position : in Cursor) return Node_Array is begin return Position.Container.Parents (Position.Node); end Parents; -------------- -- Previous -- -------------- function Previous (Position : in Cursor) return Cursor is Cursor_Copy : Cursor := Position; begin Previous (Cursor_Copy); return Cursor_Copy; 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); 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; end Previous; function Previous (Object : in Iterator; Position : in Cursor) return Cursor is Cursor_Copy : Cursor := Position; begin Previous (Cursor_Copy); return Cursor_Copy; end Previous; ---------- -- Read -- ---------- procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Container : out Graph) is begin Container.Clear; Node_Maps.Map'Read (Stream, Container.Connections); Node_Label_Maps.Map'Read (Stream, Container.Node_Labels); Edge_Label_Maps.Map'Read (Stream, Container.Edge_Labels); end Read; procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Position : out Cursor) is begin raise Program_Error with "Attempt to stream Graph cursor"; end Read; procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Item : out Node_Label_Constant_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Read; procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Item : out Node_Label_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Read; procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Item : out Edge_Label_Constant_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Read; procedure Read (Stream : not null access Streams.Root_Stream_Type'Class; Item : out Edge_Label_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Read; ------------------- -- Replace_Label -- ------------------- procedure Replace_Label (Container : in out Graph; Node : in Node_Type; Label : in Node_Label_Type) is begin Container.Node_Labels.Replace (Node, Label); end Replace_Label; procedure Replace_Label (Position : in out Cursor; Label : in Node_Label_Type) is begin Position.Container.Replace_Label (Position.Node, Label); end Replace_Label; procedure Replace_Label (Container : in out Graph; Edge : in Edge_Type; Label : in Edge_Label_Type) is begin Container.Edge_Labels.Replace (Edge, Label); end Replace_Label; ---------- -- Swap -- ---------- procedure Swap (Container : in out Graph; Left, Right : in Node_Type) is Temp_Label : Node_Label_Type; Temp_Vector : Node_Vectors.Vector; begin if Impl.Checks then if not Container.Contains (Left) then raise Constraint_Error with "Graph does not contain left operand"; end if; if not Container.Contains (Right) then raise Constraint_Error with "Graph does not contain right operand"; end if; end if; -- Switch labels around, if present if Container.Node_Labels.Contains (Left) then Temp_Label := Container.Node_Labels.Element (Left); if Container.Node_Labels.Contains (Right) then Container.Node_Labels.Replace (Left, Container.Node_Labels.Element (Right)); Container.Node_Labels.Replace (Right, Temp_Label); else Container.Node_Labels.Insert (Right, Temp_Label); Container.Node_Labels.Exclude (Left); end if; else if Container.Node_Labels.Contains (Right) then Container.Node_Labels.Insert (Left, Container.Node_Labels.Element (Right)); Container.Node_Labels.Exclude (Right); end if; end if; -- Switch the nodes themselves around Temp_Vector := Container.Connections.Element (Left); Container.Connections.Replace (Left, Container.Connections.Element (Right)); Container.Connections.Replace (Right, Temp_Vector); -- 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; end if; end loop; end loop; end Swap; procedure Swap (Left, Right : in out Cursor) 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; end if; Left.Container.Swap (Left.Node, Right.Node); end Swap; --------------- -- To_Cursor -- --------------- function To_Cursor (Container : in Graph; Node : in Node_Type) return Cursor is begin if not Container.Connections.Contains (Node) then return No_Element; else return (Container => Container'Unrestricted_Access, Node => Node, Visited => Node_Vectors.Empty_Vector, Path_Up => Node_Vectors.Empty_Vector); end if; end To_Cursor; -------------- -- To_Graph -- -------------- function To_Graph (Nodes : in Node_Array; Edges : in Edge_Array) return Graph is Adj_Map : Node_Maps.Map; begin if Nodes'Length = 0 and Edges'Length = 0 then return Empty_Graph; end if; for I in Positive range Nodes'First .. Nodes'Last loop if Impl.Checks then for J in Positive range I + 1 .. Nodes'Last loop if Nodes (I) = Nodes (J) then raise Constraint_Error with "Duplicate nodes in node array"; end if; end loop; end if; Adj_Map.Insert (Nodes (I), Node_Vectors.Empty_Vector); end loop; for E of Edges loop if Impl.Checks and then (not Adj_Map.Contains (E.From) or not Adj_Map.Contains (E.To)) then raise Constraint_Error with "Edge uses nodes not in graph"; end if; Adj_Map.Reference (E.From).Append (E.To); end loop; return G : Graph := (Ada.Finalization.Controlled with Connections => Adj_Map, others => <>); end To_Graph; ------------------ -- Unused_Nodes -- ------------------ function Unused_Nodes (Container : in Graph; 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; end if; end loop; return Nodes; end Unused_Nodes; --------------------- -- Vector_To_Array -- --------------------- function Vector_To_Array (Input : in Type_Vectors.Vector) return Array_Type is begin return Result : Array_Type (1 .. Input.Last_Index) do for I in Result'Range loop Result (I) := Input (I); end loop; end return; end Vector_To_Array; ----------- -- Write -- ----------- procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Container : in Graph) is begin Node_Maps.Map'Write (Stream, Container.Connections); Node_Label_Maps.Map'Write (Stream, Container.Node_Labels); Edge_Label_Maps.Map'Write (Stream, Container.Edge_Labels); end Write; procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Position : in Cursor) is begin raise Program_Error with "Attempt to stream Graph cursor"; end Write; procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Item : in Node_Label_Constant_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Write; procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Item : in Node_Label_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Write; procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Item : in Edge_Label_Constant_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Write; procedure Write (Stream : not null access Streams.Root_Stream_Type'Class; Item : in Edge_Label_Reference) is begin raise Program_Error with "Attempt to stream reference"; end Write; end Directed_Graphs;