Beste Kombination zur Auffüllung einer Liste

[Uwe Raabe]

Da hast du natürlich recht: es fehlen einige Kombinationen. Ich habe da wohl die Iterationen mit und ohne L3 (weil L3 ja eh nicht geht) vermischt. (L0+L3) wäre dann bei 14a und (L1+L3) bei 23a einzusortieren.

Für einen Algorithmus bietet sich ein rekursiver Ansatz an. Später kann man den ja immer noch serialisieren.

Als Datenstruktur für eine Lösung wäre ein array of Integer gut geeignet, in dem die Anzahl der einzelnen Listen vermerkt ist. Ich hab da mal quick and dirty was zusammengeschrieben, das du vielleicht als Basis nehmen kannst. Insbesondere die statischen Arrays wird man wohl durch dynamische ersetzen müssen.

Delphi-Quellcode:

program Project255;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Math;

type
  TSolution = array[0..3] of Integer;
  TListe = array[0..2] of Integer;

const
  Soll: TListe = (3,2,4);
  Listen: array[0..3] of TListe
       = ((3,2,0), (0,0,2), (0,0,1), (4,0,0));
  Kosten: array[0..3] of Integer = (10, 5, 4, 10);

function CalcKosten(const Solution: TSolution): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to 3 do
    Result := Result + Solution[I] * Kosten[I];
end;

procedure WriteIteration(const Solution: TSolution; const Liste: TListe; res: Integer);
var
  I: Integer;
  S: string;
begin
  S := '(';
  for I := 0 to 3 do
    S := S + IntToStr(Solution[I]) + ',';
  S[Length(S)] := ')';
  S := S + '[';
  for I := 0 to 2 do
    S := S + IntToStr(Liste[I]) + ',';
  S[Length(S)] := ']';
  if res = 0 then begin
    S := S + ' Lösung: ' + IntToStr(CalcKosten(Solution));
  end
  else if res > 0 then begin
    S := S + ' überfüllt';
  end;
  Writeln(S);
end;

procedure Iteration(var Solution: TSolution; const Liste: TListe; Index: Integer);
var
  newListe: TListe;
  I: Integer;
  newRes: Integer;
  res: Integer;
begin
  Inc(Solution[Index]);
  for I := 0 to 2 do
    newListe[I] := Liste[I] + Listen[Index, I];
  res := 0;
  for I := 0 to 2 do begin
    newRes := CompareValue(newListe[I], Soll[I]);
    if res <> newRes then begin
      if res = 0 then
        res := newRes
      else if newRes > 0 then
        res := newRes;
    end;
  end;
  WriteIteration(Solution, newListe, res);
  if res < 0 then begin
    Iteration(Solution, newListe, Index);
  end;
  Dec(Solution[Index]);
  if Index < 3 then begin
    Iteration(Solution, Liste, Index + 1);
  end;
end;

procedure Main;
var
  Solution: TSolution;
  Liste: TListe;
  I: Integer;
begin
  for I := 0 to 3 do
    Solution[I] := 0;
  for I := 0 to 2 do
    Liste[I] := 0;
  Iteration(Solution, Liste, 0);
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.