M agpl-conversions.adb

M agpl-conversions.ads M agpl.gpr M agpl-cr.adb M agpl-gdk/agpl-gdk-managed.adb M agpl-cr.ads M agpl-cr-assignment.adb M agpl-cr-assigner-greedy_minmax_exhaustive.adb M agpl-cr-assigner-greedy_minmax_exhaustive.ads M agpl-cr-cost_matrix.adb M agpl-optimization.ads M agpl-cr-cost_matrix.ads M agpl-cr-mutable_assignment.adb M agpl-cr-mutable_assignment.ads
mosteo · Sep 19, 2006 · b1a9542 · b1a9542
1 parent a353cee
commit b1a9542
Show file tree

Hide file tree

Showing 14 changed files with 147 additions and 18 deletions.
diff --git a/agpl-conversions.adb b/agpl-conversions.adb
@@ -33,9 +33,10 @@
 --  $Id: agpl.ads,v 1.4 2004/01/21 21:05:25 Jano Exp $
 
 with Agpl.Strings;        use Agpl.Strings;
+with Agpl.Strings.Fields;
 
 with Ada.Strings;
-with Ada.Strings.fixed;
+with Ada.Strings.Fixed;
 
 with Interfaces;
 
@@ -155,4 +156,32 @@ package body Agpl.Conversions is
       end if;
    end To_Str;
 
+   ------------------
+   -- Fixed_To_Str --
+   ------------------
+
+   function Fixed_To_Str (N        : Real;
+                          Decimals : Natural := 2)
+                          return     String
+   is
+      Result : constant String := N'Img;
+      use Strings.Fields;
+   begin
+      if Decimals > 0 then
+         declare
+            Pos : Natural := Result'First;
+            Cnt : Natural := 0;
+         begin
+            while Result (Pos) /= '.' loop Pos := Pos + 1; end loop;
+            while Pos < Result'Last loop
+               Cnt := Cnt + 1; Pos := Pos + 1;
+               exit when Cnt = Decimals;
+            end loop;
+            return Result (Result'First .. Pos);
+         end;
+      else
+         return Select_Field (Result, 1, '.');
+      end if;
+   end Fixed_To_Str;
+
 end Agpl.Conversions;
diff --git a/agpl-conversions.ads b/agpl-conversions.ads
@@ -65,6 +65,12 @@ package Agpl.Conversions is
                     Decimals : Natural := 2)
                     return     String;
 
+   generic
+      type Real is delta <> digits <>;
+   function Fixed_To_Str (N        : Real;
+                          Decimals : Natural := 2)
+                          return     String;
+
    function Trim (This : in String) return String;
 --   pragma Inline (Trim);
 

diff --git a/agpl-cr-assigner-greedy_minmax_exhaustive.adb b/agpl-cr-assigner-greedy_minmax_exhaustive.adb
@@ -142,15 +142,15 @@ package body Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive is
                                    0);
             end if;
 
-            Log ("Adding agent " & Element (I).Get_Name, Always);
+            Log ("Adding agent " & Element (I).Get_Name, Debug, Log_Section);
             A.Set_Agent (Element (I));
             Next (I);
          end loop;
       end;
 
       --  Assign tasks:
       while not Pending.Is_Empty loop
