summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-05-23 15:31:27 +1000
committerJed Barber <jjbarber@y7mail.com>2020-05-23 15:31:27 +1000
commit7f56d08907ffdd192f4b4898bfb22c1dce8f1cd0 (patch)
tree791bc8ca10d1f23226aafca9fd24c8c7612a1a02
parent5bb4bfd85fb558380a8b06ac77d0e5b27aee1feb (diff)
Added Iterate_By function for custom iteration
-rw-r--r--src/directed_graphs.adb66
-rw-r--r--src/directed_graphs.ads40
-rw-r--r--test/graph_tests-search.adb69
-rw-r--r--test/graph_tests-search.ads4
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;