M agpl-htn-tasks.adb

M    agpl-htn-tasks.ads
M    agpl-cr.adb
M    agpl-cr.ads
M    agpl-cr-tasks-insertions.adb
M    agpl-cr-map.ads
M    agpl-cr-assignment.adb
M    agpl-cr-cost_matrix.adb
M    agpl-cr-cost_matrix.ads
M    agpl-htn-plan_node.adb
M    agpl-htn-plan_node.ads
M    agpl-cr-tasks.ads
M    agpl-cr-mutable_assignment.adb
M    agpl-htn-plan.adb
M    agpl-htn-plan.ads

agpl-cr-assignment.adb

@@ -368,21 +368,19 @@ package body Agpl.Cr.Assignment is
                       Criterion : in Assignment_Criteria) return Costs
    is
    begin
-      case Criterion is
-         when Minimax  => return Get_Max_Min_Cost (This);
-         when Totalsum => return Get_Cummulative_Cost (This);
-      end case;
+      return Evaluate (Criterion,
+                       Minimax  => Get_Max_Min_Cost (This),
+                       Totalsum => Get_Cummulative_Cost (This));
    end Get_Cost;
 
    function Get_Cost (This      : in Object;
                       C         : in Cost_Matrix.Object;
                       Criterion : in Assignment_Criteria) return Costs
    is
    begin
-      case Criterion is
-         when Minimax  => return Get_Max_Min_Cost (This, C);
-         when Totalsum => return Get_Cummulative_Cost (This, C);
-      end case;
+      return Evaluate (Criterion,
+                       Minimax  => Get_Max_Min_Cost (This, C),
+                       Totalsum => Get_Cummulative_Cost (This, C));
    end Get_Cost;
 
    ------------------------

agpl-cr-cost_matrix.adb

@@ -97,6 +97,21 @@ package body Agpl.Cr.Cost_Matrix is
       end loop;
    end Create;
 
+   ------------
+   -- Create --
+   ------------
+
+   procedure Create
+     (This   : in out Object;
+      Agent  : in Cr.Agent.Object'Class;
+      Tasks  : in Htn.Tasks.Lists.List)
+   is
+      A : Cr.Agent.Lists.List;
+   begin
+      A.Append (Agent);
+      Create (This, A, Tasks);
+   end Create;
+
    -----------------------
    -- Create_With_Start --
    -----------------------
@@ -180,6 +195,19 @@ package body Agpl.Cr.Cost_Matrix is
       return Total;
    end Get_Plan_Cost;
 
+   -----------
+   -- Merge --
+   -----------
+
+   procedure Merge (Dst : in out Object; Src : in Object) is
+      procedure Do_It (I : in Cursor) is
+      begin
+         Dst.Matrix.Include (Key (I), Element (I));
+      end Do_It;
+   begin
+      Src.Matrix.Iterate (Do_It'Access);
+   end Merge;
+
    --------------
    -- Set_Cost --
    --------------

agpl-cr-cost_matrix.ads

@@ -53,8 +53,16 @@ package Agpl.Cr.Cost_Matrix is
       Agents : in Cr.Agent.Lists.List;
       Tasks  : in Htn.Tasks.Lists.List);
    --  Create a matrix given a list of agents and tasks to perform.
+   --  Note, any old costs not overwritten will remain...
    --  O (|A||T||T|)
 
+   procedure Create
+     (This   : in out Object;
+      Agent  : in Cr.Agent.Object'Class;
+      Tasks  : in Htn.Tasks.Lists.List);
+   --  Note, any old costs not overwritten will remain...
+   --  O (|T||T|)
+
    function Create_With_Start
      (Agents : in Cr.Agent.Lists.List;
       Tasks  : in Htn.Tasks.Lists.List) return Object;
@@ -68,6 +76,9 @@ package Agpl.Cr.Cost_Matrix is
    --  agent, which should be planned as the first task for each agent.
    --  These tasks are obtained via @Add_Starting_Tasks@
 