-         Log ("Pending:" & Pending.Length'Img, Always);
+         Log ("Pending:" & Pending.Length'Img, Debug, Log_Section);
          declare
             Best_Cost        : Cr.Costs := Cr.Costs'Last;
             Best_Agent       : Agent.Handle.Object;

diff --git a/agpl-cr-assigner-greedy_minmax_exhaustive.ads b/agpl-cr-assigner-greedy_minmax_exhaustive.ads
@@ -28,13 +28,15 @@ with Agpl.Cr.Cost_Matrix;
 
 package Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive is
 
+   Log_Section : constant String := "agpl.cr.assigner.greedy_minmax_exhaustive";
+
    --  Greedy heuristic that at each step will select the pair agent-task which
    --  adds less cost to the minimax cost.
    --  The new task for an agent will be tried at any point of its plan.
 
    --  O (T * A * T * T) ~ O (n^4)
 
-   -- pragma Preelaborate;
+   --  pragma Preelaborate;
 
    type Object (Keep_Order : Boolean) is new Assigner.Object with null record;
    --  If Keep_Order, any tasks in an Agent passed to Agents will be kept in

diff --git a/agpl-cr-assignment.adb b/agpl-cr-assignment.adb
@@ -35,7 +35,7 @@ package body Agpl.Cr.Assignment is
 
    package Agent_Lists renames Cr.Agent.Containers.Lists;
    package Task_Lists renames Htn.Tasks.Containers.Lists;
-   function To_String is new Conversions.To_Str (Costs);
+   function To_String is new Conversions.Fixed_To_Str (Costs);
 
    ---------
    -- Add --

diff --git a/agpl-cr-cost_matrix.adb b/agpl-cr-cost_matrix.adb
@@ -269,6 +269,14 @@ package body Agpl.Cr.Cost_Matrix is
       Fin   : in     Htn.Tasks.Task_Id;
       Cost  : in     Costs)
    is
+      function Rounded (C : in Costs) return Costs is
+      begin
+         if C /= Infinite then
+            return Costs (Float'Floor (Float (C * 100.0)) / 100.0);
+         else
+            return C;
+         end if;
+      end Rounded;
    begin
       Include (This.Matrix, Key (Agent, Ini, Fin), Cost);
    end Set_Cost;

diff --git a/agpl-cr-cost_matrix.ads b/agpl-cr-cost_matrix.ads
@@ -120,7 +120,7 @@ package Agpl.Cr.Cost_Matrix is
 private
 
    package ATT_Maps is new Ada.Containers.Indefinite_Hashed_Maps
-     (String, Costs, Ada.Strings.Hash, "=", Optimization."=");
+     (String, Costs, Ada.Strings.Hash, "=", Cr."=");
 
    use Att_Maps;
 

diff --git a/agpl-cr-mutable_assignment.adb b/agpl-cr-mutable_assignment.adb
@@ -61,7 +61,7 @@ package body Agpl.Cr.Mutable_Assignment is
    No_Task : Htn.Tasks.Task_Id renames Htn.Tasks.No_Task;
 
    function S is new Conversions.To_Str (Optimization.Annealing.Probability);
-   function To_String is new Conversions.To_Str (Cr.Costs);
+   function To_String is new Conversions.Fixed_To_Str (Cr.Costs);
 
    function "<" (L, R : Minimax_Key) return Boolean is
       use Asu;
@@ -2160,9 +2160,13 @@ package body Agpl.Cr.Mutable_Assignment is
                New_Owner   => Agent_Id (+Move.Owner_Was));
 
             if Move.Minsum_Was /= This.Minsum then
-               Log ("Cost was " & To_String (Move.Minsum_Was) &
-                    " but is " & To_String (This.Minsum), Error, Log_Section);
-               raise Program_Error with "Undo breached cost integrity!";
+               Log ("Cost was " & To_String (Move.Minsum_Was, 10) &
+                    " but is " & To_String (This.Minsum, 10) &
+                    " (" & To_String (This.Minsum - Move.Minsum_Was, 10) & ")",
+                    Error, Log_Section);
+               --  Cr.Cost_Matrix.Print (This.Context.Ref.Costs);
+               This.Reevaluate_Costs;
+               --  raise Program_Error with "Undo breached cost integrity!";
             end if;
          end;
          U.Move_Stack.Delete (U.Move_Stack.Last);
@@ -2231,6 +2235,11 @@ package body Agpl.Cr.Mutable_Assignment is
                                           Ne);
       end if;
 
