M agpl-gdk/agpl-gdk-managed.adb

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

agpl-cr-assignment.adb

@@ -27,6 +27,7 @@
 with Agpl.Trace; use Agpl.Trace;
 
 --  with Agpl.Cr.Agent.Handle;
+with Agpl.Htn.Plan.Utils;
 with Agpl.Htn.Tasks.Lists_Utils;
 
 package body Agpl.Cr.Assignment is
@@ -124,6 +125,36 @@ package body Agpl.Cr.Assignment is
       This.Agents.Include (Agent.Get_Name, Agent);
    end Set_Agent;
 
+   -----------------
+   -- Freeze_Plan --
+   -----------------
+
+   function Freeze_Plan (This : in Object;
+                         P    : in Htn.Plan.Object)
+                         return    Htn.Plan.Object
+   is
+      Result : Htn.Plan.Object := P;
+
+      procedure Check (I : in Agent.Maps.Cursor) is
+         TL : constant Htn.Tasks.Lists.List := Agent.Maps.Element (I).Get_Tasks;
+
+         procedure Check_Tasks (T : in Htn.Tasks.Lists.Cursor) is
+         begin
+            Htn.Plan.Utils.Trim_Or_Siblings
+              (Result, Htn.Tasks.Lists.Element (T).Get_Id);
+         end Check_Tasks;
+      begin
+         Tl.Iterate (Check_Tasks'Access);
+      end Check;
+   begin
+--        Log ("About to freeze plan: ", Always);
+--        Result.Print_Tree_Summary;
+--        Log ("With assignment: ", Always);
+--        This.Print_Assignment;
+      This.Agents.Iterate (Check'Access);
+      return Result;
+   end Freeze_Plan;
+
    ----------------
    -- Get_Agents --
    ----------------
@@ -255,6 +286,23 @@ package body Agpl.Cr.Assignment is
       return Worst;
    end Get_Max_Min_Cost;
 
+   function Get_Max_Min_Cost (This : in Object;
+                              C    : in Cost_Matrix.Object) return Costs
+   is
+      Worst : Costs := 0.0;
+      use Agent.Maps;
+      I : Cursor := First (This.Agents);
+   begin
+      while I /= No_Element loop
+         Worst := Costs'Max
+           (Worst,
+            Cost_Matrix.Get_Plan_Cost (C, Element (I)));
+         Next (I);
+      end loop;
+
+      return Worst;
+   end Get_Max_Min_Cost;
+
    --------------------------
    -- Get_Cummulative_Cost --
    --------------------------
@@ -272,6 +320,21 @@ package body Agpl.Cr.Assignment is
       return Cost;
    end Get_Cummulative_Cost;
 
+   function Get_Cummulative_Cost (This : in Object;
+                                  C    : in Cost_Matrix.Object) return Costs
+   is
+      Cost : Costs := 0.0;
+      use Agent.Maps;
+      I : Cursor := First (This.Agents);
+   begin
+      while I /= No_Element loop
+         Cost := Cost + Cost_Matrix.Get_Plan_Cost (C, Element (I));
+         Next (I);
+      end loop;
+
+      return Cost;
+   end Get_Cummulative_Cost;
+
    --------------
    -- Get_Cost --
    --------------
@@ -286,6 +349,17 @@ package body Agpl.Cr.Assignment is
       end case;
    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;
+   end Get_Cost;
+
    ------------------------
    -- Invalid_Assignment --
    ------------------------

agpl-cr-assignment.ads

@@ -28,6 +28,7 @@
 
 with Agpl.Cr.Agent.Lists;
 with Agpl.Cr.Agent.Maps;
+with Agpl.Cr.Cost_Matrix;
 with Agpl.Htn.Plan;
 with Agpl.Htn.Tasks;
 with Agpl.Htn.Tasks.Lists;
@@ -76,13 +77,20 @@ package Agpl.Cr.Assignment is
    --  Says the tasks assigned to a particular agent.
 
    function Get_Max_Min_Cost (This : in Object) return Costs;
+   function Get_Max_Min_Cost (This : in Object;
+                              C    : in Cost_Matrix.Object) return Costs;
    --  Says the worst of all the agent total costs.
 
    function Get_Cummulative_Cost (This : in Object) return Costs;
+   function Get_Cummulative_Cost (This : in Object;
+                                  C    : in Cost_Matrix.Object) return Costs;
    --  Says the sum of all agent costs.
 
    function Get_Cost (This      : in Object;
                       Criterion : in Assignment_Criteria) return Costs;
+   function Get_Cost (This      : in Object;
+                      C         : in Cost_Matrix.Object;
+                      Criterion : in Assignment_Criteria) return Costs;
    --  Uses one of the two previous according to the Criterion
 
    function Invalid_Assignment return Object;
@@ -92,6 +100,16 @@ package Agpl.Cr.Assignment is
 
    procedure Set_Valid (This : in out Object; Valid : in Boolean := True);
 
+   function Freeze_Plan (This : in Object;
+                         P    : in Htn.Plan.Object)
+                         return    Htn.Plan.Object;
+   --  This will take a plan that contains a superset of the tasks in the
+   --  assignment. If the plan contains OR nodes, these will be replaced with
+   --  the branches used by the assignment.
+   --  If some incompability is detected (tasks in This but not in P, or
+   --  sibling tasks used in This), an exception will be raised.
+   --  Note that if P > This, the plan can be just partially frozen.
+
    --  DEBUG
 
    procedure Print_Assignment (This : in Object);

agpl-cr-cost_matrix.ads

@@ -40,6 +40,8 @@ package Agpl.Cr.Cost_Matrix is
    --  Here we store a mapping of Agent x Start Task x End Task --> Costs
    --  This structure will be later used by assigners to compute an assignation.
 
+   Empty_Object : constant Object;
+
    function Add_Starting_Tasks
      (Agents : in Cr.Agent.Lists.List;
       Tasks  : in Htn.Tasks.Lists.List) return Htn.Tasks.Lists.List;
@@ -106,4 +108,6 @@ private
    pragma Inline (Key);
    --  Construct a suitable key for indexing.
 
+   Empty_Object : constant Object := (others => <>);
+
 end Agpl.Cr.Cost_Matrix;

agpl-cr-mutable_assignment.adb

@@ -36,6 +36,7 @@ with Agpl.Cr.Agent.Lists;
 with Agpl.Cr.Assigner.Hungry3;
 with Agpl.Cr.Tasks.Insertions;
 with Agpl.Htn.Plan_Node;
+with Agpl.Htn.Plan.Utils;
 with Agpl.Htn.Tasks.Lists;
 with Agpl.Htn.Tasks.Maps;
 with Agpl.Random;
@@ -434,15 +435,18 @@ package body Agpl.Cr.Mutable_Assignment is
          if Luck <= M.Vector (I).Prob then
             Log ("Performing mutation" & I'Img,
                  Debug, Section => Detail_Section);
-            This.Last_Mutation_Index := I;
+            Log ("Performing mutation" & I'Img,
+                 Always);
+            This.Last_Mutation_Index  := I;
+            This.Last_Mutation_Exists := True;
             M.Vector (I).Doer (This,
                                This.Last_Mutation_Description,
                                This.Last_Mutation_Undo);
             return;
          end if;
       end loop;
       Log ("Mutate: No mutation performed!", Error);
-      raise Program_Error;
+      raise Program_Error with "No mutation performed";
    end Mutate;
 
    ---------------
@@ -685,9 +689,11 @@ package body Agpl.Cr.Mutable_Assignment is
       New_Ass       : Cr.Assignment.Object := Ass;
       Pending_Tasks : Htn.Tasks.Maps.Map;
       L             : constant Htn.Tasks.Lists.List :=
-                        Htn.Plan.Enumerate_Tasks (This.Context.Ref.Plan,
-                                                  Primitive => True,
-                                                  Pending   => True);
+                        Htn.Plan.Enumerate_Tasks
+                          (Htn.Plan.Utils.Get_Any_Expansion
+                             (Ass.Freeze_Plan (This.Context.Ref.Plan)),
+                           Primitive => True,
+                           Pending   => True);
       procedure Ins (I : Htn.Tasks.Lists.Cursor) is
          use Htn.Tasks.Lists;
       begin
@@ -733,7 +739,11 @@ package body Agpl.Cr.Mutable_Assignment is
             Next (J);
          end loop;
       end Remove_Agent_Tasks;
+
+
    begin
+      Clear_Dynamic_Part (This);
+
       --  Keep mapped tasks
       Htn.Tasks.Lists.Iterate (L, Ins'Access);
 
@@ -775,10 +785,8 @@ package body Agpl.Cr.Mutable_Assignment is
 
       --  At this point, we have inserted the new ones
 
-      Log ("Create_Some_Assignment: Unassigned tasks inserted", Always);
-
-      Log ("The assignment is:", Always);
-      New_Ass.Print_Assignment;
+      Log ("Create_Some_Assignment: Unassigned tasks inserted",
+           Debug, Section => Detail_Section);
 
       --  Create all contexts and things.
       declare
@@ -787,11 +795,13 @@ package body Agpl.Cr.Mutable_Assignment is
          Cr.Agent.Lists.Iterate (Agents, Process_Agent'Access);
       end;
 
-      Log ("Create_Some_Assignment: Assigned tasks reinserted", Always);
+      Log ("Create_Some_Assignment: Assigned tasks reinserted",
+           Debug, Section => Detail_Section);
 
       Reevaluate_Costs (This);
 
-      Log ("Create_Some_Assignment: Costs reevaluated", Always);
+      Log ("Create_Some_Assignment: Costs reevaluated",
+           Debug, Section => Detail_Section);
    end Set_Assignment;
 
    ---------------
@@ -905,9 +915,13 @@ package body Agpl.Cr.Mutable_Assignment is
 
    procedure Undo (This : in out Object) is
    begin
-      This.Context.Ref.Mutations.Vector
-        (This.Last_Mutation_Index).Undoer (This, This.Last_Mutation_Undo);
-      Clear_Undo (This);
+      if This.Last_Mutation_Exists then
+         This.Context.Ref.Mutations.Vector
+           (This.Last_Mutation_Index).Undoer (This, This.Last_Mutation_Undo);
+         Clear_Undo (This);
+      else
+         raise Constraint_Error with "No mutation performed to be undone";
+      end if;
    end Undo;
 
    -----------------------

agpl-cr-mutable_assignment.ads

@@ -313,6 +313,7 @@ private
       Last_Mutation_Description : Ustring := +"None";
       Last_Mutation_Index       : Positive;
       Last_Mutation_Undo        : Undo_Info;
+      Last_Mutation_Exists      : Boolean := False;
    end record;
 
    --  Controlling...

agpl-cr-tasks-insertions.adb

@@ -1,7 +1,7 @@
 with Agpl.Cr.Agent.Lists;
-with Agpl.Htn.Tasks.Lists_Utils;
+--  with Agpl.Htn.Tasks.Lists_Utils;
 
-with Ada.Text_Io; use Ada.Text_Io;
+--  with Ada.Text_Io; use Ada.Text_Io;
 
 package body Agpl.Cr.Tasks.Insertions is
 
@@ -308,9 +308,9 @@ package body Agpl.Cr.Tasks.Insertions is
          New_Cost  : Cr.Costs;
          Success   : Boolean;
       begin
-         Put_Line ("Trying insertion of " & T.To_String & " at agent " &
-                   Agent.Lists.Element (I).Get_Name & " with tasks:");
-         Htn.Tasks.Lists_Utils.Print (Agent.Lists.Element (I).Get_Tasks);
+--           Put_Line ("Trying insertion of " & T.To_String & " at agent " &
+--                     Agent.Lists.Element (I).Get_Name & " with tasks:");
+--           Htn.Tasks.Lists_Utils.Print (Agent.Lists.Element (I).Get_Tasks);
 
          Greedy (Agent.Lists.Element (I),
                  T,
@@ -340,7 +340,7 @@ package body Agpl.Cr.Tasks.Insertions is
       if Best_Agent.Is_Valid then
          Success := True;
          New_Ass.Set_Agent (Best_Agent.Get);
-         Put_Line ("Assigned to " & Best_Agent.Get.Get_Name);
+--           Put_Line ("Assigned to " & Best_Agent.Get.Get_Name);
       else
          Success := False;
       end if;

agpl-gdk/agpl-gdk-managed.adb

@@ -1,6 +1,6 @@
 with Agpl.Trace; use Agpl.Trace;
 
-with Gtk.Main;
+with Gtk.Main; pragma Elaborate_All (Gtk.Main);
 
 --  with Ada.Tags; use Ada.Tags;
 --  with Ada.Text_Io; use Ada.Text_Io;