gnatcoll_25.0.0_d7d84483/core/src/gnatcoll-directed_graph.ads

--
--  Copyright (C) 2024, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception
--

with Ada.Containers.Vectors;
with Ada.Containers.Ordered_Sets;

package GNATCOLL.Directed_Graph is

   DG_Error : exception;

   type Directed_Graph is tagged limited private;
   --  An object representing a Direct Graph

   type DAG_Iterator is tagged limited private;
   --  An iterator on a directed acyclic graph. Note that each graph contains
   --  also its own iterator for convenience.

   type Node_Id is mod 2 ** 32 with Default_Value => 0;
   --  A node identifier in a graph structure. Limiting to 2^32 - 1 nodes is
   --  enough for all realistic case.

   No_Node : constant Node_Id := 0;
   --  Special node id value used to represents the absence of node id

   package Node_Vectors is new Ada.Containers.Vectors (Positive, Node_Id);
   subtype Node_Vector is Node_Vectors.Vector;
   Empty_Node_Vector : constant Node_Vector := Node_Vectors.Empty_Vector;

   package Node_Sets is new Ada.Containers.Ordered_Sets (Node_Id);
   subtype Node_Set is Node_Sets.Set;
   Empty_Node_Set : constant Node_Set := Node_Sets.Empty_Set;

   type Node_Array is array (Natural range <>) of Node_Id;

   function Length (Self : Directed_Graph'Class) return Natural
   with Inline => True;
   --  Return the size of the graph (i.e the number of nodes)

   function Add_Node
     (Self         : in out Directed_Graph;
      Predecessors : Node_Set := Empty_Node_Set)
     return Node_Id;
   --  Add a node to the graph and set its precedecessors. If the graph already
   --  contains 2 ^ 32 - 1 elements raise DG_Error. Otherwise return the
   --  Node_Id of the new node.
   --  Predecessors should contain only node ids of existing nodes.

   function Add_Node
     (Self         : in out Directed_Graph;
      Predecessors : Node_Array)
     return Node_Id;
   --  Same as previous function except that Predecessors are passed in an
   --  array. Note that duplicate Node_Ids in Predecessors are ignored.

   procedure Add_Predecessors
     (Self         : in out Directed_Graph;
      Node         : Node_Id;
      Predecessors : Node_Set := Empty_Node_Set);
   --  Add predecessors to an existing node. All node ids should refer to
   --  existing nodes.

   procedure Add_Predecessor
     (Self        : in out Directed_Graph;
      Node        : Node_Id;
      Predecessor : Node_Id);
   --  Add a predecessor to a node. Both nodes must belong to the graph

   function Contains (Self : Directed_Graph; Node : Node_Id) return Boolean
   with Inline => True;
   --  Return True if Self contains a node whose id is Node, False otherwise.

   function Has_Cycle (Self : in out Directed_Graph) return Boolean;
   --  Return True if the graph contains at least one cycle.

   function Shortest_Cycle (Self : in out Directed_Graph) return Node_Vector;
   --  Return the smallest circle, if any, or the empty vector

   function Topological_Sort (Self : in out Directed_Graph) return Node_Vector;
   --  Return the list of nodes in a topological order

   function Shortest_Path
     (Self           : Directed_Graph;
      Source, Target : Node_Id)
     return Node_Vector;
   --  Compute the shortest path between two vertices of the graph.
   --  If target equals to Source then the algorithm tries to find the
   --  shortest cycle including Source.
   --  If there is no path between the two vertices, then the return value is
   --  an empty vector.

   procedure Clear (Self : in out Directed_Graph);
   --  Reset the graph by removing all the nodes and stop its iterator if
   --  needed.

   --------------
   -- Iterator --
   --------------

   procedure Start_Iterator
     (Self  : in out DAG_Iterator'Class;
      Graph : Directed_Graph'Class;
      Enable_Visiting_State : Boolean := False);
   --  Initialize an iterator for the specified graph. If
   --  Enable_Visiting_State is set, then nodes states go through an
   --  intermediate state "Visiting" after the "Non_Visited" one. Nodes with
   --  the "Visiting" state are still blocking their predecessors but are not
   --  returned anymore by the Next function.
   --  The function "Complete" must be called to go from "Visiting" to
   --  "Visited" state. This mechanism can be useful for parallel tasking, as
   --  we do not want one task to keep going forward before one of its
   --  predecessor has not completed.
   --  If the iterator is already started, then it is restarted from scratch.

   function Next
      (Self  : in out DAG_Iterator'Class;
       Graph : Directed_Graph'Class;
       Node  : out Node_Id)
      return Boolean;
   --  Update the iterator to the next state.
   --
   --  The output is one of the following:
   --
   --  1- The function returns False. This means that the end of the iteration
   --     has been reached. In that case Node is always set to No_Node.
   --  2- The function returns True and Node is different from No_Node. In that
   --     case the node state is set to "visiting" or "visited" depending on
   --     how the iterator was initialized.
   --  3- The function returns True and Node is set to No_Node. This case only
   --     occurs when Enable_Visiting_State is set to True. This means that
   --     some nodes are in the visiting state and prevent the visiting of new
   --     nodes. The function will return No_Node until the some of the
   --     "visiting" nodes are marked as visited using Compilte_Visit method

   function Next
      (Self  : in out DAG_Iterator'Class;
       Graph : Directed_Graph'Class)
      return Node_Id;
   --  Update the iterator to the next state.
   --
   --  Return the next available node and set its state as visited or visiting
   --  (see Enable_Visiting_State parameter of Start_Iterator).
   --
   --  If Enable_Visiting_State was set to False the function will return
   --  No_Node on end of iteration
   --  If Enable_Visiting_State was set to True, then the function return
   --  No_Node on end of iteration or when some nodes in visiting state are
   --  blocking the visit of newer node. To do the distinction between the two
   --  state, calling Visiting_Nodes should be done. If the return set of
   --  visiting nodes is empty then it means that end of iteration was reached.

   procedure Complete_Visit
      (Self  : in out DAG_Iterator'Class;
       Graph : Directed_Graph'Class;
       Node  : Node_Id);
   --  Mark the current vertex as "Visited". Has no effect if the vertex
   --  state was not "Visiting".

   function Visiting_Nodes (Self : DAG_Iterator'Class) return Node_Set;
   --  Return the list of the Visiting nodes

   function Iterator_Started (Self : DAG_Iterator'Class) return Boolean
   with Inline => True;
   --  Return True if the iterator has been started

   -----------------------
   -- Internal Iterator --
   -----------------------

   --  Same iterator interface except that the graph's internal iterator
   --  is used.

   procedure Start_Iterator
     (Self                  : in out Directed_Graph;
      Enable_Visiting_State : Boolean := False);
   --  Initialize the iterator embedded with the graph. If
   --  Enable_Visiting_State is set, then nodes states go through an
   --  intermediate state "Visiting" after the "Non_Visited" one. Nodes with
   --  the "Visiting" state are still blocking their predecessors but are not
   --  returned anymore by the Next function.
   --  The function "Complete" must be called to go from "Visiting" to
   --  "Visited" state. This mechanism can be useful for parallel tasking, as
   --  we do not want one task to keep going forward before one of its
   --  predecessor has not completed.
   --  If the iterator is already started, then it is restarted from scratch.

   function Next
     (Self : in out Directed_Graph'Class; Node : out Node_Id) return Boolean;
   --  Update the internal iterator to the next state.
   --
   --  The output is one of the following:
   --
   --  1- The function returns False. This means that the end of the iteration
   --     has been reached. In that case Node is always set to No_Node.
   --  2- The function returns True and Node is different from No_Node. In that
   --     case the node state is set to "visiting" or "visited" depending on
   --     how the iterator was initialized.
   --  3- The function returns True and Node is set to No_Node. This case only
   --     occurs when Enable_Visiting_State is set to True. This means that
   --     some nodes are in the visiting state and prevent the visiting of new
   --     nodes. The function will return No_Node until the some of the
   --     "visiting" nodes are marked as visited using Compilte_Visit method

   function Next (Self : in out Directed_Graph'Class) return Node_Id;
   --  Update the internal iterator to the next state.
   --
   --  Return the next available node and set its state as visited or visiting
   --  (see Enable_Visiting_State parameter of Start_Iterator).
   --
   --  If Enable_Visiting_State was set to False the function will return
   --  No_Node on end of iteration
   --  If Enable_Visiting_State was set to True, then the function return
   --  No_Node on end of iteration or when some nodes in visiting state are
   --  blocking the visit of newer node. To do the distinction between the two
   --  state, calling Visiting_Nodes should be done. If the return set of
   --  visiting nodes is empty then it means that end of iteration was reached.

   procedure Complete_Visit
     (Self : in out Directed_Graph'Class; Node : Node_Id);
   --  Mark the current vertex as "Visited" within the internal iterator.
   --  Has no effect if the vertex state was not "Visiting".

   function Visiting_Nodes (Self : Directed_Graph) return Node_Set;
   --  Return the list of the Visiting nodes for the internal iterator

   function Iterator_Started (Self : Directed_Graph) return Boolean;
   --  Return True if the internal iterator has been started

private

   package Node_Set_Vectors is new Ada.Containers.Vectors
      (Positive, Node_Set, "=" => Node_Sets."=");
   subtype Node_Set_Vector is Node_Set_Vectors.Vector;
   Empty_Node_Set_Vector : constant Node_Set_Vector :=
      Node_Set_Vectors.Empty_Vector;

   package Pred_Num_Vectors is new Ada.Containers.Vectors (Positive, Natural);
   subtype Pred_Num_Vector is Pred_Num_Vectors.Vector;
   Empty_Pred_Num_Vector : constant Pred_Num_Vector :=
      Pred_Num_Vectors.Empty_Vector;

   First_Free_Node : constant := 1;

   type State is (Non_Visited, Visiting, Visited);
   --  Non_Visited : The vertex has not been iterated.
   --  Visiting    : Only used when Enable_Visiting_State is set. The vertex
   --                has been iterated but it has not been processed by the
   --                graph iterator caller. Use the "Complete" procedure to go
   --                from the "Visiting" to the "Visited" state.
   --  Visited     : The vertex has been iterated and processed.

   type DAG_Iterator is tagged limited record

      Non_Visited           : Node_Set := Empty_Node_Set;
      --  Nodes that have not been visited yet

      Visiting              : Node_Set := Empty_Node_Set;
      --  Nodes that are currently in visiting state

      Visited_Predecessors  : Pred_Num_Vector := Empty_Pred_Num_Vector;
      --  For each node of the graph, the number of predecessors that have been
      --  visited.

      Graph_Next_Free_Node  : Node_Id := No_Node;
      --  Used to detect addition of new nodes in the Graph linked to the
      --  iterator.

      Graph_Update_List_Last : Ada.Containers.Count_Type := 0;
      --  Used to detect addition of predecessors in existing nodes

      Enable_Visiting_State : Boolean := False;
      --  Indicate if there is an intermediate state "Visiting" between the
      --  "Non_Visited" and "Visited" ones.

      Started               : Boolean := False;

   end record;

   type Directed_Graph is tagged limited record
      Predecessors   : Node_Set_Vector;
      --  Set of predecessors for each node

      Successors     : Node_Set_Vector;
      --  Set of successors for each node

      Next_Free_Node : Node_Id := First_Free_Node;
      --  Next available Node_Id. As no deletion is permitted
      --  Next_Free_Node - 1 represents also the number of nodes in the graph.

      --  The following two attributes are cached on first computation
      Sort_Cache     : Node_Vectors.Vector;
      --  One topological sort of the graph's nodes

      Has_Cycle      : Boolean := False;
      --  Whether the graph contains a cycle

      Is_Cache_Valid : Boolean := True;
      --  Whether the Sort_Cache is valid. True by default with everything
      --  empty.

      Iterator       : DAG_Iterator;
      --  Internal iterator

      Update_List : Node_Vectors.Vector;
      --  Keep track of add_predecessor operations. Needed in order to track
      --  changes during iterations.
   end record;

end GNATCOLL.Directed_Graph;