+      Log ("Inserting: [Plus1/Plus2/Minus] = " &
+           To_String (Plus_1, 10) & " " &
+           To_String (Plus_2, 10) & " " &
+           To_String (Minus, 10), Debug, Detail_Section);
+
       return Cr.Evaluate (This.Context.Ref.Criterion,
                           Minmax => Cost + Plus_1 + Plus_2 - Minus,
                           Minsum =>        Plus_1 + Plus_2 - Minus);
@@ -2300,6 +2309,14 @@ package body Agpl.Cr.Mutable_Assignment is
          This.Valid := False;
       end if;
 
+      Log ("Inserting: [Plus1/Plus2/Minus] = " &
+           To_String (Plus_1, 16) & " " &
+           To_String (Plus_2, 16) & " " &
+           To_String (Minus, 16), Debug, Detail_Section);
+
+      Log ("Inserting [Prev/After] " & To_String (Cost, 16) & " " &
+           To_String (Cost + Plus_1 + Plus_2 - Minus, 16),
+           Debug, Detail_Section);
       Cost := Cost + Plus_1 + Plus_2 - Minus;
 
       This.Agent_Costs.Insert (Agent_Id (New_Owner), Cost);
@@ -2370,6 +2387,15 @@ package body Agpl.Cr.Mutable_Assignment is
          This.Valid := False;
       end if;
 
+      Log ("Removing: [Minus1/Minus2/Plus] = " &
+           To_String (Minus_1, 16) & " " &
+           To_String (Minus_2, 16) & " " &
+           To_String (Plus, 16), Debug, Detail_Section);
+
+      Log ("Removing [Prev/After] " & To_String (Cost, 16) & " " &
+           To_String (Cost - Minus_1 - Minus_2 + Plus, 16),
+           Debug, Detail_Section);
+
       Log ("Removing costs: Prev:" & Pr'Img & "; Next:" & Ne'Img &
            "; Curr:" & Curr.Job'Img,
            Debug, Detail_Section);

diff --git a/agpl-cr-mutable_assignment.ads b/agpl-cr-mutable_assignment.ads
@@ -363,14 +363,19 @@ private
    function Key (This : in Agent_Context) return Solution_Context_Key;
    procedure Debug_Dump (This : in Agent_Context);
 
+   ----------------
+   -- OR_Context --
+   ----------------
+   Continue here
+
    type Minimax_Key is record
       Cost  : Costs;
       Agent : Ustring;
    end record;
    function "<" (L, R : Minimax_Key) return Boolean;
 
    package Agent_Cost_Maps is new Ada.Containers.Indefinite_Ordered_Maps
-     (Agent_Id, Costs, "<", Optimization."=");
+     (Agent_Id, Costs, "<", Cr."=");
    package Cost_Agent_Sets is new
      Ada.Containers.Ordered_Sets (Minimax_Key);
 

diff --git a/agpl-cr.adb b/agpl-cr.adb
@@ -1,7 +1,10 @@
+with Agpl.Conversions;
 with Agpl.Strings.Fields;
 
 package body Agpl.Cr is
 
+   function Img is new Conversions.Fixed_To_Str (Costs);
+
    --------------
    -- Evaluate --
    --------------
@@ -19,6 +22,24 @@ package body Agpl.Cr is
       end if;
    end Evaluate;
 
+   -----------
+   -- Image --
+   -----------
+
+   function Image (C : in Costs) return String is
+   begin
+      return Costs'Image (C);
+   end Image;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (C : in Costs; Decimals : in Natural) return String is
+   begin
+      return Img (C, Decimals);
+   end Image;
+
    -----------
    -- Value --
    -----------

diff --git a/agpl-cr.ads b/agpl-cr.ads
@@ -26,16 +26,19 @@
 
 --  Root package for Cooperative Robotics
 
-with Agpl.Optimization;
+--  with Agpl.Optimization;
 
 package Agpl.Cr is
 
    pragma Preelaborate;
 
