-- This source is licensed under the Sunset License v1.0 with System; 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 --------- -- "<" -- --------- function "<" (Left, Right : in Edge_Type) return Boolean is begin if Left.From = Right.From then if Left.To = Right.To then return Left.ID < Right.ID; else return Left.To < Right.To; end if; 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 "="; ------------ -- Adjust -- ------------ procedure Adjust (Container : in out Graph) is begin Impl.Zero_Counts (Container.Tamper_Info); end Adjust; ------------------ -- Append_Label -- ------------------ procedure Append_Label (Container : in out Graph; Node : in Node_ID_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 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.Append_Label (Element (Position), 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; procedure Append_Label (Container : in Cursor; Edge : in Edge_Type; Label : in Edge_Label_Type) is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; Container.Container.Append_Label (Edge, Label); end Append_Label; ------------ -- Assign -- ------------ procedure Assign (Target : in out Graph; Source : in Graph) is use type System.Address; begin if Target'Address = Source'Address then return; else Target := Source; end if; end Assign; ------------- -- Between -- ------------- function Between (Container : in Graph; Parent, Child : in Node_ID_Type) return Edge_Array is function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); Result : Edge_Vectors.Vector; begin for E of Container.Outbound (Parent) loop if E.To = Child then Result.Append (E); end if; end loop; return V2A (Result); end Between; function Between (Parent, Child : in Cursor) return Edge_Array is begin if Impl.Checks then if Parent.Container = null then raise Constraint_Error with "Graph for parent cursor does not exist"; end if; if Child.Container = null then raise Constraint_Error with "Graph for child cursor does not exist"; end if; if Parent.Container /= Child.Container then raise Constraint_Error with "Parent and child cursors refer to different graphs"; end if; if not Has_Element (Parent) then raise Constraint_Error with "Parent cursor points to nothing"; end if; if not Has_Element (Child) then raise Constraint_Error with "Child cursor points to nothing"; end if; end if; return Parent.Container.Between (Element (Parent), Element (Child)); end Between; -------------- -- Children -- -------------- function Children (Container : in Graph; Node : in Node_ID_Type) return Node_Array is function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); Result : Node_Vectors.Vector; begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; for A of Container.Connections.Element (Node) loop Result.Append (A.Node_ID); end loop; return V2A (Result); end Children; function Children (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.Children (Element (Position)); 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 Container.Node_Labels.Clear; Container.Edge_Labels.Clear; end Clear_Labels; ------------------------------ -- Constant_Label_Reference -- ------------------------------ function Constant_Label_Reference (Container : in Graph; Node : in Node_ID_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 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; 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; function Constant_Label_Reference (Container : in Cursor; Edge : in Edge_Type) return Edge_Label_Constant_Reference is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Constant_Label_Reference (Edge); end Constant_Label_Reference; -------------- -- Contains -- -------------- function Contains (Container : in Graph; Node : in Node_ID_Type) return Boolean is begin return Container.Connections.Contains (Node); end Contains; function Contains (Container : in Graph; Node : in Node_ID_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_ID : in Edge_ID_Type) return Boolean is begin for N of Container.Connections loop for A of N loop if A.Edge_ID = Edge_ID then return True; end if; end loop; end loop; return False; 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_ID => Edge.ID, Node_ID => 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_ID_Type) return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop if Element (C) = Node then return True; end if; end loop; return False; end Contains_In_Subgraph; function Contains_In_Subgraph (Position : in Cursor; Node : in Node_ID_Type; Label : in Node_Label_Type) return Boolean is begin if Position.Container = null then return False; end if; return Contains_In_Subgraph (Position, Node) and then Position.Container.Constant_Label_Reference (Node) = Label; end Contains_In_Subgraph; function Contains_In_Subgraph (Position : in Cursor; Edge_ID : in Edge_ID_Type) return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop for E of Position.Container.Outbound (Element (C)) loop if E.ID = Edge_ID then return True; end if; end loop; end loop; return False; end Contains_In_Subgraph; function Contains_In_Subgraph (Position : in Cursor; Edge : in Edge_Type) return Boolean is begin if Position.Container = null then return False; end if; for C in Position.Container.Iterate_Subgraph (Position) loop for E of Position.Container.Outbound (Element (C)) loop if E = Edge then return True; end if; end loop; 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 then return False; end if; return Contains_In_Subgraph (Position, Edge) and then Position.Container.Constant_Label_Reference (Edge) = Label; 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.Has_Label (Element (C)) and then Position.Container.Constant_Label_Reference (Element (C)) = Label 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 (Element (C)); 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 Position.Container.Edge_Labels.Constant_Reference (E) = Label then return True; end if; end loop; return False; end Contains_Label_In_Subgraph; ---------- -- Copy -- ---------- function Copy (Source : in Graph) return Graph is begin return G : Graph do G.Assign (Source); end return; end Copy; --------------- -- Cursor_To -- --------------- function Cursor_To (Position : in Cursor; Node : in Node_ID_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 Position.Container.Contains (Node) then raise Constraint_Error with "Target node does not exist"; end if; end if; return Position.Container.To_Cursor (Node); end Cursor_To; ------------ -- Degree -- ------------ function Degree (Container : in Graph; Node : in Node_ID_Type) return Ada.Containers.Count_Type is begin return Container.Indegree (Node) + Container.Outdegree (Node); end Degree; function Degree (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.Degree (Element (Position)); end Degree; ------------ -- Delete -- ------------ procedure Delete (Container : in out Graph; Node : in Node_ID_Type) is begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; Impl.TC_Check (Container.Tamper_Info); for N of Container.Connections.Constant_Reference (Node) loop Container.Edge_Labels.Exclude ((ID => N.Edge_ID, From => Node, To => N.Node_ID)); 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_ID = Node then Container.Edge_Labels.Exclude ((ID => Ref (I).Edge_ID, 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 if Impl.Checks then if Position.Container = null then raise Constraint_Error with "Graph does not exist"; end if; if not Has_Element (Position) then raise Constraint_Error with "Cursor points to nothing"; end if; end if; Position.Container.Delete (Element (Position)); Position := No_Element; 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_ID => Edge.ID, Node_ID => Edge.To))); end; end Delete; procedure Delete (Container : in Cursor; Edge : in 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.Delete (Edge); 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_ID_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; procedure Delete_Label (Position : in 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; end if; Position.Container.Delete_Label (Element (Position)); end Delete_Label; procedure Delete_Label (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; procedure Delete_Label (Container : in Cursor; Edge : in 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.Delete_Label (Edge); end Delete_Label; --------------------- -- Delete_Subgraph -- --------------------- procedure Delete_Subgraph (Position : in out Cursor) is Nodes : Node_Vectors.Vector; begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; end if; Impl.TC_Check (Position.Container.Tamper_Info); declare It : Graph_Iterator_Interfaces.Reversible_Iterator'Class := Position.Container.Iterate_Subgraph (Position); begin Nodes := Subgraph_Iterator (It).Nodes; end; -- Have to wait for the Iterator to go out of scope -- before deleting Nodes due to busy check rules for N of Nodes loop Position.Container.Delete (N); end loop; end Delete_Subgraph; ---------------- -- Edge_Count -- ---------------- function Edge_Count (Container : in Graph) return Ada.Containers.Count_Type is 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 (Container : in Cursor) return Ada.Containers.Count_Type is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Edge_Count; end Edge_Count; ---------------------------- -- Edge_Count_In_Subgraph -- ---------------------------- function Edge_Count_In_Subgraph (Position : in Cursor) return Ada.Containers.Count_Type is Result : Ada.Containers.Count_Type := 0; 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; for C in Position.Container.Iterate_Subgraph (Position) loop Result := Result + Outdegree (Position); end loop; return Result; end Edge_Count_In_Subgraph; ----------- -- 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 ((ID => N.Edge_ID, From => Node_Maps.Key (C), To => N.Node_ID)); end loop; end loop; return V2A (Tos); end Edges; function Edges (Container : in Cursor) return Edge_Array is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Edges; end Edges; ----------------------- -- Edges_In_Subgraph -- ----------------------- function Edges_In_Subgraph (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 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 (C) loop Tos.Append (E); end loop; end loop; return V2A (Tos); end Edges_In_Subgraph; ------------- -- Element -- ------------- function Element (Position : in Cursor) return Extended_Node_ID_Type is use type Node_Maps.Cursor; begin if Position.Container = null or else Position.Place = Node_Maps.No_Element or else not Position.Container.Contains (Node_Maps.Key (Position.Place)) then return No_Node; else return Node_Maps.Key (Position.Place); end if; 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_ID_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_ID_Type, Node_Array, Node_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop if Position.Container.Node_Labels.Constant_Reference (Element (C)) = Label then Result.Append (Element (C)); 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); 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; for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (Element (C)); end loop; 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 (Edge_Label_Maps.Key (E)); end if; end loop; return V2A (Result); end Find_In_Subgraph; ----------- -- First -- ----------- function First (Container : in Graph) return Cursor is begin if Impl.Checks and then Container.Is_Empty then raise Constraint_Error with "Graph is empty"; end if; return (Container => Container'Unrestricted_Access, Place => Container.Connections.First, Sub_Index => Node_Vectors.Extended_Index'First); 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 if Object.Nodes.Is_Empty then return No_Element; else return (Container => Object.Container, Place => Object.Container.Connections.Find (Object.Nodes.First_Element), Sub_Index => Object.Nodes.First_Index); end if; end First; ------------ -- 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 -- -------------- function Has_Edge (Container : in Graph; Parent, Child : in Node_ID_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; for N of Container.Connections.Constant_Reference (Parent) loop if N.Node_ID = Child then return True; end if; end loop; return False; end Has_Edge; function Has_Edge (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 Has_Element (Parent) then raise Constraint_Error with "Parent cursor points to nothing"; end if; if not Has_Element (Child) then raise Constraint_Error with "Child cursor points to nothing"; end if; end if; return Parent.Container.Has_Edge (Element (Parent), Element (Child)); end Has_Edge; ----------------- -- Has_Element -- ----------------- function Has_Element (Position : in Cursor) return Boolean is begin return Position.Container /= null and then Position.Container.Contains (Node_Maps.Key (Position.Place)); end Has_Element; --------------- -- Has_Label -- --------------- function Has_Label (Container : in Graph; Node : in Node_ID_Type) return Boolean is begin return Container.Node_Labels.Contains (Node); end Has_Label; function Has_Label (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; function Has_Label (Container : in Graph; Edge : in Edge_Type) return Boolean is begin return Container.Edge_Labels.Contains (Edge); end Has_Label; function Has_Label (Container : in Cursor; Edge : in Edge_Type) 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.Edge_Labels.Contains (Edge); end Has_Label; ---------------------- -- Has_Labeled_Edge -- ---------------------- function Has_Labeled_Edge (Container : in Graph; Parent, Child : Node_ID_Type) return Boolean is begin if Container.Has_Edge (Parent, Child) then for C in Container.Edge_Labels.Iterate loop if Edge_Label_Maps.Key (C).From = Parent and Edge_Label_Maps.Key (C).To = Child then return True; end if; end loop; end if; return False; end Has_Labeled_Edge; function Has_Labeled_Edge (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 Has_Element (Parent) then raise Constraint_Error with "Parent cursor points to nothing"; end if; if not Has_Element (Child) then raise Constraint_Error with "Child cursor points to nothing"; 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; ------------------ -- Has_Neighbor -- ------------------ function Has_Neighbor (Container : in Graph; Left, Right : in Node_ID_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 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; ------------- -- Inbound -- ------------- function Inbound (Container : in Graph; Node : in Node_ID_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_ID = Node then Edges.Append ((ID => N.Edge_ID, From => Node_Maps.Key (C), To => N.Node_ID)); end if; end loop; end loop; return V2A (Edges); end Inbound; function Inbound (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; -------------- -- Indegree -- -------------- function Indegree (Container : in Graph; Node : in Node_ID_Type) return Ada.Containers.Count_Type is 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_ID = 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 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; ------------ -- Insert -- ------------ procedure Insert (Container : in out Graph; Node : in Node_ID_Type) is begin if Impl.Checks and then Container.Contains (Node) then raise Constraint_Error with "Graph already contains node"; end if; Impl.TC_Check (Container.Tamper_Info); Container.Connections.Insert (Node, Adj_Vectors.Empty_Vector); end Insert; procedure Insert (Container : in out Graph; Node : in Node_ID_Type; Label : in Node_Label_Type) is begin Container.Insert (Node); Container.Node_Labels.Insert (Node, Label); end Insert; procedure Insert (Container : in Cursor; Node : in Node_ID_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); end Insert; procedure Insert (Container : in Cursor; Node : in Node_ID_Type; Label : in Node_Label_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); 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_ID => Edge.ID, Node_ID => 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 Cursor; Edge : in 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); end Insert; procedure Insert (Container : in Cursor; Edge : in Edge_Type; Label : in Edge_Label_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); 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; Impl.Busy (Container.Tamper_Info'Unrestricted_Access.all); end return; end Iterate; ---------------------- -- Iterate_Subgraph -- ---------------------- function Iterate_Subgraph (Container : in Graph; Position : in Cursor) return Graph_Iterator_Interfaces.Reversible_Iterator'Class is Root_Node, Current_Node : Node_ID_Type; Path_Up : Node_Vectors.Vector; Visited : Node_Vectors.Vector; begin if Impl.Checks and then not Has_Element (Position) then raise Constraint_Error with "Cursor points to nothing"; end if; Root_Node := Element (Position); Current_Node := Root_Node; Depth_First : loop Visited.Append (Current_Node); Select_Next : loop for N of Container.Children (Current_Node) loop if not Visited.Contains (N) then Path_Up.Append (Current_Node); Current_Node := N; exit Select_Next; end if; end loop; if Path_Up.Is_Empty then exit Depth_First; else Current_Node := Path_Up.Last_Element; Path_Up.Delete_Last; end if; end loop Select_Next; end loop Depth_First; Node_Sort.Sort (Visited); return It : Subgraph_Iterator do It.Container := Container'Unrestricted_Access; It.Nodes := Visited; Impl.Busy (Container.Tamper_Info'Unrestricted_Access.all); end return; end Iterate_Subgraph; ----------- -- Label -- ----------- function Label (Container : in Graph; Node : in Node_ID_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 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; 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; function Label (Container : in Cursor; Edge : in Edge_Type) return Edge_Label_Type is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Label (Edge); end Label; --------------------- -- Label_Reference -- --------------------- function Label_Reference (Container : aliased in out Graph; Node : in Node_ID_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 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; 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; function Label_Reference (Container : in Cursor; Edge : in Edge_Type) return Edge_Label_Reference is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Label_Reference (Edge); end Label_Reference; ---------- -- Last -- ---------- function Last (Container : in Graph) return Cursor is begin if Container.Is_Empty then return No_Element; else return (Container => Container'Unrestricted_Access, Place => Container.Connections.Last, Sub_Index => Node_Vectors.Extended_Index'First); end if; end Last; function Last (Object : in Iterator) return Cursor is begin return Object.Container.Last; end Last; function Last (Object : in Subgraph_Iterator) return Cursor is begin if Object.Nodes.Is_Empty then return No_Element; else return (Container => Object.Container, Place => Object.Container.Connections.Find (Object.Nodes.Last_Element), Sub_Index => Object.Nodes.Last_Index); end if; end Last; ---------- -- Move -- ---------- procedure Move (Target, Source : in out Graph) is use type System.Address; begin if Target'Address = Source'Address then return; end if; Impl.TC_Check (Target.Tamper_Info); Impl.TC_Check (Source.Tamper_Info); 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); end Move; --------------- -- Neighbors -- --------------- function Neighbors (Container : in Graph; Node : in Node_ID_Type) return Node_Array is Result : Node_Vectors.Vector; To_Del : Boolean; function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); begin for N of Container.Connections.Constant_Reference (Node) loop if not Result.Contains (N.Node_ID) then Result.Append (N.Node_ID); end if; end loop; for I in reverse 1 .. Result.Last_Index loop To_Del := True; for N of Container.Connections.Constant_Reference (Result (I)) loop if N.Node_ID = Node then To_Del := False; exit; end if; end loop; if To_Del then Result.Delete (I); end if; end loop; return V2A (Result); end Neighbors; function Neighbors (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; ---------- -- 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 begin if Position.Container = null then Position := No_Element; return; end if; Node_Maps.Next (Position.Place); end Next; function Next (Object : in Iterator; Position : in Cursor) return Cursor 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; function Next (Object : in Subgraph_Iterator; Position : in Cursor) return Cursor 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; if Position.Sub_Index not in 1 .. Object.Nodes.Last_Index or else Node_Maps.Key (Position.Place) /= Object.Nodes (Position.Sub_Index) then Result.Sub_Index := Object.Nodes.Find_Index (Node_Maps.Key (Position.Place)); if Result.Sub_Index = Node_Vectors.No_Index then return No_Element; end if; end if; if Result.Sub_Index = Object.Nodes.Last_Index then return No_Element; else Result.Sub_Index := Result.Sub_Index + 1; Result.Place := Result.Container.Connections.Find (Object.Nodes (Result.Sub_Index)); return Result; end if; end Next; ---------------- -- 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 (Container : in Cursor) return Ada.Containers.Count_Type is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Connections.Length; end Node_Count; ---------------------------- -- Node_Count_In_Subgraph -- ---------------------------- function Node_Count_In_Subgraph (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; declare It : Graph_Iterator_Interfaces.Reversible_Iterator'Class := Position.Container.Iterate_Subgraph (Position); begin return Subgraph_Iterator (It).Nodes.Length; end; end Node_Count_In_Subgraph; ---------------- -- Node_Range -- ---------------- procedure Node_Range (Container : in Graph; Minimum : out Node_ID_Type; Maximum : out Node_ID_Type) is begin if Impl.Checks and then Container.Is_Empty then raise Constraint_Error with "Graph is empty"; end if; Minimum := Node_ID_Type'Last; Maximum := Node_ID_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_ID_Type, Node_Array, Node_Vectors); Result : Node_Vectors.Vector; begin for C in Container.Connections.Iterate loop Result.Append (Node_Maps.Key (C)); end loop; return V2A (Result); end Nodes; function Nodes (Container : in Cursor) return Node_Array is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Container.Container.Nodes; end Nodes; ----------------------- -- Nodes_In_Subgraph -- ----------------------- function Nodes_In_Subgraph (Position : in Cursor) return Node_Array is Result : Node_Vectors.Vector; function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); 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; for C in Position.Container.Iterate_Subgraph (Position) loop Result.Append (Element (C)); end loop; return V2A (Result); end Nodes_In_Subgraph; -------------- -- Outbound -- -------------- function Outbound (Container : in Graph; Node : in Node_ID_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) := (ID => Ref.Element.Element (I).Edge_ID, From => Node, To => Ref.Element.Element (I).Node_ID); end loop; return Result; end; end Outbound; function Outbound (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; --------------- -- Outdegree -- --------------- function Outdegree (Container : in Graph; Node : in Node_ID_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 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; ------------- -- Parents -- ------------- function Parents (Container : in Graph; Node : in Node_ID_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_ID_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_ID = Node and not Froms.Contains (Node_Maps.Key (C)) 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 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; -------------- -- 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 begin if Position.Container = null then Position := No_Element; return; end if; Node_Maps.Previous (Position.Place); end Previous; function Previous (Object : in Iterator; Position : in Cursor) return Cursor 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; function Previous (Object : in Subgraph_Iterator; Position : in Cursor) return Cursor 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; if Position.Sub_Index not in 1 .. Object.Nodes.Last_Index or else Node_Maps.Key (Position.Place) /= Object.Nodes (Position.Sub_Index) then Result.Sub_Index := Object.Nodes.Find_Index (Node_Maps.Key (Position.Place)); if Result.Sub_Index = Node_Vectors.No_Index then return No_Element; end if; end if; if Result.Sub_Index = Object.Nodes.First_Index then return No_Element; else Result.Sub_Index := Result.Sub_Index - 1; Result.Place := Result.Container.Connections.Find (Object.Nodes (Result.Sub_Index)); return Result; end if; end Previous; ---------- -- 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_ID_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; procedure Replace_Label (Position : in 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; procedure Replace_Label (Container : in out Graph; 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; procedure Replace_Label (Container : in Cursor; Edge : in Edge_Type; Label : in Edge_Label_Type) is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; Container.Container.Replace_Label (Edge, Label); end Replace_Label; ---------- -- Swap -- ---------- procedure Swap (Container : in out Graph; Left, Right : in Node_ID_Type) is Temp_Vector : Adj_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; Impl.TE_Check (Container.Tamper_Info); -- 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.Node_ID = Left then N.Node_ID := Right; elsif N.Node_ID = Right then N.Node_ID := 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; if Left.Container /= Right.Container then raise Constraint_Error with "Left and right operands refer to different graphs"; end if; end if; Left.Container.Swap (Element (Left), Element (Right)); end Swap; --------------- -- To_Cursor -- --------------- function To_Cursor (Container : in Graph; Node : in Node_ID_Type) return Cursor is begin if not Container.Connections.Contains (Node) then return No_Element; else return (Container => Container'Unrestricted_Access, Place => Container.Connections.Find (Node), Sub_Index => Node_Vectors.Extended_Index'First); 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), Adj_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.ID, E.To)); end loop; return G : Graph := (Ada.Finalization.Controlled with Connections => Adj_Map, others => <>); end To_Graph; ------------------ -- Unused -- ------------------ function Unused (Container : in Graph) return Node_ID_Type is begin for N in Node_ID_Type'First .. Node_ID_Type'Last loop if not Container.Contains (N) then return N; end if; end loop; raise Constraint_Error with "No unused nodes available"; return Node_ID_Type'First; end Unused; function Unused (Container : in Graph) return Edge_ID_Type is begin for E in Edge_ID_Type'First .. Edge_ID_Type'Last loop if not Container.Contains (E) then return E; end if; end loop; raise Constraint_Error with "No unused edges available"; return Edge_ID_Type'First; end Unused; function Unused (Container : in Cursor) return Node_ID_Type is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Unused (Container.Container.all); end Unused; function Unused (Container : in Cursor) return Edge_ID_Type is begin if Impl.Checks and then Container.Container = null then raise Constraint_Error with "Graph does not exist"; end if; return Unused (Container.Container.all); end Unused; function Unused (Container : in Graph; Count : in Positive := 1) return Node_Array is function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); Nodes : Node_Vectors.Vector; begin for N in Node_ID_Type'First .. Node_ID_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; raise Constraint_Error with "Not enough unused nodes"; return V2A (Nodes); end Unused; --------------------- -- 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;