Das Rucksackproblem

[schöni]

Hallo!

Inspiriert durch das Thema "Rucksackproblem" eines DP Mitglieds vor einigen Tagen habe ich mich mal drangemacht, das Problem zu lösen. Hier ist das Ergebnis:

Delphi-Quellcode:

unit Rucksack;

interface

uses
  SysUtils,Classes;

type
  PObjStruct = ^TObjStruct;
  TObjStruct = record
    useability,mass,optimum: Extended;
  end;
  TObjects = class(TList)
    function Add(Item: Pointer): Integer;
  end;

procedure Optimize(var AObjects,AList: TObjects; AMaxMass: Extended);

inplementation

function TObjects.Add(Item: Pointer): Integer;
begin
   PObjStruct(Item).optimum := PObjStruct(Item)^.useability / PObjStruct(Item)^.mass;
   Result := inherited Add(PObjStruct(Item));
end;

function Compare(Item1,Item2: Pointer): Integer;
begin
 if PObjStruct(Item1)^.optimum < PObjStruct(Item2)^.optimum then Result := -1 else
 if PObjStruct(Item1)^.optimum > PObjStruct(Item2)^.optimum then Result := +1 else 
 Result := 0;
end;

procedure Optimize(var AObjects,AList: TObjects; AMaxMass: Extended);
var i,j: Integer; amass: Extended;
begin
  amass := 0.0;
  AList.Sort(Compare);
  i := AList.Count-1;
  while i > 0 do
  begin
    amass := amass + PObjStruct(AList.Items[i])^.mass; //EInvalidOp
    if amass<=AMaxMass then AObjects.Add(PObjStruct(AList.Items[i])) else
    begin
      j:=i;
      while (amass>AMaxMass) and (j>0) do
      begin
        amass := amass - PObjStruct(AList.Items[j])^.mass;
        amass := amass + PObjStruct(AList.Items[j-1])^.mass;
        if amass<=AMaxMass then AObjects.Add(PObjStruct(AList.Items[j-1]));
        Dec(j);
      end;
    end;
    Dec(i);
  end;
end;

end.

schöni