-   subtype Costs is Optimization.Cost; --  Abstract "Cost" to perform some job.
+   type Costs is delta 0.01 digits 18;
+   --  This *must* be a fixed point type, otherwise incremental cost computation
+   --  in annealing will fail.
+
    use type Costs;
 
-   Infinite : constant Costs := Optimization.Infinite;
+   Infinite : constant Costs := Costs'Last;
 
    type Assignment_Criteria is record
       Minmax_Weight : Float := 0.0;
@@ -49,11 +52,23 @@ package Agpl.Cr is
                       Minsum    : in Costs) return Costs;
    pragma Inline (Evaluate);
 
+   function Image (C : in Costs) return String;
+   pragma Inline (Image);
+
+   function Image (C : in Costs; Decimals : in Natural) return String;
+   pragma Inline (Image);
+
    function Value (S : in String) return Assignment_Criteria;
 
    Criterion_Invalid       : constant Assignment_Criteria := (0.0, 0.0);
-   Criterion_Minimax       : constant Assignment_Criteria := (1.0, 0.0);
-   Criterion_Totalsum      : constant Assignment_Criteria := (0.0, 1.0);
-   Criterion_Time_Critical : constant Assignment_Criteria := (1.0, 0.00001);
+   Criterion_Minmax        : constant Assignment_Criteria := (1.0, 0.0);
+   Criterion_Minsum        : constant Assignment_Criteria := (0.0, 1.0);
+   Criterion_Minmix        : constant Assignment_Criteria := (1.0, 1.0);
+   Criterion_Mintim        : constant Assignment_Criteria := (1.0, 0.00001);
+
+   Criterion_Minimax       : Assignment_Criteria renames Criterion_Minmax;
+   Criterion_Totalsum      : Assignment_Criteria renames Criterion_Minsum;
+   Criterion_Time_Critical : Assignment_Criteria renames Criterion_Minmix;
+   Criterion_Best          : Assignment_Criteria renames Criterion_Minmix;
 
 end Agpl.Cr;
diff --git a/agpl-gdk/agpl-gdk-managed.adb b/agpl-gdk/agpl-gdk-managed.adb
@@ -13,6 +13,8 @@ package body Agpl.Gdk.Managed is
 
    task Gtk_Task is
 
+      entry Start;
+
       entry Execute (This : in out Gtk_Code'Class);
       --  Dispatch on This.Execute inside the Gtk thread.
 
@@ -24,6 +26,11 @@ package body Agpl.Gdk.Managed is
 
    procedure Execute_In_Gtk (This : in out Gtk_Code'Class) is
    begin
+      select
+         Gtk_Task.Start;
+      else
+         null;
+      end select;
       Gtk_Task.Execute (This);
    end Execute_In_Gtk;
 
@@ -57,7 +64,15 @@ package body Agpl.Gdk.Managed is
       end Num_Windows;
 
    begin
+
+      select
+         accept Start;
+      or
+         terminate;
+      end select;
+
       Gtk.Main.Init;
+      Log ("Gtk_Task [managed]: Running...", Informative);
 
       loop
          begin

diff --git a/agpl-optimization.ads b/agpl-optimization.ads
@@ -28,6 +28,8 @@ package Agpl.Optimization is
 
    pragma Pure;
 
+   --  type Cost is delta 0.00001 digits 18;
+   --  type Cost is new Long_Float;
    type Cost is new Float;
    --  We are *minimizing* the solution cost.
    --  If you want ot maximize an utility function, simply negate your function.

diff --git a/agpl.gpr b/agpl.gpr
@@ -71,7 +71,7 @@ project Agpl is
    end Compiler;
 
    package Builder is
-      for Default_Switches ("ada") use ("-a", "-g");
+      for Default_Switches ("ada") use ("-a", "-g", "-j2");
    end Builder;
 
    package Binder is