path: root/src/directed_graphs.ads

--  This source is licensed under the Sunset License v1.0


pragma Warnings (Off, """Ada.Containers.Helpers"" is an internat GNAT unit");
pragma Warnings (Off, "use of this unit is non-portable and version-dependent");


with

    Ada.Iterator_Interfaces;

private with

    Ada.Containers.Helpers,
    Ada.Finalization,
    Ada.Streams,
    Ada.Containers.Ordered_Maps,
    Ada.Containers.Vectors;


generic

    type Node_ID_Type is (<>);
    type Edge_ID_Type is (<>);

    type Node_Label_Type is private;
    type Edge_Label_Type is private;

    with function "="
           (Left, Right : in Node_ID_Type)
        return Boolean is <>;

    with function "="
           (Left, Right : in Edge_ID_Type)
        return Boolean is <>;

    with function "="
           (Left, Right : in Node_Label_Type)
        return Boolean is <>;

    with function "="
           (Left, Right : in Edge_Label_Type)
        return Boolean is <>;

package Directed_Graphs is


    pragma Preelaborate;
    pragma Remote_Types;




    subtype Extended_Node_ID_Type is Node_ID_Type'Base
        range Node_ID_Type'Pred (Node_ID_Type'First) .. Node_ID_Type'Last;

    No_Node : constant Extended_Node_ID_Type := Extended_Node_ID_Type'First;

    type Node_Array is array (Positive range <>) of Node_ID_Type;

    subtype Path is Node_Array;




    type Edge_Type is record
        ID   : Edge_ID_Type;
        From : Node_ID_Type;
        To   : Node_ID_Type;
    end record;

    type Edge_Array is array (Positive range <>) of Edge_Type;

    function "<"
           (Left, Right : in Edge_Type)
        return Boolean;




    type Graph is tagged private;

    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);

    No_Element : constant Cursor;

    function Has_Element
           (Position : in Cursor)
        return Boolean;

    function Element
           (Position : in Cursor)
        return Extended_Node_ID_Type;

    package Graph_Iterator_Interfaces is new
        Ada.Iterator_Interfaces (Cursor, Has_Element);

    Empty_Graph : constant Graph;

    overriding function "="
           (Left, Right : in Graph)
        return Boolean;

    function To_Graph
           (Nodes : in Node_Array;
            Edges : in Edge_Array)
        return Graph;

    function To_Cursor
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Cursor;




    procedure Assign
           (Target : in out Graph;
            Source : in     Graph);

    function Copy
           (Source : in Graph)
        return Graph;

    procedure Move
           (Target, Source : in out Graph);




    function Is_Empty
           (Container : in Graph)
        return Boolean;

    procedure Clear
           (Container : in out Graph);

    procedure Clear_Labels
           (Container : in out Graph);




    function Node_Count
           (Container : in Graph)
        return Ada.Containers.Count_Type;

    function Node_Count
           (Container : in Cursor)
        return Ada.Containers.Count_Type;

    function Node_Count_In_Subgraph
           (Position : in Cursor)
        return Ada.Containers.Count_Type;

    function Edge_Count
           (Container : in Graph)
        return Ada.Containers.Count_Type;

    function Edge_Count
           (Container : in Cursor)
        return Ada.Containers.Count_Type;

    function Edge_Count_In_Subgraph
           (Position : in Cursor)
        return Ada.Containers.Count_Type;

    function Nodes
           (Container : in Graph)
        return Node_Array;

    function Nodes
           (Container : in Cursor)
        return Node_Array;

    function Nodes_In_Subgraph
           (Position : in Cursor)
        return Node_Array;

    function Edges
           (Container : in Graph)
        return Edge_Array;

    function Edges
           (Container : in Cursor)
        return Edge_Array;

    function Edges_In_Subgraph
           (Position : in Cursor)
        return Edge_Array;

    procedure Node_Range
           (Container : in     Graph;
            Minimum   :    out Node_ID_Type;
            Maximum   :    out Node_ID_Type);

    function Unused
           (Container : in Graph)
        return Node_ID_Type;

    function Unused
           (Container : in Graph)
        return Edge_ID_Type;

    function Unused
           (Container : in Cursor)
        return Node_ID_Type;

    function Unused
           (Container : in Cursor)
        return Edge_ID_Type;

    function Unused
           (Container : in Graph;
            Count     : in Positive := 1)
        return Node_Array;




    procedure Insert
           (Container : in out Graph;
            Node      : in     Node_ID_Type);

    procedure Insert
           (Container : in out Graph;
            Node      : in     Node_ID_Type;
            Label     : in     Node_Label_Type);

    procedure Insert
           (Container : in Cursor;
            Node      : in Node_ID_Type);

    procedure Insert
           (Container : in Cursor;
            Node      : in Node_ID_Type;
            Label     : in Node_Label_Type);

    procedure Insert
           (Container : in out Graph;
            Nodes     : in     Node_Array);

    procedure Insert
           (Container : in out Graph;
            Edge      : in     Edge_Type);

    procedure Insert
           (Container : in out Graph;
            Edge      : in     Edge_Type;
            Label     : in     Edge_Label_Type);

    procedure Insert
           (Container : in Cursor;
            Edge      : in Edge_Type);

    procedure Insert
           (Container : in Cursor;
            Edge      : in Edge_Type;
            Label     : in Edge_Label_Type);

    procedure Insert
           (Container : in out Graph;
            Edges     : in     Edge_Array);

    procedure Delete
           (Container : in out Graph;
            Node      : in     Node_ID_Type);

    procedure Delete
           (Position : in out Cursor);

    procedure Delete
           (Container : in out Graph;
            Nodes     : in     Node_Array);

    procedure Delete
           (Container : in out Graph;
            Edge      : in     Edge_Type);

    procedure Delete
           (Container : in Cursor;
            Edge      : in Edge_Type);

    procedure Delete
           (Container : in out Graph;
            Edges     : in     Edge_Array);

    procedure Append_Label
           (Container : in out Graph;
            Node      : in     Node_ID_Type;
            Label     : in     Node_Label_Type);

    procedure Append_Label
           (Position : in Cursor;
            Label    : in Node_Label_Type);

    procedure Append_Label
           (Container : in out Graph;
            Edge      : in     Edge_Type;
            Label     : in     Edge_Label_Type);

    procedure Append_Label
           (Container : in Cursor;
            Edge      : in Edge_Type;
            Label     : in Edge_Label_Type);

    procedure Replace_Label
           (Container : in out Graph;
            Node      : in     Node_ID_Type;
            Label     : in     Node_Label_Type);

    procedure Replace_Label
           (Position : in Cursor;
            Label    : in Node_Label_Type);

    procedure Replace_Label
           (Container : in out Graph;
            Edge      : in     Edge_Type;
            Label     : in     Edge_Label_Type);

    procedure Replace_Label
           (Container : in Cursor;
            Edge      : in Edge_Type;
            Label     : in Edge_Label_Type);

    procedure Delete_Label
           (Container : in out Graph;
            Node      : in     Node_ID_Type);

    procedure Delete_Label
           (Position : in Cursor);

    procedure Delete_Label
           (Container : in out Graph;
            Edge      : in     Edge_Type);

    procedure Delete_Label
           (Container : in Cursor;
            Edge      : in Edge_Type);

    procedure Delete_Subgraph
           (Position : in out Cursor);

    procedure Swap
           (Container   : in out Graph;
            Left, Right : in     Node_ID_Type);

    procedure Swap
           (Left, Right : in out Cursor);




    type Node_Label_Constant_Reference
        (Element : not null access constant Node_Label_Type) is private
    with Implicit_Dereference => Element;

    function Constant_Label_Reference
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Node_Label_Constant_Reference;

    function Constant_Label_Reference
           (Position : in Cursor)
        return Node_Label_Constant_Reference;

    type Node_Label_Reference
        (Element : not null access Node_Label_Type) is private
    with Implicit_Dereference => Element;

    function Label_Reference
           (Container : aliased in out Graph;
            Node      : in             Node_ID_Type)
        return Node_Label_Reference;

    function Label_Reference
           (Position : in Cursor)
        return Node_Label_Reference;

    type Edge_Label_Constant_Reference
        (Element : not null access constant Edge_Label_Type) is private
    with Implicit_Dereference => Element;

    function Constant_Label_Reference
           (Container : in Graph;
            Edge      : in Edge_Type)
        return Edge_Label_Constant_Reference;

    function Constant_Label_Reference
           (Container : in Cursor;
            Edge      : in Edge_Type)
        return Edge_Label_Constant_Reference;

    type Edge_Label_Reference
        (Element : not null access Edge_Label_Type) is private
    with Implicit_Dereference => Element;

    function Label_Reference
           (Container : aliased in out Graph;
            Edge      : in             Edge_Type)
        return Edge_Label_Reference;

    function Label_Reference
           (Container : in Cursor;
            Edge      : in Edge_Type)
        return Edge_Label_Reference;




    function Has_Label
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Boolean;

    function Has_Label
           (Position : in Cursor)
        return Boolean;

    function Has_Label
           (Container : in Graph;
            Edge      : in Edge_Type)
        return Boolean;

    function Has_Label
           (Container : in Cursor;
            Edge      : in Edge_Type)
        return Boolean;

    function Label
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Node_Label_Type;

    function Label
           (Position : in Cursor)
        return Node_Label_Type;

    function Label
           (Container : in Graph;
            Edge      : in Edge_Type)
        return Edge_Label_Type;

    function Label
           (Container : in Cursor;
            Edge      : in Edge_Type)
        return Edge_Label_Type;

    function Neighbors
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Node_Array;

    function Neighbors
           (Position : in Cursor)
        return Node_Array;

    function Parents
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Node_Array;

    function Parents
           (Position : in Cursor)
        return Node_Array;

    function Children
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Node_Array;

    function Children
           (Position : in Cursor)
        return Node_Array;

    function Outbound
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Edge_Array;

    function Outbound
           (Position : in Cursor)
        return Edge_Array;

    function Inbound
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Edge_Array;

    function Inbound
           (Position : in Cursor)
        return Edge_Array;

    function Between
           (Container     : in Graph;
            Parent, Child : in Node_ID_Type)
        return Edge_Array;

    function Between
           (Parent, Child : in Cursor)
        return Edge_Array;

    function Outdegree
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Ada.Containers.Count_Type;

    function Outdegree
           (Position : in Cursor)
        return Ada.Containers.Count_Type;

    function Indegree
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Ada.Containers.Count_Type;

    function Indegree
           (Position : in Cursor)
        return Ada.Containers.Count_Type;

    function Degree
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Ada.Containers.Count_Type;

    function Degree
           (Position : in Cursor)
        return Ada.Containers.Count_Type;

    function Has_Edge
           (Container     : in Graph;
            Parent, Child : in Node_ID_Type)
        return Boolean;

    function Has_Edge
           (Parent, Child : in Cursor)
        return Boolean;

    function Has_Labeled_Edge
           (Container     : in Graph;
            Parent, Child : in Node_ID_Type)
        return Boolean;

    function Has_Labeled_Edge
           (Parent, Child : in Cursor)
        return Boolean;

    function Has_Neighbor
           (Container   : in Graph;
            Left, Right : in Node_ID_Type)
        return Boolean;

    function Has_Neighbor
           (Left, Right : in Cursor)
        return Boolean;




    function Find
           (Container : in Graph;
            Label     : in Node_Label_Type)
        return Node_Array;

    function Find
           (Container : in Graph;
            Label     : in Edge_Label_Type)
        return Edge_Array;

    function Find_In_Subgraph
           (Position : in Cursor;
            Label    : in Node_Label_Type)
        return Node_Array;

    function Find_In_Subgraph
           (Position : in Cursor;
            Label    : in Edge_Label_Type)
        return Edge_Array;

    function Contains
           (Container : in Graph;
            Node      : in Node_ID_Type)
        return Boolean;

    function Contains
           (Container : in Graph;
            Node      : in Node_ID_Type;
            Label     : in Node_Label_Type)
        return Boolean;

    function Contains
           (Container : in Graph;
            Edge_ID   : in Edge_ID_Type)
        return Boolean;

    function Contains
           (Container : in Graph;
            Edge      : in Edge_Type)
        return Boolean;

    function Contains
           (Container : in Graph;
            Edge      : in Edge_Type;
            Label     : in Edge_Label_Type)
        return Boolean;

    function Contains_Label
           (Container : in Graph;
            Label     : in Node_Label_Type)
        return Boolean;

    function Contains_Label
           (Container : in Graph;
            Label     : in Edge_Label_Type)
        return Boolean;

    function Contains_In_Subgraph
           (Position : in Cursor;
            Node     : in Node_ID_Type)
        return Boolean;

    function Contains_In_Subgraph
           (Position : in Cursor;
            Node     : in Node_ID_Type;
            Label    : in Node_Label_Type)
        return Boolean;

    function Contains_In_Subgraph
           (Position : in Cursor;
            Edge_ID  : in Edge_ID_Type)
        return Boolean;

    function Contains_In_Subgraph
           (Position : in Cursor;
            Edge     : in Edge_Type)
        return Boolean;

    function Contains_In_Subgraph
           (Position : in Cursor;
            Edge     : in Edge_Type;
            Label    : in Edge_Label_Type)
        return Boolean;

    function Contains_Label_In_Subgraph
           (Position : in Cursor;
            Label    : in Node_Label_Type)
        return Boolean;

    function Contains_Label_In_Subgraph
           (Position : in Cursor;
            Label    : in Edge_Label_Type)
        return Boolean;




    --  Iterates through all Nodes in the Graph in order of Node_ID_Type.
    function Iterate
           (Container : in Graph)
        return Graph_Iterator_Interfaces.Reversible_Iterator'Class;

    --  Iterates through all reachable Nodes in the subgraph in order
    --  of Node_ID_Type. Note that this is NOT the same as the order of
    --  either breadth first or depth first search.
    function Iterate_Subgraph
           (Container : in Graph;
            Position  : in Cursor)
        return Graph_Iterator_Interfaces.Reversible_Iterator'Class;

    function First
           (Container : in Graph)
        return Cursor;

    function Last
           (Container : in Graph)
        return Cursor;

    function Next
           (Position : in Cursor)
        return Cursor;

    procedure Next
           (Position : in out Cursor);

    function Previous
           (Position : in Cursor)
        return Cursor;

    procedure Previous
           (Position : in out Cursor);

    function Follow
           (Position : in Cursor;
            Edge     : in Edge_Type)
        return Cursor;

    function Cursor_To
           (Position : in Cursor;
            Node     : in Node_ID_Type)
        return Cursor;


private


    pragma Inline (Append_Label);
    pragma Inline (Assign);
    pragma Inline (Copy);
    pragma Inline (Degree);
    pragma Inline (Delete_Label);
    pragma Inline (Element);
    pragma Inline (Has_Element);
    pragma Inline (Has_Label);
    pragma Inline (Has_Labeled_Edge);
    pragma Inline (Has_Neighbor);
    pragma Inline (Is_Empty);
    pragma Inline (Label);
    pragma Inline (Move);
    pragma Inline (Replace_Label);
    pragma Inline (To_Cursor);




    --  These need to be replaced with my own nested packages with
    --  separate bodies, as Ada.Containers.Helpers is GNAT-specific
    package Help renames Ada.Containers.Helpers;
    package Impl is new Help.Generic_Implementation;

    package Streams renames Ada.Streams;

    type Node_Adj is record
        Edge_ID : Edge_ID_Type;
        Node_ID : Node_ID_Type;
    end record;

    package Node_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Node_ID_Type);

    package Adj_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Node_Adj);

    package Edge_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Edge_Type);

    use type Node_Vectors.Vector;
    use type Adj_Vectors.Vector;
    use type Ada.Containers.Count_Type;

    package Node_Sort is new Node_Vectors.Generic_Sorting;

    package Node_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type        => Node_ID_Type,
        Element_Type    => Adj_Vectors.Vector);

    package Node_Label_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type        => Node_ID_Type,
        Element_Type    => Node_Label_Type);

    package Edge_Label_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type        => Edge_Type,
        Element_Type    => Edge_Label_Type);




    type Graph is new Ada.Finalization.Controlled with record
        Connections : Node_Maps.Map;
        Node_Labels : Node_Label_Maps.Map;
        Edge_Labels : Edge_Label_Maps.Map;
        Tamper_Info : aliased Help.Tamper_Counts;
    end record;

    overriding procedure Adjust
           (Container : in out Graph);

    overriding procedure Finalize
           (Container : in out Graph);

    procedure Write
           (Stream    : not null access Streams.Root_Stream_Type'Class;
            Container : in              Graph);
    for Graph'Write use Write;

    procedure Read
           (Stream    : not null access Streams.Root_Stream_Type'Class;
            Container :    out          Graph);
    for Graph'Read use Read;

    type Graph_Access is access all Graph;

    Empty_Graph : constant Graph := (Ada.Finalization.Controlled with others => <>);




    type Cursor is record
        Container : Graph_Access;
        Place     : Node_Maps.Cursor;
        Sub_Index : Node_Vectors.Extended_Index;
    end record;

    procedure Write
           (Stream   : not null access Streams.Root_Stream_Type'Class;
            Position : in              Cursor);
    for Cursor'Write use Write;

    procedure Read
           (Stream   : not null access Streams.Root_Stream_Type'Class;
            Position :    out          Cursor);
    for Cursor'Read use Read;

    No_Element : constant Cursor :=
           (Container => null,
            Place     => Node_Maps.No_Element,
            Sub_Index => Node_Vectors.Extended_Index'First);




    subtype Reference_Control_Type is Impl.Reference_Control_Type;

    type Node_Label_Constant_Reference
        (Element : not null access constant Node_Label_Type) is
    record
        Control : Reference_Control_Type :=
            raise Program_Error with "uninitialized reference";
    end record;

    procedure Write
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   : in              Node_Label_Constant_Reference);
    for Node_Label_Constant_Reference'Write use Write;

    procedure Read
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   :    out          Node_Label_Constant_Reference);
    for Node_Label_Constant_Reference'Read use Read;

    type Node_Label_Reference
        (Element : not null access Node_Label_Type) is
    record
        Control : Reference_Control_Type :=
            raise Program_Error with "uninitialized reference";
    end record;

    procedure Write
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   : in              Node_Label_Reference);
    for Node_Label_Reference'Write use Write;

    procedure Read
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   :    out          Node_Label_Reference);
    for Node_Label_Reference'Read use Read;

    type Edge_Label_Constant_Reference
        (Element : not null access constant Edge_Label_Type) is
    record
        Control : Reference_Control_Type :=
            raise Program_Error with "uninitialized reference";
    end record;

    procedure Write
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   : in              Edge_Label_Constant_Reference);
    for Edge_Label_Constant_Reference'Write use Write;

    procedure Read
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   :    out          Edge_Label_Constant_Reference);
    for Edge_Label_Constant_Reference'Read use Read;

    type Edge_Label_Reference
        (Element : not null access Edge_Label_Type) is
    record
        Control : Reference_Control_Type :=
            raise Program_Error with "uninitialized reference";
    end record;

    procedure Write
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   : in              Edge_Label_Reference);
    for Edge_Label_Reference'Write use Write;

    procedure Read
           (Stream : not null access Streams.Root_Stream_Type'Class;
            Item   :    out          Edge_Label_Reference);
    for Edge_Label_Reference'Read use Read;




    type Iterator is new Ada.Finalization.Limited_Controlled and
        Graph_Iterator_Interfaces.Reversible_Iterator with
    record
        Container : Graph_Access;
    end record
    with Disable_Controlled => not Impl.T_Check;

    overriding procedure Finalize
           (Object : in out Iterator);

    overriding function First
           (Object : in Iterator)
        return Cursor;

    overriding function Last
           (Object : in Iterator)
        return Cursor;

    overriding function Next
           (Object   : in Iterator;
            Position : in Cursor)
        return Cursor;

    overriding function Previous
           (Object   : in Iterator;
            Position : in Cursor)
        return Cursor;




    type Subgraph_Iterator is new Ada.Finalization.Limited_Controlled and
        Graph_Iterator_Interfaces.Reversible_Iterator with
    record
        Container : Graph_Access;
        Nodes     : Node_Vectors.Vector;
    end record
    with Disable_Controlled => not Impl.T_Check;

    overriding procedure Finalize
           (Object : in out Subgraph_Iterator);

    overriding function First
           (Object : in Subgraph_Iterator)
        return Cursor;

    overriding function Last
           (Object : in Subgraph_Iterator)
        return Cursor;

    overriding function Next
           (Object   : in Subgraph_Iterator;
            Position : in Cursor)
        return Cursor;

    overriding function Previous
           (Object   : in Subgraph_Iterator;
            Position : in Cursor)
        return Cursor;




    generic
        type Base_Type is private;
        type Array_Type is array (Positive range <>) of Base_Type;
        with package Type_Vectors is new Ada.Containers.Vectors
           (Index_Type   => Positive,
            Element_Type => Base_Type);
    function Vector_To_Array
           (Input : in Type_Vectors.Vector)
        return Array_Type;


end Directed_Graphs;