+   procedure Merge (Dst : in out Object; Src : in Object);
+   --  Overwrite Dst costs that are also present in Src, add new ones in Src.
+
    function Get_Cost
      (This  : in Object;
       Agent : in String;

agpl-cr-map.ads

@@ -29,7 +29,7 @@
 
 package Agpl.Cr.Map is
 
-   pragma Pure;
+   pragma Preelaborate;
 
    No_Data : exception;
 

agpl-cr-mutable_assignment.adb

@@ -387,14 +387,10 @@ package body Agpl.Cr.Mutable_Assignment is
    function Evaluate (This      : in Object;
                       Criterion : in Assignment_Criteria) return Costs
    is
-      Mm : constant Costs := This.Evaluate_Minimax;
-      Ts : constant Costs := This.Evaluate_Totalsum;
    begin
-      if Mm = Infinite or else Ts = Infinite then
-         return Infinite;
-      else
-         return Mm * Costs (Criterion.Weight_Minimax) +
-                Ts * Costs (Criterion.Weight_Totalsum);
+      return Evaluate (Criterion,
+                       Minimax  => This.Evaluate_Minimax,
+                       Totalsum => This.Evaluate_Totalsum);
    end Evaluate;
 
    ----------------------
@@ -1029,7 +1025,7 @@ package body Agpl.Cr.Mutable_Assignment is
    is
    begin
       Log ("Undoing from scratch", Debug, Section => Detail_Section);
-      Set_Assignment (This, Undo.Ass, Minimax);
+      Set_Assignment (This, Undo.Ass, This.Context.Ref.Criterion);
    end Undo_From_Scratch;
 
    ----------------------

agpl-cr-tasks-insertions.adb

@@ -321,10 +321,10 @@ package body Agpl.Cr.Tasks.Insertions is
                  Success    => Success);
 
          if Success then
-            case Criterion is
-               when Minimax => New_Cost := New_Total;
-               when Totalsum => New_Cost := New_Delta;
-            end case;
+            New_Cost := Evaluate (Criterion,
+                                  Minimax  => New_Total,
+                                  Totalsum => New_Delta);
+
             if New_Cost < Best_Cost then
                Best_Cost  := New_Cost;
                Best_Agent := New_Agent;

agpl-cr-tasks.ads

@@ -28,6 +28,6 @@
 
 package Agpl.Cr.Tasks is
 
-   pragma Pure;
+   pragma Preelaborate;
 
 end Agpl.Cr.Tasks;

agpl-cr.adb

@@ -2,6 +2,23 @@ with Agpl.Strings.Fields;
 
 package body Agpl.Cr is
 
+   --------------
+   -- Evaluate --
+   --------------
+
+   function Evaluate (Criterion : in Assignment_Criteria;
+                      Minimax   : in Costs;
+                      Totalsum  : in Costs) return Costs
+   is
+   begin
+      if Minimax = Infinite or else Totalsum = Infinite then
+         return Infinite;
+      else
+         return Costs (Criterion.Minimax_Weight)  * Minimax +
+                Costs (Criterion.Totalsum_Weight) * Totalsum;
+      end if;
+   end Evaluate;
+
    -----------
    -- Value --
    -----------

agpl-cr.ads

@@ -43,6 +43,11 @@ package Agpl.Cr is
    end record;
    --  Possibilities for assignments
 
+   function Evaluate (Criterion : in Assignment_Criteria;
+                      Minimax   : in Costs;
+                      Totalsum  : in Costs) return Costs;
+   pragma Inline (Evaluate);
+
    function Value (S : in String) return Assignment_Criteria;
 
    Criterion_Minimax       : constant Assignment_Criteria := (1.0, 0.0);

agpl-htn-plan.adb

@@ -38,6 +38,19 @@ package body Agpl.Htn.Plan is
    Boolean_To_Char : constant array (Boolean) of Character := (True  => 'T',
                                                                False => 'f');
 
+   ---------
+   -- "=" --
+   ---------
+
+   function "=" (L, R : in Object) return Boolean is
+      use type Subplan;
+      use type Htn.Method.Vectors.Vector;
+   begin
+      return L.Dirty = R.Dirty and then
+             L.Methods = R.Methods and then
+             Plan_Node.Equivalent (L.Tasks, R.Tasks);
+   end "=";
+
    -----------------
    -- Add_Subplan --
    -----------------
@@ -832,8 +845,11 @@ package body Agpl.Htn.Plan is
       This   :    out Object)
    is
    begin
-      raise Program_Error;
-      pragma Unimplemented;
+      This.Dirty   := Boolean'Input (Stream);
+      This.Methods := Method.Vectors.Vector'Input (Stream);
+      This.Tasks   := Subplan'Input (Stream);
+
+      This.Build_Index;
    end Read;
 
    -----------
@@ -845,8 +861,9 @@ package body Agpl.Htn.Plan is
       This   : in     Object)
    is
    begin
-      raise Program_Error;
-      pragma Unimplemented;
+      Boolean'Output (Stream, This.Dirty);
+      Method.Vectors.Vector'Output (Stream, This.Methods);
+      Subplan'Output (Stream, This.Tasks);
    end Write;
 
 end Agpl.Htn.Plan;

agpl-htn-plan.ads

@@ -51,6 +51,8 @@ package Agpl.Htn.Plan is
    subtype Subplan   is Plan_Node.Node_Access;
    --  Renamings used for simplicity.
 
+   function "=" (L, R : in Object) return Boolean;
+
    procedure Add_Subplan
      (This : in out Object;
       Comp : in     Subplan;