generic_directed_weighted_graph.ads

--                                                                    --
--  package                         Copyright (c)  Dmitry A. Kazakov  --
--     Generic_Directed_Weighted_Graph             Luebeck            --
--  Interface                                      Winter, 2009       --
--                                                                    --
--                                Last revision :  10:10 27 Dec 2009  --
--                                                                    --
--  This  library  is  free software; you can redistribute it and/or  --
--  modify it under the terms of the GNU General Public  License  as  --
--  published by the Free Software Foundation; either version  2  of  --
--  the License, or (at your option) any later version. This library  --
--  is distributed in the hope that it will be useful,  but  WITHOUT  --
--  ANY   WARRANTY;   without   even   the   implied   warranty   of  --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU  --
--  General  Public  License  for  more  details.  You  should  have  --
--  received  a  copy  of  the GNU General Public License along with  --
--  this library; if not, write to  the  Free  Software  Foundation,  --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.    --
--                                                                    --
--  As a special exception, if other files instantiate generics from  --
--  this unit, or you link this unit with other files to produce  an  --
--  executable, this unit does not by  itself  cause  the  resulting  --
--  executable to be covered by the GNU General Public License. This  --
--  exception  does not however invalidate any other reasons why the  --
--  executable file might be covered by the GNU Public License.       --
--____________________________________________________________________--
--
--  This generic package provides directed graphs of nodes. Nodes can be
--  of any type. The type of the nodes is the package's formal parameter
--  Node_Type.
--
--  The nodes of a graph are never copied when inserted or removed  from
--  the  graph.  All  operations  are  referential.  A node can have any
--  number of children and parent nodes. The graph can be constrained to
--  be acyclic, in which case adding a child checks this constraint.
--
--     Node_Type             - The node type
--     Weight                - The edge weight type
--     Pool                  - The storage pool to use for the nodes
--     Minimal_Parents_Size  - Minimal additionally allocated size
--     Minimal_Children_Size - Minimal additionally allocated size
--     Increment             - By which the map is enlarged if necessary
--     Equal                 - Equivalence of the nodes in a set
--     Less                  - Order of the nodes in a set
--
with System;                   use System;
with System.Storage_Elements;  use System.Storage_Elements;
with System.Storage_Pools;     use System.Storage_Pools;

with Generic_Set;
with Generic_Unbounded_Array;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

generic
   type Node_Type (<>) is limited private;
   type Weight_Type (<>) is private;
   Pool                  : in out Root_Storage_Pool'Class;
   Minimal_Parents_Size  : Positive := 16;
   Minimal_Children_Size : Positive := 16;
   Increment             : Natural  := 50;
   with function Equal
                 (  Left, Right : access Node_Type
                 )  return Boolean is <>;
   with function Equal
                 (  Left, Right : access Weight_Type
                 )  return Boolean is <>;
   with function Less
                 (  Left, Right : access Node_Type
                 )  return Boolean is <>;
   with function Less
                 (  Left, Right : access Weight_Type
                 )  return Boolean is <>;
