From 2551080276e30000767a318c1896db1eaa506fcc Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 28 Apr 2020 20:54:48 +1000 Subject: Switched over to Ordered_Maps --- src/directed_graphs.adb | 124 ++++++++++++++++++++---------------------------- src/directed_graphs.ads | 42 ++++++++-------- 2 files changed, 71 insertions(+), 95 deletions(-) diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index 3e32dff..a17f1d4 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -10,18 +10,19 @@ package body Directed_Graphs is - -- Make these Keys functions generic after switching to ordered maps - function Keys - (My_Map : in Node_Maps.Map) - return Node_Vectors.Vector; - - function Keys - (My_Map : in Node_Label_Maps.Map) - return Node_Vectors.Vector; - - function Keys - (My_Map : in Edge_Label_Maps.Map) - return Edge_Vectors.Vector; + generic + type Base_Type is private; + type Ignore_Element is private; + with package Key_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Base_Type, + Element_Type => Ignore_Element, + others => <>); + with package Type_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Base_Type); + function Key_Vector + (My_Map : in Key_Maps.Map) + return Type_Vectors.Vector; generic type Base_Type is private; @@ -36,6 +37,24 @@ package body Directed_Graphs is + --------- + -- "<" -- + --------- + + function "<" + (Left, Right : in Edge_Type) + return Boolean is + begin + if Left.From = Right.From then + return Left.To < Right.To; + else + return Left.From < Right.From; + end if; + end "<"; + + + + --------- -- "=" -- --------- @@ -884,6 +903,7 @@ package body Directed_Graphs is Nodes : Node_Vectors.Vector; Result : Edge_Vectors.Vector; function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); + function Keys is new Key_Vector (Edge_Type, Edge_Label_Type, Edge_Label_Maps, Edge_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -915,6 +935,7 @@ package body Directed_Graphs is is use type Ada.Containers.Count_Type; Node : Node_Type := Node_Type'Last; + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin if Impl.Checks and then Container.Node_Count = 0 then raise Constraint_Error with "Graph is empty"; @@ -1256,42 +1277,20 @@ package body Directed_Graphs is - ---------- - -- Keys -- - ---------- - - function Keys - (My_Map : in Node_Maps.Map) - return Node_Vectors.Vector is - begin - return My_Vector : Node_Vectors.Vector do - for C in My_Map.Iterate loop - My_Vector.Append (Node_Maps.Key (C)); - end loop; - end return; - end Keys; - - function Keys - (My_Map : in Node_Label_Maps.Map) - return Node_Vectors.Vector is - begin - return My_Vector : Node_Vectors.Vector do - for C in My_Map.Iterate loop - My_Vector.Append (Node_Label_Maps.Key (C)); - end loop; - end return; - end Keys; + ---------------- + -- Key_Vector -- + ---------------- - function Keys - (My_Map : in Edge_Label_Maps.Map) - return Edge_Vectors.Vector is + function Key_Vector + (My_Map : in Key_Maps.Map) + return Type_Vectors.Vector is begin - return My_Vector : Edge_Vectors.Vector do + return My_Vector : Type_Vectors.Vector do for C in My_Map.Iterate loop - My_Vector.Append (Edge_Label_Maps.Key (C)); + My_Vector.Append (Key_Maps.Key (C)); end loop; end return; - end Keys; + end Key_Vector; @@ -1442,6 +1441,7 @@ package body Directed_Graphs is is use type Ada.Containers.Count_Type; Node : Node_Type := Node_Type'First; + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin if Impl.Checks and then Container.Node_Count = 0 then raise Constraint_Error with "Graph is empty"; @@ -1538,13 +1538,14 @@ package body Directed_Graphs is is Select_From : Node_Vectors.Vector; Current_Index : Natural; + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin if Position.Container = null then Position := No_Element; return; end if; Select_From := Keys (Position.Container.Connections); - Vector_Sort.Sort (Select_From); + Node_Sort.Sort (Select_From); Current_Index := Select_From.Find_Index (Position.Node); if Current_Index = Node_Vectors.No_Index or Current_Index = Select_From.Last_Index @@ -1580,7 +1581,7 @@ package body Directed_Graphs is Next_Cursor.Visited.Append (Position.Node); loop Consider := Next_Cursor.Container.Connections.Constant_Reference (Next_Cursor.Node); - Vector_Sort.Sort (Consider); + Node_Sort.Sort (Consider); for N of Consider loop if not Next_Cursor.Visited.Contains (N) then Next_Cursor.Path_Up.Append (Next_Cursor.Node); @@ -1666,6 +1667,7 @@ package body Directed_Graphs is return Node_Array is function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin return V2A (Keys (Container.Connections)); end Nodes; @@ -1804,13 +1806,14 @@ package body Directed_Graphs is is Select_From : Node_Vectors.Vector; Current_Index : Natural; + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); begin if Position.Container = null then Position := No_Element; return; end if; Select_From := Keys (Position.Container.Connections); - Vector_Sort.Sort (Select_From); + Node_Sort.Sort (Select_From); Current_Index := Select_From.Find_Index (Position.Node); if Current_Index = Node_Vectors.No_Index or Current_Index = Select_From.First_Index @@ -2051,30 +2054,6 @@ package body Directed_Graphs is - ------------- - -- To_Hash -- - ------------- - - function To_Hash - (Node : in Node_Type) - return Ada.Containers.Hash_Type is - begin - return Ada.Containers.Hash_Type (Node_Type'Pos (Node)); - end To_Hash; - - function To_Hash - (Edge : in Edge_Type) - return Ada.Containers.Hash_Type - is - use type Ada.Containers.Hash_Type; - begin - return Ada.Containers.Hash_Type (Node_Type'Pos (Edge.From)) + - Ada.Containers.Hash_Type (Node_Type'Pos (Edge.To)); - end To_Hash; - - - - ------------------ -- Unused_Nodes -- ------------------ @@ -2084,13 +2063,14 @@ package body Directed_Graphs is Count : in Positive := 1) return Node_Array is + function Keys is new Key_Vector (Node_Type, Node_Vectors.Vector, Node_Maps, Node_Vectors); Nodes : Node_Array (1 .. Count); Used : Node_Vectors.Vector := Keys (Container.Connections); Next_Node : Node_Type := Node_Type'First; Vector_Index : Positive := 1; Result_Index : Positive := 1; begin - Vector_Sort.Sort (Used); + Node_Sort.Sort (Used); while Result_Index <= Nodes'Last loop if Vector_Index > Used.Last_Index or else Next_Node < Used (Vector_Index) @@ -2106,7 +2086,7 @@ package body Directed_Graphs is end if; elsif Next_Node > Used (Vector_Index) then Vector_Index := Vector_Index + 1; - else -- Next_Node = Used (Vector_Index + else -- Next_Node = Used (Vector_Index) if Impl.Checks and then Next_Node = Node_Type'Last then diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads index 854bf8e..77d9850 100644 --- a/src/directed_graphs.ads +++ b/src/directed_graphs.ads @@ -9,7 +9,7 @@ private with Ada.Containers.Helpers, Ada.Finalization, Ada.Streams, - Ada.Containers.Hashed_Maps, + Ada.Containers.Ordered_Maps, Ada.Containers.Vectors; @@ -21,6 +21,10 @@ generic type Node_Label_Type is private; type Edge_Label_Type is private; + with function "=" + (Left, Right : in Node_Type) + return Boolean is <>; + with function "=" (Left, Right : in Node_Label_Type) return Boolean is <>; @@ -50,6 +54,10 @@ package Directed_Graphs is type Edge_Array is array (Positive range <>) of Edge_Type; + function "<" + (Left, Right : in Edge_Type) + return Boolean; + @@ -619,40 +627,28 @@ private (Index_Type => Positive, Element_Type => Node_Type); - package Vector_Sort is new Node_Vectors.Generic_Sorting; + function "=" + (Left, Right : in Node_Vectors.Vector) + return Boolean renames Node_Vectors."="; + + package Node_Sort is new Node_Vectors.Generic_Sorting; package Edge_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Edge_Type); - function To_Hash - (Node : in Node_Type) - return Ada.Containers.Hash_Type; - - function To_Hash - (Edge : in Edge_Type) - return Ada.Containers.Hash_Type; - - package Node_Maps is new Ada.Containers.Hashed_Maps + package Node_Maps is new Ada.Containers.Ordered_Maps (Key_Type => Node_Type, Element_Type => Node_Vectors.Vector, - Hash => To_Hash, - Equivalent_Keys => "=", "=" => Node_Vectors."="); - package Node_Label_Maps is new Ada.Containers.Hashed_Maps + package Node_Label_Maps is new Ada.Containers.Ordered_Maps (Key_Type => Node_Type, - Element_Type => Node_Label_Type, - Hash => To_Hash, - Equivalent_Keys => "=", - "=" => "="); + Element_Type => Node_Label_Type); - package Edge_Label_Maps is new Ada.Containers.Hashed_Maps + package Edge_Label_Maps is new Ada.Containers.Ordered_Maps (Key_Type => Edge_Type, - Element_Type => Edge_Label_Type, - Hash => To_Hash, - Equivalent_Keys => "=", - "=" => "="); + Element_Type => Edge_Label_Type); -- cgit