| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- G N A T . G R A P H S -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2018-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Unchecked_Deallocation; |
| |
| package body GNAT.Graphs is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| function Sequence_Next_Component return Component_Id; |
| -- Produce the next handle for a component. The handle is guaranteed to be |
| -- unique across all graphs. |
| |
| -------------------- |
| -- Directed_Graph -- |
| -------------------- |
| |
| package body Directed_Graphs is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Add_Component |
| (G : Directed_Graph; |
| Comp : Component_Id; |
| Vertices : Vertex_List.Doubly_Linked_List); |
| pragma Inline (Add_Component); |
| -- Add component Comp which houses vertices Vertices to graph G |
| |
| procedure Ensure_Created (G : Directed_Graph); |
| pragma Inline (Ensure_Created); |
| -- Verify that graph G is created. Raise Not_Created if this is not the |
| -- case. |
| |
| procedure Ensure_Not_Present |
| (G : Directed_Graph; |
| E : Edge_Id); |
| pragma Inline (Ensure_Not_Present); |
| -- Verify that graph G lacks edge E. Raise Duplicate_Edge if this is not |
| -- the case. |
| |
| procedure Ensure_Not_Present |
| (G : Directed_Graph; |
| V : Vertex_Id); |
| pragma Inline (Ensure_Not_Present); |
| -- Verify that graph G lacks vertex V. Raise Duplicate_Vertex if this is |
| -- not the case. |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| Comp : Component_Id); |
| pragma Inline (Ensure_Present); |
| -- Verify that component Comp exists in graph G. Raise Missing_Component |
| -- if this is not the case. |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| E : Edge_Id); |
| pragma Inline (Ensure_Present); |
| -- Verify that edge E is present in graph G. Raise Missing_Edge if this |
| -- is not the case. |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| V : Vertex_Id); |
| pragma Inline (Ensure_Present); |
| -- Verify that vertex V is present in graph G. Raise Missing_Vertex if |
| -- this is not the case. |
| |
| procedure Free is |
| new Ada.Unchecked_Deallocation |
| (Directed_Graph_Attributes, Directed_Graph); |
| |
| function Get_Component_Attributes |
| (G : Directed_Graph; |
| Comp : Component_Id) return Component_Attributes; |
| pragma Inline (Get_Component_Attributes); |
| -- Obtain the attributes of component Comp of graph G |
| |
| function Get_Edge_Attributes |
| (G : Directed_Graph; |
| E : Edge_Id) return Edge_Attributes; |
| pragma Inline (Get_Edge_Attributes); |
| -- Obtain the attributes of edge E of graph G |
| |
| function Get_Vertex_Attributes |
| (G : Directed_Graph; |
| V : Vertex_Id) return Vertex_Attributes; |
| pragma Inline (Get_Vertex_Attributes); |
| -- Obtain the attributes of vertex V of graph G |
| |
| function Get_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id) return Edge_Set.Membership_Set; |
| pragma Inline (Get_Outgoing_Edges); |
| -- Obtain the Outgoing_Edges attribute of vertex V of graph G |
| |
| function Get_Vertices |
| (G : Directed_Graph; |
| Comp : Component_Id) return Vertex_List.Doubly_Linked_List; |
| pragma Inline (Get_Vertices); |
| -- Obtain the Vertices attribute of component Comp of graph G |
| |
| procedure Set_Component |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Component_Id); |
| pragma Inline (Set_Component); |
| -- Set attribute Component of vertex V of graph G to value Val |
| |
| procedure Set_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Edge_Set.Membership_Set); |
| pragma Inline (Set_Outgoing_Edges); |
| -- Set attribute Outgoing_Edges of vertex V of graph G to value Val |
| |
| procedure Set_Vertex_Attributes |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Vertex_Attributes); |
| pragma Inline (Set_Vertex_Attributes); |
| -- Set the attributes of vertex V of graph G to value Val |
| |
| ------------------- |
| -- Add_Component -- |
| ------------------- |
| |
| procedure Add_Component |
| (G : Directed_Graph; |
| Comp : Component_Id; |
| Vertices : Vertex_List.Doubly_Linked_List) |
| is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Add the component to the set of all components in the graph |
| |
| Component_Map.Put |
| (T => G.Components, |
| Key => Comp, |
| Value => (Vertices => Vertices)); |
| end Add_Component; |
| |
| -------------- |
| -- Add_Edge -- |
| -------------- |
| |
| procedure Add_Edge |
| (G : Directed_Graph; |
| E : Edge_Id; |
| Source : Vertex_Id; |
| Destination : Vertex_Id) |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Not_Present (G, E); |
| Ensure_Present (G, Source); |
| Ensure_Present (G, Destination); |
| |
| -- Add the edge to the set of all edges in the graph |
| |
| Edge_Map.Put |
| (T => G.All_Edges, |
| Key => E, |
| Value => |
| (Destination => Destination, |
| Source => Source)); |
| |
| -- Associate the edge with its source vertex which effectively "owns" |
| -- the edge. |
| |
| Edge_Set.Insert |
| (S => Get_Outgoing_Edges (G, Source), |
| Elem => E); |
| end Add_Edge; |
| |
| ---------------- |
| -- Add_Vertex -- |
| ---------------- |
| |
| procedure Add_Vertex |
| (G : Directed_Graph; |
| V : Vertex_Id) |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Not_Present (G, V); |
| |
| -- Add the vertex to the set of all vertices in the graph |
| |
| Vertex_Map.Put |
| (T => G.All_Vertices, |
| Key => V, |
| Value => |
| (Component => No_Component, |
| Outgoing_Edges => Edge_Set.Nil)); |
| |
| -- It is assumed that the vertex will have at least one outgoing |
| -- edge. It is important not to create the set of edges above as |
| -- the call to Put may fail in case the vertices are iterated. |
| -- This would lead to a memory leak because the set would not be |
| -- reclaimed. |
| |
| Set_Outgoing_Edges (G, V, Edge_Set.Create (1)); |
| end Add_Vertex; |
| |
| --------------- |
| -- Component -- |
| --------------- |
| |
| function Component |
| (G : Directed_Graph; |
| V : Vertex_Id) return Component_Id |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, V); |
| |
| return Get_Vertex_Attributes (G, V).Component; |
| end Component; |
| |
| ------------------------ |
| -- Contains_Component -- |
| ------------------------ |
| |
| function Contains_Component |
| (G : Directed_Graph; |
| Comp : Component_Id) return Boolean |
| is |
| begin |
| Ensure_Created (G); |
| |
| return Component_Map.Contains (G.Components, Comp); |
| end Contains_Component; |
| |
| ------------------- |
| -- Contains_Edge -- |
| ------------------- |
| |
| function Contains_Edge |
| (G : Directed_Graph; |
| E : Edge_Id) return Boolean |
| is |
| begin |
| Ensure_Created (G); |
| |
| return Edge_Map.Contains (G.All_Edges, E); |
| end Contains_Edge; |
| |
| --------------------- |
| -- Contains_Vertex -- |
| --------------------- |
| |
| function Contains_Vertex |
| (G : Directed_Graph; |
| V : Vertex_Id) return Boolean |
| is |
| begin |
| Ensure_Created (G); |
| |
| return Vertex_Map.Contains (G.All_Vertices, V); |
| end Contains_Vertex; |
| |
| ------------ |
| -- Create -- |
| ------------ |
| |
| function Create |
| (Initial_Vertices : Positive; |
| Initial_Edges : Positive) return Directed_Graph |
| is |
| G : constant Directed_Graph := new Directed_Graph_Attributes; |
| |
| begin |
| G.All_Edges := Edge_Map.Create (Initial_Edges); |
| G.All_Vertices := Vertex_Map.Create (Initial_Vertices); |
| G.Components := Component_Map.Create (Initial_Vertices); |
| |
| return G; |
| end Create; |
| |
| ----------------- |
| -- Delete_Edge -- |
| ----------------- |
| |
| procedure Delete_Edge |
| (G : Directed_Graph; |
| E : Edge_Id) |
| is |
| Source : Vertex_Id; |
| |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, E); |
| |
| Source := Source_Vertex (G, E); |
| Ensure_Present (G, Source); |
| |
| -- Delete the edge from its source vertex which effectively "owns" |
| -- the edge. |
| |
| Edge_Set.Delete (Get_Outgoing_Edges (G, Source), E); |
| |
| -- Delete the edge from the set of all edges |
| |
| Edge_Map.Delete (G.All_Edges, E); |
| end Delete_Edge; |
| |
| ------------------------ |
| -- Destination_Vertex -- |
| ------------------------ |
| |
| function Destination_Vertex |
| (G : Directed_Graph; |
| E : Edge_Id) return Vertex_Id |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, E); |
| |
| return Get_Edge_Attributes (G, E).Destination; |
| end Destination_Vertex; |
| |
| ------------- |
| -- Destroy -- |
| ------------- |
| |
| procedure Destroy (G : in out Directed_Graph) is |
| begin |
| Ensure_Created (G); |
| |
| Edge_Map.Destroy (G.All_Edges); |
| Vertex_Map.Destroy (G.All_Vertices); |
| Component_Map.Destroy (G.Components); |
| |
| Free (G); |
| end Destroy; |
| |
| ---------------------------------- |
| -- Destroy_Component_Attributes -- |
| ---------------------------------- |
| |
| procedure Destroy_Component_Attributes |
| (Attrs : in out Component_Attributes) |
| is |
| begin |
| Vertex_List.Destroy (Attrs.Vertices); |
| end Destroy_Component_Attributes; |
| |
| ----------------------------- |
| -- Destroy_Edge_Attributes -- |
| ----------------------------- |
| |
| procedure Destroy_Edge_Attributes (Attrs : in out Edge_Attributes) is |
| pragma Unreferenced (Attrs); |
| begin |
| null; |
| end Destroy_Edge_Attributes; |
| |
| -------------------- |
| -- Destroy_Vertex -- |
| -------------------- |
| |
| procedure Destroy_Vertex (V : in out Vertex_Id) is |
| pragma Unreferenced (V); |
| begin |
| null; |
| end Destroy_Vertex; |
| |
| ------------------------------- |
| -- Destroy_Vertex_Attributes -- |
| ------------------------------- |
| |
| procedure Destroy_Vertex_Attributes (Attrs : in out Vertex_Attributes) is |
| begin |
| Edge_Set.Destroy (Attrs.Outgoing_Edges); |
| end Destroy_Vertex_Attributes; |
| |
| -------------------- |
| -- Ensure_Created -- |
| -------------------- |
| |
| procedure Ensure_Created (G : Directed_Graph) is |
| begin |
| if not Present (G) then |
| raise Not_Created; |
| end if; |
| end Ensure_Created; |
| |
| ------------------------ |
| -- Ensure_Not_Present -- |
| ------------------------ |
| |
| procedure Ensure_Not_Present |
| (G : Directed_Graph; |
| E : Edge_Id) |
| is |
| begin |
| if Contains_Edge (G, E) then |
| raise Duplicate_Edge; |
| end if; |
| end Ensure_Not_Present; |
| |
| ------------------------ |
| -- Ensure_Not_Present -- |
| ------------------------ |
| |
| procedure Ensure_Not_Present |
| (G : Directed_Graph; |
| V : Vertex_Id) |
| is |
| begin |
| if Contains_Vertex (G, V) then |
| raise Duplicate_Vertex; |
| end if; |
| end Ensure_Not_Present; |
| |
| -------------------- |
| -- Ensure_Present -- |
| -------------------- |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| Comp : Component_Id) |
| is |
| begin |
| if not Contains_Component (G, Comp) then |
| raise Missing_Component; |
| end if; |
| end Ensure_Present; |
| |
| -------------------- |
| -- Ensure_Present -- |
| -------------------- |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| E : Edge_Id) |
| is |
| begin |
| if not Contains_Edge (G, E) then |
| raise Missing_Edge; |
| end if; |
| end Ensure_Present; |
| |
| -------------------- |
| -- Ensure_Present -- |
| -------------------- |
| |
| procedure Ensure_Present |
| (G : Directed_Graph; |
| V : Vertex_Id) |
| is |
| begin |
| if not Contains_Vertex (G, V) then |
| raise Missing_Vertex; |
| end if; |
| end Ensure_Present; |
| |
| --------------------- |
| -- Find_Components -- |
| --------------------- |
| |
| procedure Find_Components (G : Directed_Graph) is |
| |
| -- The components of graph G are discovered using Tarjan's strongly |
| -- connected component algorithm. Do not modify this code unless you |
| -- intimately understand the algorithm. |
| |
| ---------------- |
| -- Tarjan_Map -- |
| ---------------- |
| |
| type Visitation_Number is new Natural; |
| No_Visitation_Number : constant Visitation_Number := |
| Visitation_Number'First; |
| First_Visitation_Number : constant Visitation_Number := |
| No_Visitation_Number + 1; |
| |
| type Tarjan_Attributes is record |
| Index : Visitation_Number := No_Visitation_Number; |
| -- Visitation number |
| |
| Low_Link : Visitation_Number := No_Visitation_Number; |
| -- Lowest visitation number |
| |
| On_Stack : Boolean := False; |
| -- Set when the corresponding vertex appears on the Stack |
| end record; |
| |
| No_Tarjan_Attributes : constant Tarjan_Attributes := |
| (Index => No_Visitation_Number, |
| Low_Link => No_Visitation_Number, |
| On_Stack => False); |
| |
| procedure Destroy_Tarjan_Attributes |
| (Attrs : in out Tarjan_Attributes); |
| -- Destroy the contents of attributes Attrs |
| |
| package Tarjan_Map is new Dynamic_Hash_Tables |
| (Key_Type => Vertex_Id, |
| Value_Type => Tarjan_Attributes, |
| No_Value => No_Tarjan_Attributes, |
| Expansion_Threshold => 1.5, |
| Expansion_Factor => 2, |
| Compression_Threshold => 0.3, |
| Compression_Factor => 2, |
| "=" => Same_Vertex, |
| Destroy_Value => Destroy_Tarjan_Attributes, |
| Hash => Hash_Vertex); |
| |
| ------------------ |
| -- Tarjan_Stack -- |
| ------------------ |
| |
| package Tarjan_Stack is new Doubly_Linked_Lists |
| (Element_Type => Vertex_Id, |
| "=" => Same_Vertex, |
| Destroy_Element => Destroy_Vertex); |
| |
| ----------------- |
| -- Global data -- |
| ----------------- |
| |
| Attrs : Tarjan_Map.Dynamic_Hash_Table := Tarjan_Map.Nil; |
| Stack : Tarjan_Stack.Doubly_Linked_List := Tarjan_Stack.Nil; |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Associate_All_Vertices; |
| pragma Inline (Associate_All_Vertices); |
| -- Associate all vertices in the graph with the corresponding |
| -- components that house them. |
| |
| procedure Associate_Vertices (Comp : Component_Id); |
| pragma Inline (Associate_Vertices); |
| -- Associate all vertices of component Comp with the component |
| |
| procedure Create_Component (V : Vertex_Id); |
| pragma Inline (Create_Component); |
| -- Create a new component with root vertex V |
| |
| function Get_Tarjan_Attributes |
| (V : Vertex_Id) return Tarjan_Attributes; |
| pragma Inline (Get_Tarjan_Attributes); |
| -- Obtain the Tarjan attributes of vertex V |
| |
| function Index (V : Vertex_Id) return Visitation_Number; |
| pragma Inline (Index); |
| -- Obtain the Index attribute of vertex V |
| |
| procedure Initialize_Components; |
| pragma Inline (Initialize_Components); |
| -- Initialize or reinitialize the components of the graph |
| |
| function Is_Visited (V : Vertex_Id) return Boolean; |
| pragma Inline (Is_Visited); |
| -- Determine whether vertex V has been visited |
| |
| function Low_Link (V : Vertex_Id) return Visitation_Number; |
| pragma Inline (Low_Link); |
| -- Obtain the Low_Link attribute of vertex V |
| |
| function On_Stack (V : Vertex_Id) return Boolean; |
| pragma Inline (On_Stack); |
| -- Obtain the On_Stack attribute of vertex V |
| |
| function Pop return Vertex_Id; |
| pragma Inline (Pop); |
| -- Pop a vertex off Stack |
| |
| procedure Push (V : Vertex_Id); |
| pragma Inline (Push); |
| -- Push vertex V on Stack |
| |
| procedure Record_Visit (V : Vertex_Id); |
| pragma Inline (Record_Visit); |
| -- Save the visitation of vertex V by setting relevant attributes |
| |
| function Sequence_Next_Index return Visitation_Number; |
| pragma Inline (Sequence_Next_Index); |
| -- Procedure the next visitation number of the DFS traversal |
| |
| procedure Set_Index |
| (V : Vertex_Id; |
| Val : Visitation_Number); |
| pragma Inline (Set_Index); |
| -- Set attribute Index of vertex V to value Val |
| |
| procedure Set_Low_Link |
| (V : Vertex_Id; |
| Val : Visitation_Number); |
| pragma Inline (Set_Low_Link); |
| -- Set attribute Low_Link of vertex V to value Val |
| |
| procedure Set_On_Stack |
| (V : Vertex_Id; |
| Val : Boolean); |
| pragma Inline (Set_On_Stack); |
| -- Set attribute On_Stack of vertex V to value Val |
| |
| procedure Set_Tarjan_Attributes |
| (V : Vertex_Id; |
| Val : Tarjan_Attributes); |
| pragma Inline (Set_Tarjan_Attributes); |
| -- Set the attributes of vertex V to value Val |
| |
| procedure Visit_Successors (V : Vertex_Id); |
| pragma Inline (Visit_Successors); |
| -- Visit the successors of vertex V |
| |
| procedure Visit_Vertex (V : Vertex_Id); |
| pragma Inline (Visit_Vertex); |
| -- Visit single vertex V |
| |
| procedure Visit_Vertices; |
| pragma Inline (Visit_Vertices); |
| -- Visit all vertices in the graph |
| |
| ---------------------------- |
| -- Associate_All_Vertices -- |
| ---------------------------- |
| |
| procedure Associate_All_Vertices is |
| Comp : Component_Id; |
| Iter : Component_Iterator; |
| |
| begin |
| Iter := Iterate_Components (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Comp); |
| |
| Associate_Vertices (Comp); |
| end loop; |
| end Associate_All_Vertices; |
| |
| ------------------------ |
| -- Associate_Vertices -- |
| ------------------------ |
| |
| procedure Associate_Vertices (Comp : Component_Id) is |
| Iter : Component_Vertex_Iterator; |
| V : Vertex_Id; |
| |
| begin |
| Iter := Iterate_Component_Vertices (G, Comp); |
| while Has_Next (Iter) loop |
| Next (Iter, V); |
| |
| Set_Component (G, V, Comp); |
| end loop; |
| end Associate_Vertices; |
| |
| ---------------------- |
| -- Create_Component -- |
| ---------------------- |
| |
| procedure Create_Component (V : Vertex_Id) is |
| Curr_V : Vertex_Id; |
| Vertices : Vertex_List.Doubly_Linked_List; |
| |
| begin |
| Vertices := Vertex_List.Create; |
| |
| -- Collect all vertices that comprise the current component by |
| -- popping the stack until reaching the root vertex V. |
| |
| loop |
| Curr_V := Pop; |
| Vertex_List.Append (Vertices, Curr_V); |
| |
| exit when Same_Vertex (Curr_V, V); |
| end loop; |
| |
| Add_Component |
| (G => G, |
| Comp => Sequence_Next_Component, |
| Vertices => Vertices); |
| end Create_Component; |
| |
| ------------------------------- |
| -- Destroy_Tarjan_Attributes -- |
| ------------------------------- |
| |
| procedure Destroy_Tarjan_Attributes |
| (Attrs : in out Tarjan_Attributes) |
| is |
| pragma Unreferenced (Attrs); |
| begin |
| null; |
| end Destroy_Tarjan_Attributes; |
| |
| --------------------------- |
| -- Get_Tarjan_Attributes -- |
| --------------------------- |
| |
| function Get_Tarjan_Attributes |
| (V : Vertex_Id) return Tarjan_Attributes |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Tarjan_Map.Get (Attrs, V); |
| end Get_Tarjan_Attributes; |
| |
| ----------- |
| -- Index -- |
| ----------- |
| |
| function Index (V : Vertex_Id) return Visitation_Number is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Get_Tarjan_Attributes (V).Index; |
| end Index; |
| |
| --------------------------- |
| -- Initialize_Components -- |
| --------------------------- |
| |
| procedure Initialize_Components is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- The graph already contains a set of components. Reinitialize |
| -- them in order to accommodate the new set of components about to |
| -- be computed. |
| |
| if Number_Of_Components (G) > 0 then |
| Component_Map.Destroy (G.Components); |
| G.Components := Component_Map.Create (Number_Of_Vertices (G)); |
| end if; |
| end Initialize_Components; |
| |
| ---------------- |
| -- Is_Visited -- |
| ---------------- |
| |
| function Is_Visited (V : Vertex_Id) return Boolean is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Index (V) /= No_Visitation_Number; |
| end Is_Visited; |
| |
| -------------- |
| -- Low_Link -- |
| -------------- |
| |
| function Low_Link (V : Vertex_Id) return Visitation_Number is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Get_Tarjan_Attributes (V).Low_Link; |
| end Low_Link; |
| |
| -------------- |
| -- On_Stack -- |
| -------------- |
| |
| function On_Stack (V : Vertex_Id) return Boolean is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Get_Tarjan_Attributes (V).On_Stack; |
| end On_Stack; |
| |
| --------- |
| -- Pop -- |
| --------- |
| |
| function Pop return Vertex_Id is |
| V : Vertex_Id; |
| |
| begin |
| V := Tarjan_Stack.Last (Stack); |
| Tarjan_Stack.Delete_Last (Stack); |
| Set_On_Stack (V, False); |
| |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return V; |
| end Pop; |
| |
| ---------- |
| -- Push -- |
| ---------- |
| |
| procedure Push (V : Vertex_Id) is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| Tarjan_Stack.Append (Stack, V); |
| Set_On_Stack (V, True); |
| end Push; |
| |
| ------------------ |
| -- Record_Visit -- |
| ------------------ |
| |
| procedure Record_Visit (V : Vertex_Id) is |
| Index : constant Visitation_Number := Sequence_Next_Index; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| Set_Index (V, Index); |
| Set_Low_Link (V, Index); |
| end Record_Visit; |
| |
| ------------------------- |
| -- Sequence_Next_Index -- |
| ------------------------- |
| |
| Index_Sequencer : Visitation_Number := First_Visitation_Number; |
| -- The counter for visitation numbers. Do not directly manipulate its |
| -- value because this will destroy the Index and Low_Link invariants |
| -- of the algorithm. |
| |
| function Sequence_Next_Index return Visitation_Number is |
| Index : constant Visitation_Number := Index_Sequencer; |
| |
| begin |
| Index_Sequencer := Index_Sequencer + 1; |
| return Index; |
| end Sequence_Next_Index; |
| |
| --------------- |
| -- Set_Index -- |
| --------------- |
| |
| procedure Set_Index |
| (V : Vertex_Id; |
| Val : Visitation_Number) |
| is |
| TA : Tarjan_Attributes; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| TA := Get_Tarjan_Attributes (V); |
| TA.Index := Val; |
| Set_Tarjan_Attributes (V, TA); |
| end Set_Index; |
| |
| ------------------ |
| -- Set_Low_Link -- |
| ------------------ |
| |
| procedure Set_Low_Link |
| (V : Vertex_Id; |
| Val : Visitation_Number) |
| is |
| TA : Tarjan_Attributes; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| TA := Get_Tarjan_Attributes (V); |
| TA.Low_Link := Val; |
| Set_Tarjan_Attributes (V, TA); |
| end Set_Low_Link; |
| |
| ------------------ |
| -- Set_On_Stack -- |
| ------------------ |
| |
| procedure Set_On_Stack |
| (V : Vertex_Id; |
| Val : Boolean) |
| is |
| TA : Tarjan_Attributes; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| TA := Get_Tarjan_Attributes (V); |
| TA.On_Stack := Val; |
| Set_Tarjan_Attributes (V, TA); |
| end Set_On_Stack; |
| |
| --------------------------- |
| -- Set_Tarjan_Attributes -- |
| --------------------------- |
| |
| procedure Set_Tarjan_Attributes |
| (V : Vertex_Id; |
| Val : Tarjan_Attributes) |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| Tarjan_Map.Put (Attrs, V, Val); |
| end Set_Tarjan_Attributes; |
| |
| ---------------------- |
| -- Visit_Successors -- |
| ---------------------- |
| |
| procedure Visit_Successors (V : Vertex_Id) is |
| E : Edge_Id; |
| Iter : Outgoing_Edge_Iterator; |
| Succ : Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| Iter := Iterate_Outgoing_Edges (G, V); |
| while Has_Next (Iter) loop |
| Next (Iter, E); |
| |
| Succ := Destination_Vertex (G, E); |
| pragma Assert (Contains_Vertex (G, Succ)); |
| |
| -- The current successor has not been visited yet. Extend the |
| -- DFS traversal into it. |
| |
| if not Is_Visited (Succ) then |
| Visit_Vertex (Succ); |
| |
| Set_Low_Link (V, |
| Visitation_Number'Min (Low_Link (V), Low_Link (Succ))); |
| |
| -- The current successor has been visited, and still remains on |
| -- the stack which indicates that it does not participate in a |
| -- component yet. |
| |
| elsif On_Stack (Succ) then |
| Set_Low_Link (V, |
| Visitation_Number'Min (Low_Link (V), Index (Succ))); |
| end if; |
| end loop; |
| end Visit_Successors; |
| |
| ------------------ |
| -- Visit_Vertex -- |
| ------------------ |
| |
| procedure Visit_Vertex (V : Vertex_Id) is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| if not Is_Visited (V) then |
| Record_Visit (V); |
| Push (V); |
| Visit_Successors (V); |
| |
| -- The current vertex is the root of a component |
| |
| if Low_Link (V) = Index (V) then |
| Create_Component (V); |
| end if; |
| end if; |
| end Visit_Vertex; |
| |
| -------------------- |
| -- Visit_Vertices -- |
| -------------------- |
| |
| procedure Visit_Vertices is |
| Iter : All_Vertex_Iterator; |
| V : Vertex_Id; |
| |
| begin |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, V); |
| |
| Visit_Vertex (V); |
| end loop; |
| end Visit_Vertices; |
| |
| -- Start of processing for Find_Components |
| |
| begin |
| -- Initialize or reinitialize the components of the graph |
| |
| Initialize_Components; |
| |
| -- Prepare the extra attributes needed for each vertex, global |
| -- visitation number, and the stack where examined vertices are |
| -- placed. |
| |
| Attrs := Tarjan_Map.Create (Number_Of_Vertices (G)); |
| Stack := Tarjan_Stack.Create; |
| |
| -- Start the DFS traversal of Tarjan's SCC algorithm |
| |
| Visit_Vertices; |
| |
| Tarjan_Map.Destroy (Attrs); |
| Tarjan_Stack.Destroy (Stack); |
| |
| -- Associate each vertex with the component it belongs to |
| |
| Associate_All_Vertices; |
| end Find_Components; |
| |
| ------------------------------ |
| -- Get_Component_Attributes -- |
| ------------------------------ |
| |
| function Get_Component_Attributes |
| (G : Directed_Graph; |
| Comp : Component_Id) return Component_Attributes |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Component (G, Comp)); |
| |
| return Component_Map.Get (G.Components, Comp); |
| end Get_Component_Attributes; |
| |
| ------------------------- |
| -- Get_Edge_Attributes -- |
| ------------------------- |
| |
| function Get_Edge_Attributes |
| (G : Directed_Graph; |
| E : Edge_Id) return Edge_Attributes |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Edge (G, E)); |
| |
| return Edge_Map.Get (G.All_Edges, E); |
| end Get_Edge_Attributes; |
| |
| --------------------------- |
| -- Get_Vertex_Attributes -- |
| --------------------------- |
| |
| function Get_Vertex_Attributes |
| (G : Directed_Graph; |
| V : Vertex_Id) return Vertex_Attributes |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Vertex_Map.Get (G.All_Vertices, V); |
| end Get_Vertex_Attributes; |
| |
| ------------------------ |
| -- Get_Outgoing_Edges -- |
| ------------------------ |
| |
| function Get_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id) return Edge_Set.Membership_Set |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| return Get_Vertex_Attributes (G, V).Outgoing_Edges; |
| end Get_Outgoing_Edges; |
| |
| ------------------ |
| -- Get_Vertices -- |
| ------------------ |
| |
| function Get_Vertices |
| (G : Directed_Graph; |
| Comp : Component_Id) return Vertex_List.Doubly_Linked_List |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Component (G, Comp)); |
| |
| return Get_Component_Attributes (G, Comp).Vertices; |
| end Get_Vertices; |
| |
| -------------- |
| -- Has_Next -- |
| -------------- |
| |
| function Has_Next (Iter : All_Edge_Iterator) return Boolean is |
| begin |
| return Edge_Map.Has_Next (Edge_Map.Iterator (Iter)); |
| end Has_Next; |
| |
| -------------- |
| -- Has_Next -- |
| -------------- |
| |
| function Has_Next (Iter : All_Vertex_Iterator) return Boolean is |
| begin |
| return Vertex_Map.Has_Next (Vertex_Map.Iterator (Iter)); |
| end Has_Next; |
| |
| -------------- |
| -- Has_Next -- |
| -------------- |
| |
| function Has_Next (Iter : Component_Iterator) return Boolean is |
| begin |
| return Component_Map.Has_Next (Component_Map.Iterator (Iter)); |
| end Has_Next; |
| |
| -------------- |
| -- Has_Next -- |
| -------------- |
| |
| function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is |
| begin |
| return Vertex_List.Has_Next (Vertex_List.Iterator (Iter)); |
| end Has_Next; |
| |
| -------------- |
| -- Has_Next -- |
| -------------- |
| |
| function Has_Next (Iter : Outgoing_Edge_Iterator) return Boolean is |
| begin |
| return Edge_Set.Has_Next (Edge_Set.Iterator (Iter)); |
| end Has_Next; |
| |
| -------------- |
| -- Is_Empty -- |
| -------------- |
| |
| function Is_Empty (G : Directed_Graph) return Boolean is |
| begin |
| Ensure_Created (G); |
| |
| return |
| Edge_Map.Is_Empty (G.All_Edges) |
| and then Vertex_Map.Is_Empty (G.All_Vertices); |
| end Is_Empty; |
| |
| ----------------------- |
| -- Iterate_All_Edges -- |
| ----------------------- |
| |
| function Iterate_All_Edges |
| (G : Directed_Graph) return All_Edge_Iterator |
| is |
| begin |
| Ensure_Created (G); |
| |
| return All_Edge_Iterator (Edge_Map.Iterate (G.All_Edges)); |
| end Iterate_All_Edges; |
| |
| -------------------------- |
| -- Iterate_All_Vertices -- |
| -------------------------- |
| |
| function Iterate_All_Vertices |
| (G : Directed_Graph) return All_Vertex_Iterator |
| is |
| begin |
| Ensure_Created (G); |
| |
| return All_Vertex_Iterator (Vertex_Map.Iterate (G.All_Vertices)); |
| end Iterate_All_Vertices; |
| |
| ------------------------ |
| -- Iterate_Components -- |
| ------------------------ |
| |
| function Iterate_Components |
| (G : Directed_Graph) return Component_Iterator |
| is |
| begin |
| Ensure_Created (G); |
| |
| return Component_Iterator (Component_Map.Iterate (G.Components)); |
| end Iterate_Components; |
| |
| -------------------------------- |
| -- Iterate_Component_Vertices -- |
| -------------------------------- |
| |
| function Iterate_Component_Vertices |
| (G : Directed_Graph; |
| Comp : Component_Id) return Component_Vertex_Iterator |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, Comp); |
| |
| return |
| Component_Vertex_Iterator |
| (Vertex_List.Iterate (Get_Vertices (G, Comp))); |
| end Iterate_Component_Vertices; |
| |
| ---------------------------- |
| -- Iterate_Outgoing_Edges -- |
| ---------------------------- |
| |
| function Iterate_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id) return Outgoing_Edge_Iterator |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, V); |
| |
| return |
| Outgoing_Edge_Iterator |
| (Edge_Set.Iterate (Get_Outgoing_Edges (G, V))); |
| end Iterate_Outgoing_Edges; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| procedure Next |
| (Iter : in out All_Edge_Iterator; |
| E : out Edge_Id) |
| is |
| begin |
| Edge_Map.Next (Edge_Map.Iterator (Iter), E); |
| end Next; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| procedure Next |
| (Iter : in out All_Vertex_Iterator; |
| V : out Vertex_Id) |
| is |
| begin |
| Vertex_Map.Next (Vertex_Map.Iterator (Iter), V); |
| end Next; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| procedure Next |
| (Iter : in out Component_Iterator; |
| Comp : out Component_Id) |
| is |
| begin |
| Component_Map.Next (Component_Map.Iterator (Iter), Comp); |
| end Next; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| procedure Next |
| (Iter : in out Component_Vertex_Iterator; |
| V : out Vertex_Id) |
| is |
| begin |
| Vertex_List.Next (Vertex_List.Iterator (Iter), V); |
| end Next; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| procedure Next |
| (Iter : in out Outgoing_Edge_Iterator; |
| E : out Edge_Id) |
| is |
| begin |
| Edge_Set.Next (Edge_Set.Iterator (Iter), E); |
| end Next; |
| |
| ---------------------------------- |
| -- Number_Of_Component_Vertices -- |
| ---------------------------------- |
| |
| function Number_Of_Component_Vertices |
| (G : Directed_Graph; |
| Comp : Component_Id) return Natural |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, Comp); |
| |
| return Vertex_List.Size (Get_Vertices (G, Comp)); |
| end Number_Of_Component_Vertices; |
| |
| -------------------------- |
| -- Number_Of_Components -- |
| -------------------------- |
| |
| function Number_Of_Components (G : Directed_Graph) return Natural is |
| begin |
| Ensure_Created (G); |
| |
| return Component_Map.Size (G.Components); |
| end Number_Of_Components; |
| |
| --------------------- |
| -- Number_Of_Edges -- |
| --------------------- |
| |
| function Number_Of_Edges (G : Directed_Graph) return Natural is |
| begin |
| Ensure_Created (G); |
| |
| return Edge_Map.Size (G.All_Edges); |
| end Number_Of_Edges; |
| |
| ------------------------------ |
| -- Number_Of_Outgoing_Edges -- |
| ------------------------------ |
| |
| function Number_Of_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id) return Natural |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, V); |
| |
| return Edge_Set.Size (Get_Outgoing_Edges (G, V)); |
| end Number_Of_Outgoing_Edges; |
| |
| ------------------------ |
| -- Number_Of_Vertices -- |
| ------------------------ |
| |
| function Number_Of_Vertices (G : Directed_Graph) return Natural is |
| begin |
| Ensure_Created (G); |
| |
| return Vertex_Map.Size (G.All_Vertices); |
| end Number_Of_Vertices; |
| |
| ------------- |
| -- Present -- |
| ------------- |
| |
| function Present (G : Directed_Graph) return Boolean is |
| begin |
| return G /= Nil; |
| end Present; |
| |
| ------------------- |
| -- Set_Component -- |
| ------------------- |
| |
| procedure Set_Component |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Component_Id) |
| is |
| VA : Vertex_Attributes; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| VA := Get_Vertex_Attributes (G, V); |
| VA.Component := Val; |
| Set_Vertex_Attributes (G, V, VA); |
| end Set_Component; |
| |
| ------------------------ |
| -- Set_Outgoing_Edges -- |
| ------------------------ |
| |
| procedure Set_Outgoing_Edges |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Edge_Set.Membership_Set) |
| is |
| VA : Vertex_Attributes; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| VA := Get_Vertex_Attributes (G, V); |
| VA.Outgoing_Edges := Val; |
| Set_Vertex_Attributes (G, V, VA); |
| end Set_Outgoing_Edges; |
| |
| --------------------------- |
| -- Set_Vertex_Attributes -- |
| --------------------------- |
| |
| procedure Set_Vertex_Attributes |
| (G : Directed_Graph; |
| V : Vertex_Id; |
| Val : Vertex_Attributes) |
| is |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Contains_Vertex (G, V)); |
| |
| Vertex_Map.Put (G.All_Vertices, V, Val); |
| end Set_Vertex_Attributes; |
| |
| ------------------- |
| -- Source_Vertex -- |
| ------------------- |
| |
| function Source_Vertex |
| (G : Directed_Graph; |
| E : Edge_Id) return Vertex_Id |
| is |
| begin |
| Ensure_Created (G); |
| Ensure_Present (G, E); |
| |
| return Get_Edge_Attributes (G, E).Source; |
| end Source_Vertex; |
| end Directed_Graphs; |
| |
| -------------------- |
| -- Hash_Component -- |
| -------------------- |
| |
| function Hash_Component (Comp : Component_Id) return Bucket_Range_Type is |
| begin |
| return Bucket_Range_Type (Comp); |
| end Hash_Component; |
| |
| ------------- |
| -- Present -- |
| ------------- |
| |
| function Present (Comp : Component_Id) return Boolean is |
| begin |
| return Comp /= No_Component; |
| end Present; |
| |
| ----------------------------- |
| -- Sequence_Next_Component -- |
| ----------------------------- |
| |
| Component_Sequencer : Component_Id := First_Component; |
| -- The counter for component handles. Do not directly manipulate its value |
| -- because this will destroy the invariant of the handles. |
| |
| function Sequence_Next_Component return Component_Id is |
| Component : constant Component_Id := Component_Sequencer; |
| |
| begin |
| Component_Sequencer := Component_Sequencer + 1; |
| return Component; |
| end Sequence_Next_Component; |
| |
| end GNAT.Graphs; |
