Added Iterate_By function for custom iteration

4 files changed, 178 insertions, 1 deletions

diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb
index 12916d1..bacb040 100644
--- a/src/directed_graphs.adb
+++ b/src/directed_graphs.adb
@@ -1019,6 +1019,12 @@ package body Directed_Graphs is
         Impl.Unbusy (Object.Container.Tamper_Info);
     end Finalize;
 
+    procedure Finalize
+           (Object : in out By_Iterator) is
+    begin
+        Impl.Unbusy (Object.Container.Tamper_Info);
+    end Finalize;
+
 
 
 
@@ -1163,6 +1169,17 @@ package body Directed_Graphs is
         end if;
     end First;
 
+    function First
+           (Object : in By_Iterator)
+        return Cursor is
+    begin
+        if Object.Filter = null or else Object.Filter (Object.Start) then
+            return Object.Start;
+        else
+            return Next (Object, Object.Start);
+        end if;
+    end First;
+
 
 
 
@@ -1628,6 +1645,40 @@ package body Directed_Graphs is
 
 
 
+    ----------------
+    -- Iterate_By --
+    ----------------
+
+    function Iterate_By
+           (Container : in Graph;
+            Start     : in Cursor;
+            Chooser   : in Choice_Function;
+            Filter    : in Filter_Function := null)
+        return Graph_Iterator_Interfaces.Forward_Iterator'Class is
+    begin
+        if Impl.Checks then
+            if Start.Container /= Container'Unrestricted_Access then
+                raise Constraint_Error with "Cursor points to different graph";
+            end if;
+            if not Has_Element (Start) then
+                raise Constraint_Error with "Start Cursor points to nothing";
+            end if;
+            if Chooser = null then
+                raise Constraint_Error with "No choice function supplied";
+            end if;
+        end if;
+        return It : By_Iterator do
+            It.Container := Container'Unrestricted_Access;
+            It.Start := Start;
+            It.Chooser := Chooser;
+            It.Filter := Filter;
+            Impl.Busy (Container.Tamper_Info'Unrestricted_Access.all);
+        end return;
+    end Iterate_By;
+
+
+
+
     ----------------------
     -- Iterate_Subgraph --
     ----------------------
@@ -2010,6 +2061,21 @@ package body Directed_Graphs is
         end if;
     end Next;
 
+    function Next
+           (Object   : in By_Iterator;
+            Position : in Cursor)
+        return Cursor
+    is
+        Result : Cursor := Position;
+    begin
+        loop
+            Result := Object.Chooser (Result);
+            if Object.Filter = null or else Object.Filter (Result) then
+                return Result;
+            end if;
+        end loop;
+    end Next;
+
 
 
 
diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads
index d31b7c7..3154f75 100644
--- a/src/directed_graphs.ads
+++ b/src/directed_graphs.ads
@@ -670,6 +670,21 @@ package Directed_Graphs is
             Position  : in Cursor)
         return Graph_Iterator_Interfaces.Reversible_Iterator'Class;
 
+    type Choice_Function is access function
+           (Position : in Cursor)
+        return Cursor;
+
+    type Filter_Function is access function
+           (Position : in Cursor)
+        return Boolean;
+
+    function Iterate_By
+           (Container : in Graph;
+            Start     : in Cursor;
+            Chooser   : in Choice_Function;
+            Filter    : in Filter_Function := null)
+        return Graph_Iterator_Interfaces.Forward_Iterator'Class;
+
     function First
            (Container : in Graph)
         return Cursor;
@@ -963,6 +978,31 @@ private
 
 
 
+    type By_Iterator is new Ada.Finalization.Controlled and
+        Graph_Iterator_Interfaces.Forward_Iterator with
+    record
+        Container : Graph_Access;
+        Start     : Cursor;
+        Chooser   : Choice_Function;
+        Filter    : Filter_Function;
+    end record
+    with Disable_Controlled => not Impl.T_Check;
+
+    overriding procedure Finalize
+           (Object : in out By_Iterator);
+
+    overriding function First
+           (Object : in By_Iterator)
+        return Cursor;
+
+    overriding function Next
+           (Object   : in By_Iterator;
+            Position : in Cursor)
+        return Cursor;
+
+
+
+
     generic
         type Base_Type is private;
         type Array_Type is array (Positive range <>) of Base_Type;
