Skip to content

Commit

Permalink
D agpl-cr-assigner-hungry2.adb
Browse files Browse the repository at this point in the history
D    agpl-cr-assigner-hungry2.ads
M    agpl-generic_handle.adb
D    agpl-folders.adb
M    agpl-generic_handle.ads
D    agpl-folders.ads
M    agpl-cr-assigner-hungry3.ads
A    agpl-cr-assigner-greedy_minmax_exhaustive.adb
A    agpl-cr-assigner-greedy_minmax_exhaustive.ads
M    agpl-graphs-bellman_ford.adb
A    agpl-cr-assigner-greedy_totalsum.adb
M    agpl-graphs-bellman_ford.ads
A    agpl-cr-assigner-greedy_totalsum.ads
A    agpl-filesystem.adb
A    agpl-filesystem.ads
A    agpl-generic_file_store.adb
A    agpl-generic_file_store.ads
  • Loading branch information
mosteo committed Sep 1, 2006
1 parent 4de508a commit 48f65f3
Show file tree
Hide file tree
Showing 13 changed files with 455 additions and 25 deletions.
198 changes: 198 additions & 0 deletions agpl-cr-assigner-greedy_minmax_exhaustive.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,198 @@
------------------------------------------------------------------------------
-- AGPL --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (public@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This program is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
------------------------------------------------------------------------------

with Agpl.Cr.Agent.Handle;
with Agpl.Cr.Assignment;
with Agpl.Cr.Tasks.Insertions;
with Agpl.Htn.Tasks;
with Agpl.Htn.Tasks.Handle;
-- with Agpl.Trace; use Agpl.Trace;

with Ada.Containers.Indefinite_Ordered_Maps;

package body Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive is

package Task_Lists renames Agpl.Htn.Tasks.Lists;
use type Agent.Lists.Cursor;
use type Task_Lists.Cursor;
use type Htn.Tasks.Task_Id;
use type Cr.Agent.Handle.Object;
use type Htn.Tasks.Handle.Object;

package Int_Maps is new
Ada.Containers.Indefinite_Ordered_Maps (String, Natural);

------------
-- Assign --
------------

function Assign
(This : in Object;
Agents : in Agent.Lists.List;
Tasks : in Task_Lists.List;
Costs : in Cr.Cost_Matrix.Object)
return Assignment.Object
is
A : Assignment.Object;
-- The result we'll return.

Pending : Task_Lists.List := Tasks;
-- Tasks not yet assigned.

Not_Before : Int_Maps.Map;
-- To keep track of untouchable tasks if This.Keep_Order

-------------------------
-- Remove_From_Pending --
-------------------------

procedure Remove_From_Pending (T : in Htn.Tasks.Object'Class) is
use Task_Lists;
I : Cursor := Pending.First;
begin
while Has_Element (I) loop
if Element (I).Get_Id = T.Get_Id then
Pending.Delete (I);
return;
else
Next (I);
end if;
end loop;
raise Program_Error; -- Shouldn't be reached.
end Remove_From_Pending;

---------------
-- Try_Agent --
---------------
-- Try all pending tasks in the agent.
-- Returns a new agent with the task inserted at best place.
-- Ct holds the new total cost for the modified agent.
procedure Try_Agent (Ag : in Agent.Object'Class;
Nw : out Agent.Handle.Object;
Ct : out Cr.Costs;
Job : out Htn.Tasks.Handle.Object)
is
use Task_Lists;
T : Task_Lists.Cursor := Pending.First;
begin
Ct := Cr.Costs'Last;
while Has_Element (T) loop
declare
Try_Agent : Agent.Handle.Object;
Dummy : Cr.Costs;
Try_Total : Cr.Costs;
Ok : Boolean;
begin
Cr.Tasks.Insertions.Greedy
(Ag,
Element (T),
Costs,
Int_Maps.Element (Not_Before.Find (Ag.Get_Name)),
Try_Agent,
Cost_Delta => Dummy,
Cost_Total => Try_Total,
Success => Ok);

if Ok and then Try_Total < Ct then
Ct := Try_Total;
Nw := Try_Agent;
Job.Set (Element (T));
end if;
end;
Next (T);
end loop;
end Try_Agent;

begin
-- Initialize assignment:
declare
use Agent.Lists;
I : Cursor := Agents.First;
begin
while Has_Element (I) loop
if This.Keep_Order then
Not_Before.Include (Element (I).Get_Name,
Natural (Element (I).Get_Tasks.Length));
else
Not_Before.Include (Element (I).Get_Name,
0);
end if;

A.Set_Agent (Element (I));
Next (I);
end loop;
end;

-- Assign tasks:
while not Pending.Is_Empty loop
declare
Best_Cost : Cr.Costs := Cr.Costs'Last;
Best_Agent : Agent.Handle.Object;
Best_Task : Htn.Tasks.Handle.Object;
use Agent.Lists;
I : Cursor := Agents.First;
begin
while Has_Element (I) loop
declare
Mod_Agent : Agent.Handle.Object;
Mod_Cost : Cr.Costs;
Target : Htn.Tasks.Handle.Object;
begin
-- Select the best task for a given agent
declare
Name : constant String := Element (I).Get_Name;
begin
Try_Agent (A.Get_Agent (Name),
Mod_Agent, Mod_Cost, Target);
end;

if Target.Is_Valid then
if Mod_Cost < Best_Cost then
Best_Cost := Mod_Cost;
Best_Agent.Set (Mod_Agent.Get);
Best_Task.Set (Target.Get);
end if;
end if;
end;
Next (I);
end loop;

if Best_Agent.Is_Valid then
A.Set_Agent (Best_Agent.Get);
Remove_From_Pending (Best_Task.Get);
else
A.Set_Valid (False);
return A;
end if;
end;
end loop;

A.Set_Valid;

return A;
end Assign;

end Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive;
51 changes: 51 additions & 0 deletions agpl-cr-assigner-greedy_minmax_exhaustive.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
------------------------------------------------------------------------------
-- AGPL --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (public@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This program is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
------------------------------------------------------------------------------

with Agpl.Cr.Cost_Matrix;

package Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive is

-- 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;

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
-- that position (at plan start).
-- If Keep_Order is false, all tasks will be planned in equal conditions.

function Assign
(This : in Object;
Agents : in Agent.Lists.List;
Tasks : in Htn.Tasks.Lists.List;
Costs : in Cr.Cost_Matrix.Object)
return Assignment.Object;

end Agpl.Cr.Assigner.Greedy_Minmax_Exhaustive;
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ with Agpl.Htn.Tasks;
-- with Agpl.Strings;
-- with Agpl.Trace; use Agpl.Trace;

package body Agpl.Cr.Assigner.Hungry2 is
package body Agpl.Cr.Assigner.Greedy_Totalsum is

package Task_Lists renames Agpl.Htn.Tasks.Lists;
use type Agent.Lists.Cursor;
Expand Down Expand Up @@ -157,4 +157,4 @@ package body Agpl.Cr.Assigner.Hungry2 is
return A;
end Assign;

end Agpl.Cr.Assigner.Hungry2;
end Agpl.Cr.Assigner.Greedy_Totalsum;
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,13 @@

with Agpl.Cr.Cost_Matrix;

package Agpl.Cr.Assigner.Hungry2 is
-- Greedy heuristic that will at each step use the agent with the least cost
-- for its least costly task.
-- Not exhaustive: tasks are always added to the end of an agent tasks list

-- O (T * A * T) ~ O (n^3)

package Agpl.Cr.Assigner.Greedy_Totalsum is

pragma Preelaborate;

Expand All @@ -38,7 +44,5 @@ package Agpl.Cr.Assigner.Hungry2 is
Tasks : in Htn.Tasks.Lists.List;
Costs : in Cr.Cost_Matrix.Object)
return Assignment.Object;
-- Greedy heuristic that will get the agent with the minor cost for its
-- least costly task.

end Agpl.Cr.Assigner.Hungry2;
end Agpl.Cr.Assigner.Greedy_Totalsum;
9 changes: 6 additions & 3 deletions agpl-cr-assigner-hungry3.ads
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,12 @@ with Agpl.Cr.Cost_Matrix;

package Agpl.Cr.Assigner.Hungry3 is

-- 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;

type Object (Keep_Order : Boolean) is new Assigner.Object with null record;
Expand All @@ -42,7 +48,4 @@ package Agpl.Cr.Assigner.Hungry3 is
Costs : in Cr.Cost_Matrix.Object)
return Assignment.Object;

-- Greedy heuristic that at each step will select the pair agent-task which
-- adds less cost to the minimax cost.

end Agpl.Cr.Assigner.Hungry3;
25 changes: 19 additions & 6 deletions agpl-folders.adb → agpl-filesystem.adb
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,14 @@
------------------------------------------------------------------------------
-- $Id: agpl.ads,v 1.4 2004/01/21 21:05:25 Jano Exp $

package body Agpl.Folders is
with Agpl.Strings.Fields;

package body Agpl.Filesystem is

------------------
-- Ensure_Slash --
------------------

------------------------------------------------------------------------
-- Ensure_Slash --
------------------------------------------------------------------------
-- Returns the same string with a Folder_Separator added if it is missing.
function Ensure_Slash (This : in String; Separator : in Character := '/')
return String is
begin
Expand All @@ -48,4 +50,15 @@ package body Agpl.Folders is
end if;
end Ensure_Slash;

end Agpl.Folders;
-----------------------
-- Replace_Extension --
-----------------------

function Replace_Extension (This : in String; New_Ext : in String)
return String
is
begin
return Strings.Fields.String_Tail_Reverse (This, '.') & '.' & New_Ext;
end Replace_Extension;

end Agpl.Filesystem;
11 changes: 6 additions & 5 deletions agpl-folders.ads → agpl-filesystem.ads
Original file line number Diff line number Diff line change
Expand Up @@ -32,16 +32,17 @@
------------------------------------------------------------------------------
-- $Id: agpl.ads,v 1.4 2004/01/21 21:05:25 Jano Exp $

package Agpl.Folders is
package Agpl.Filesystem is

pragma Preelaborate;

------------------------------------------------------------------------
-- Ensure_Slash --
------------------------------------------------------------------------
-- Returns the same string with a Folder_Separator added if it is missing.
function Ensure_Slash (This : in String; Separator : in Character := '/')
return String;
pragma Inline (Ensure_Slash);

end Agpl.Folders;
function Replace_Extension (This : in String; New_Ext : in String)
return String;
-- Replace the extension by a new one

end Agpl.Filesystem;
Loading

0 comments on commit 48f65f3

Please sign in to comment.