package Generic_Directed_Weighted_Graph is
--
-- Node_Storage_Pool -- The type of a proxy pool that keeps the nodes.
--
--    Host - The pool to take the memory from
--
   type Node_Storage_Pool (Host : access Root_Storage_Pool'Class) is
      new Root_Storage_Pool with null record;
--
-- Allocate -- Overrides System.Storage_Pools...
--
   procedure Allocate
             (  Pool            : in out Node_Storage_Pool;
                Storage_Address : out Address;
                Size            : Storage_Count;
                Alignment       : Storage_Count
             );
--
-- Deallocate -- Overrides System.Storage_Pools...
--
   procedure Deallocate
             (  Pool            : in out Node_Storage_Pool;
                Storage_Address : in Address;
                Size            : Storage_Count;
                Alignment       : Storage_Count
             );
--
-- Storage_Size -- Overrides System.Storage_Pools...
--
   function Storage_Size (Pool : Node_Storage_Pool)
      return Storage_Count;
--
-- Node_Pool -- The pool of the graph nodes
--
   Node_Pool : Node_Storage_Pool (Pool'Access);
------------------------------------------------------------------------
-- Node -- A  reference  to  a  node  of  a graph. The node points to an
--         instance of the type node type. Nodes are  allocated  in  the
-- pool Node_Pool. When a node is deallocated it  is  checked  that  the
-- node is not in any graph, otherwise Program_Error is propagated.
--
   type Node is access Node_Type;
   for Node'Storage_Pool use Node_Pool;
   for Node'Size use Integer_Address'Size;
--
-- Subgraph_Type -- The type of a subgraph
--
--    Ancestor   - An ancestor node
--    Descendant - A descendant node
--    Self       - The node itself
--
   type Subgraph_Type is mod 2**3;
   Self       : constant Subgraph_Type := 2**0;
   Ancestor   : constant Subgraph_Type := 2**1;
   Descendant : constant Subgraph_Type := 2**2;
   Any        : constant Subgraph_Type := Subgraph_Type'Last;
--
-- Nodes_Array -- List of nodes
--
   type Nodes_Array is array (Positive range <>) of Node;
--
-- Classify -- According to the given weight
--
--    Parent - The parent node
--    Weight - The weight
--    Lower  - The lower bound child position
--    Upper  - The upper bound child position
--
-- This procedure classifies the children of  Parent  according  to  the
-- value  of  Weight. The output Lower is the position of the child node
-- with the greatest weight less or equal to Weight. When  there  is  no
-- such  child Lower is 0. The output Upper is the position of the child
-- node with the least weight greater or equal to Weight. When there  is
-- no such child Upper is the number of children + 1. When  there  is  a
-- child  with  the  weight  equal  to  Weight, then Lower = Upper = the
-- position of the child. Otherwise Lower = Upper - 1.  When  Lower  and
-- Upper are valid positions of nodes, then the interval of  weights  of
-- these nodes contains Weight.
--
-- Exceptions :
--
--    Constraint_Error - Parent is null
--
   procedure Classify
             (  Parent : Node;
                Weight : Weight_Type;
                Lower  : out Natural;
                Upper  : out Positive
             );
--
-- Connect -- Add a new arc in the graph
--
--    Parent  - The parent node
--    Child   - The child node
--    Weight  - The edge weight
--    Acyclic - The constraint
--
-- This  procedure creates a directed arc from Parent to Child. When the
-- arc already exists, this operation replaces the weight.  Additionally
-- when  Acyclic  is  true, it is checked that the arc does not create a
-- cycle in the graph, that is  when  Child  would  be  an  ancestor  of
-- Parent.
--
-- Exceptions :
--
--    Argument_Error   - There is an equivalent edge in the graph
--    Constraint_Error - Parent  or  child  is  null or else Acyclic and
--                       Parent is descendant of Child
--
   procedure Connect
             (  Parent  : Node;
                Child   : Node;
                Weight  : Weight_Type;
                Acyclic : Boolean := True
             );
--
-- Delete -- A subgraph rooted in a node
--
--    Vertex   - The root node
--    Subgraph - Indicates the graph to remove
--
-- This procedure removes a subgraph rooted  in  Vertex.  The  parameter
-- Subgraph specifies which parts of the graph to be removed and freed.
--
   procedure Delete
             (  Vertex   : in out Node;
                Subgraph : Subgraph_Type := Any
             );
--
-- Disconnect -- Remove arc from the graph
--
--    Parent - A node
--    Child  - A node
--
-- The arc from Parent to Child if any is removed.
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   procedure Disconnect (Parent : Node; Child : Node);
--
-- Find_Child -- Get the position of an immediate descendant
--
--    Parent - The node
--    Child  - The node
--
-- Returns :
--
--    Child's number or else 0 if it is unrelated to Parent
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   function Find_Child (Parent : Node; Child : Node) return Natural;
--
-- Find_Parent -- Get the position of an immediate ancestor
--
--    Parent - The node
--    Child  - The node
--
-- Returns :
--
--    Parent's number or else 0 if it is unrelated to Child
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   function Find_Parent (Parent : Node; Child : Node) return Natural;
--
-- Free -- A node
--
-- Exceptions :
--
--    Program_Error - Node  is  in  a graph (including the case when the
--                    node is a parent or a child of itself
--
   procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node);
--
-- Get_Children -- Get immediate descendants of a node
--
--    Parent - The node
--
-- The nodes in the array are ordered  according  to  their  weights  as
-- defined by the formal functions Equal and Less.  The nodes in the set
-- of children are ordered by the contents.
--
-- Returns :
--
--    The array of children
--
-- Exceptions :
--
--    Constraint_Error - Parent is null
--
   function Get_Children (Parent : Node) return Nodes_Array;
--
-- Get_Children_Number -- Get the number of immediate descendants
--
--    Parent - The node
--
-- Returns :
--
--    The number of children
--
-- Exceptions :
--
--    Constraint_Error - Parent is null
--
   function Get_Children_Number (Parent : Node) return Natural;
--
-- Get_Child -- Get an immediate descendant by its number
--
--    Parent - The node
--    Child  - The position of the child 1..Get_Children_Number
--
-- The children of Parent are ordered  according  to  their  weights  as
-- defined by the formal functions Equal and Less.
--
-- Returns :
--
--    The child node
--
-- Exceptions :
--
--    Constraint_Error - No such child or Parent is null
--
   function Get_Child (Parent : Node; Child : Positive) return Node;
--
-- Get_Parent -- Get an immediate ancestor by its number
--
--    Child  - The node
--    Parent - The position of the child 1..Get_Parents_Number
--
-- The parents of Child are ordered by their contents according  to  the
-- the formal functions Equal and Less.
--
-- Returns :
--
--    The parent node
--
-- Exceptions :
--
--    Constraint_Error - No such parent or child is null
--
   function Get_Parent (Child : Node; Parent : Positive) return Node;
--
-- Get_Parents -- Get immediate ancestors of a node
--
--    Child - The node
--
-- The  nodes  in the array are ordered by the nodes contents as defined
-- by the formal function Equal and Less.
--
-- Returns :
--
--    The array of parents
--
-- Exceptions :
--
--    Constraint_Error - Child is null
--
   function Get_Parents (Child : Node) return Nodes_Array;
--
-- Get_Parents_Number -- Get the number of immediate ancestors
--
--    Child - The node
--
-- Returns :
--
--    The number of parents
--
-- Exceptions :
--
--    Constraint_Error - Child is null
--
   function Get_Parents_Number (Child : Node) return Natural;
--
-- Get_Weight -- Get the weight an edge by its number or node
--
--    Parent - The node
--    Child  - The child
--
-- The   parameter   Chails   is   either  the  position  of  the  child
-- 1..Get_Children_Number or else the child itself.
--
-- Returns :
--
--    The weight of the edge to the child
--
-- Exceptions :
--
--    Constraint_Error - No such edge
--
   function Get_Weight (Parent : Node; Child : Node) return Weight_Type;
   function Get_Weight (Parent : Node; Child : Positive)
      return Weight_Type;
--
-- Is_Ancestor -- Check for a path in the graph
--
--    Parent - A node
--    Child  - A node
--
-- Returns :
--
--    True if there is a path from Parent to Child
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   function Is_Ancestor (Parent : Node; Child : Node) return Boolean;
--
-- Is_Descendant -- Check for a path in the graph
--
--    Child  - A node
--    Parent - A node
--
-- Returns :
--
--    True if there is a path from Parent to Child
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   function Is_Descendant (Child : Node; Parent : Node) return Boolean;
--
-- Is_Connected -- Check for a path in the graph
--
--    Vertex - A node
--
-- Returns :
--
--    True if there edges connecting the node Vertex
--
-- Exceptions :
--
--    Constraint_Error - Vertex is null
--
   function Is_Connected (Vertex : Node) return Boolean;
--
-- Is_Sibling -- Check if two nodes have a common parent
--
--    Left, Right - Nodes
--
-- Returns :
--
--    True if Left and Right have a common parent
--
-- Exceptions :
--
--    Constraint_Error - Left or Right is null
--
   function Is_Sibling (Left, Right : Node) return Boolean;
--
-- Precedes -- Node objects order
--
--    Left, Right - Nodes to compare
--
-- Returns :
--
--    True if Left precedes Right
--
   function Precedes (Left, Right : Node) return Boolean;
--
-- Related -- Graph relation
--
--    Parent - A node
--    Child  - A node
--
-- Returns :
--
--    True if Parent is an immediate ancestor of Child
--
-- Exceptions :
--
--    Constraint_Error - Parent or Child is null
--
   function Related (Parent : Node; Child : Node) return Boolean;
--
-- Same -- Node objects equivalence
--
--    Left, Right - Nodes to compare
--
-- Returns :
--
--    True if Left precedes Right
--
   function Same (Left, Right : Node) return Boolean;
--
-- Node_Arrays -- Unbounded arrays of nodes (instantiation)
--
   package Node_Arrays is
      new Generic_Unbounded_Array
          (  Index_Type        => Positive,
             Object_Type       => Node,
             Object_Array_Type => Nodes_Array,
             Null_Element      => null
          );
--
-- Node_Sets -- Sets of nodes
--
   package Node_Sets is
      new Generic_Set
          (  Object_Type  => Node,
             Null_Element => null,
             "="          => Same,
             "<"          => Precedes
          );

   function Get_Children (Parent : Node) return Node_Sets.Set;
   function Get_Parents (Child : Node) return Node_Sets.Set;

private
   pragma Inline (Precedes);
   pragma Inline (Same);

   function "<" (Left, Right : Node) return Boolean;
   pragma Inline ("<");

   package Node_Address_Sets is new Generic_Set (Node, null);

end Generic_Directed_Weighted_Graph;