diff --git a/test/graph_tests-search.adb b/test/graph_tests-search.adb
index 17c2cbb..d72ce67 100644
--- a/test/graph_tests-search.adb
+++ b/test/graph_tests-search.adb
@@ -230,6 +230,75 @@ package body Graph_Tests.Search is
     end Iterate_Subgraph_Check;
 
 
+    function Iterate_By_Check
+        return Test_Result
+    is
+        function Max
+               (Nodes : in Graphs.Node_Array)
+            return Node_ID
+        is
+            Current : Node_ID := 1;
+        begin
+            for N of Nodes loop
+                if N > Current then
+                    Current := N;
+                end if;
+            end loop;
+            return Current;
+        end Max;
+
+        function My_Choices
+               (Position : in Graphs.Cursor)
+            return Graphs.Cursor
+        is
+            Pick_From : Graphs.Node_Array := Graphs.Children (Position);
+        begin
+            if Pick_From'Length = 0 then
+                return Graphs.No_Element;
+            end if;
+            return Graphs.Cursor_To (Position, Max (Pick_From));
+        end My_Choices;
+
+        function My_Filter
+               (Position : in Graphs.Cursor)
+            return Boolean is
+        begin
+            return not Graphs.Has_Element (Position) or else
+                Graphs.Element (Position) mod 2 = 0;
+        end My_Filter;
+
+        Index : Positive := 1;
+        Check_1 : Graphs.Node_Array := (1, 5, 7, 10);
+        Check_2 : Graphs.Node_Array := (1 => 10);
+
+        Start : Graphs.Cursor := My_Complex_Graph.To_Cursor (1);
+    begin
+        for C in My_Complex_Graph.Iterate_By (Start, My_Choices'Unrestricted_Access) loop
+            if Index not in Check_1'Range or else
+                Graphs.Element (C) /= Check_1 (Index)
+            then
+                return Fail;
+            else
+                Index := Index + 1;
+            end if;
+        end loop;
+
+        Index := 1;
+        for C in My_Complex_Graph.Iterate_By
+            (Start, My_Choices'Unrestricted_Access, My_Filter'Unrestricted_Access)
+        loop
+            if Index not in Check_2'Range or else
+                Graphs.Element (C) /= Check_2 (Index)
+            then
+                return Fail;
+            else
+                Index := Index + 1;
+            end if;
+        end loop;
+        return Pass;
+    end Iterate_By_Check;
+
+
 end Graph_Tests.Search;
 
 
diff --git a/test/graph_tests-search.ads b/test/graph_tests-search.ads
index d0ea2bb..63602e7 100644
--- a/test/graph_tests-search.ads
+++ b/test/graph_tests-search.ads
@@ -15,6 +15,7 @@ package Graph_Tests.Search is
     function Contains_Label_Subgraph_Check return Test_Result;
     function Iterate_Check return Test_Result;
     function Iterate_Subgraph_Check return Test_Result;
+    function Iterate_By_Check return Test_Result;
 
 
     Tests : Test_Array :=
@@ -25,7 +26,8 @@ package Graph_Tests.Search is
         (+"Contains_In_Subgraph", Contains_Subgraph_Check'Access),
         (+"Contains_Label_In_Subgraph", Contains_Label_Subgraph_Check'Access),
         (+"Iterate", Iterate_Check'Access),
-        (+"Iterate_Subgraph", Iterate_Subgraph_Check'Access));
+        (+"Iterate_Subgraph", Iterate_Subgraph_Check'Access),
+        (+"Iterate_By", Iterate_By_Check'Access));
 
 
 end Graph_Tests.Search;