Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Delphi Lösungsweg für Mischkarton´s gesucht ! (https://www.delphipraxis.net/183274-loesungsweg-fuer-mischkarton%B4s-gesucht.html)

Sir Rufo 27. Dez 2014 15:13

AW: Lösungsweg für Mischkarton´s gesucht !
 
Zitat:

Zitat von Bjoerk (Beitrag 1284784)
Oder die Liste vorher (nach Produkt) sortieren und alles ist gut.

Und das hilft wobei?

Ich gehe mal davon aus, dass die Informationen in der Art kommen, wie der TE das beschrieben hat:
10xA, 6xB, 2xC

Nach deiner Methode würden wir jetzt 3 Kartons erhalten mit
  • 6xA
  • 4xA,2xB
  • 4xB,2xC
Mit meiner Methode
  • 6xA
  • 6xB
  • 4xA,2xC
Allerdings kann auch mein Ansatz noch weiter verfeinert (verbessert) werden, damit gleiche Artikel möglichst auf nicht zuviele Kartons verteilt werden.

Bjoerk 27. Dez 2014 15:49

AW: Lösungsweg für Mischkarton´s gesucht !
 
[Saarlännich]Ei, ich hann gemennt, sordiere is immer gudd.[/Saarlännich]. Anyway. Aber hast Recht. Bringt hier nix wenn man zuerst die ganzen Kasten ausm Keller holen will.

Hotti 27. Dez 2014 16:24

AW: Lösungsweg für Mischkarton´s gesucht !
 
Hi Sir Rufo,

und hast das Prinzip der Sache Perfekt verstanden. Die 6*B aus deinem Beispiel sind ja schon ein komplett gefüllter Karton und sollen nicht auf andere Kartons verteilt werden.

Frage ! Wenn ihr von Listen schreibt, was wäre der beste Datentyp für die Daten Verschieberei !

Hotti

Bjoerk 27. Dez 2014 18:25

AW: Lösungsweg für Mischkarton´s gesucht !
 
Habs jetzt doch schnell mal gemacht. Ich hab zum Beispiel sowas verwendet. Das muß aber nicht so sein. Das kann man auch mit Arrays machen, falls du dich damit besser auskennst?
Delphi-Quellcode:
type
  TBottleStyle = (bs75, bs100);

const
  cBoxBottlesCount: array[TBottleStyle] of integer = (6, 6); // Wieviel Flaschen passen in den Kasten;

type
  TBottleProduct = (bpA, bpB, bpC, bpD, bpE, bpF, bpG, bpH, bpI, bpJ, bpK);

  TBottle = class // Eine Flasche;
  private
    FProduct: TBottleProduct;
    FStyle: TBottleStyle;
  public
    property Product: TBottleProduct read FProduct write FProduct;
    property Style: TBottleStyle read FStyle write FStyle;
  end;

  TBottles = class // Liste von Flaschen;
  private
    FItems: TObjectList;
    function GetBottle(Index: integer): TBottle;
    function GetCount: integer;
  public
    function Add(Product: TBottleProduct; Style: TBottleStyle): integer;
    procedure Delete(Index: integer);
    procedure Clear;
    procedure AddAsStringsTo(Dest: TStrings);
    function CountAsString: string;
    procedure Assign(Value: TBottles);
    procedure Sort;
    function CanExtractBox(var BottleProduct: TBottleProduct;
      var BottleStyle: TBottleStyle): boolean;
    property Bottle[Index: integer]: TBottle read GetBottle; default;
    property Count: integer read GetCount;
    constructor Create;
    destructor Destroy; override;
  end;

  TBottleBox = class // Ein Kasten bestimmter Flaschengröße;
  private
    FItems: TObjectList;
    FStyle: TBottleStyle;
    function GetBottle(Index: integer): TBottle;
    function GetCount: integer;
  public
    function Add(Product: TBottleProduct): integer;
    procedure Clear;
    function CountAsString: string;
    procedure AddAsStringsTo(Dest: TStrings);
    property Bottle[Index: integer]: TBottle read GetBottle;
    property Style: TBottleStyle read FStyle;
    property Count: integer read GetCount;
    constructor Create(Style: TBottleStyle);
    destructor Destroy; override;
  end;

  TBottleBoxes = class // Kästen;
  private
    FItems: TObjectList;
    function GetBox(Index: integer): TBottleBox;
    function GetCount: integer;
  public
    function Add(Style: TBottleStyle): integer;
    function IndexOfMinCount(Style: TBottleStyle): integer;
    procedure Clear;
    function CountAsString: string;
    procedure AddAsStringsTo(Dest: TStrings);
    procedure Fill(List: TBottles); // Flaschen in Kästen einsortieren;
    property Box[Index: integer]: TBottleBox read GetBox;
    property Count: integer read GetCount;
    constructor Create;
    destructor Destroy; override;
  end;

sx2008 27. Dez 2014 20:28

AW: Lösungsweg für Mischkarton´s gesucht !
 
mein Vorschlag:
a.) Bestellung nach Produkten sortieren
b.) Phase 1 - alle Produkte durchlaufen und so lange jeweils 6 Flaschen in einen sortenreinen Karton verpacken wie die Reststückzahl größergleich 6 ist.
c.) jetzt gibt es kein Produkt mehr mit einer Stückzahl >= 6; es folgt Phase 2
d.) Produkte sortieren nach absteigendem Volumen (1L zuerst)
e.) jeweils prüfen ob das zu verpackende Produkt (Stückzahl zwischen 1 und 5) einen großen 1L-Karton oder einen kleineren 0,75L-Karton benötigt und alle Flaschen des Produkts in den Karton packen.
f.) weiter mit nächstem Produkt und wie bei e.) verfahren nur dass dabei der letzte halbvolle Karton zuerst vollgemacht werden muss

Schritt e.) und f.) sind programmiertechnisch also das Gleiche. Dieser Schritt wird so lange ausgeführt bis alles verpackt wurde.
Es gibt zwei Phasen:
Phase 1: sortenreine Karton füllen
Phase 2: Mischkartons füllen
optional gibt es noch Phase 3:
prüfen ob 0,75L-Flaschen aus einem Karton für 6*1L in einen noch nicht vollen 6*0,75L-Karton umgepackt werden sollen.
Ggf. sollte man dies schon in Phase 2 berücksichtigen.

Hotti 29. Dez 2014 19:46

AW: Lösungsweg für Mischkarton´s gesucht !
 
Hi,

vielen Dank für die Antworten und Lösungsvorschläge.

Ich habe diese mal versucht in einem simplen Pascal Programm umzusetzen.
Wie könnte man die Packroutine noch optimieren um logischere Ergebnisse zu erreichen ?

Viele Grüße
Hotti


Code:
program KartonPacker;

uses SysUtils;

type Bestellung = Record
      Menge:Integer;
      Inhalt:Integer; // 0 für =0,75 und 1 für 1 LTR Flaschen
      Artikel:String;
     end;


TBestellung = Array [0..5] of Bestellung;
Var zahlen: TBestellung = ((Menge:9;Inhalt:1;Artikel:'A'),  //Beispieldaten
                            (Menge:2;Inhalt:1;Artikel:'B'),
                            (Menge:1;Inhalt:0;Artikel:'C'),
                            (Menge:7;Inhalt:0;Artikel:'D'),
                            (Menge:3;Inhalt:0;Artikel:'F'),
                            (Menge:2;Inhalt:0;Artikel:'G'));

procedure GanzerKarton;
var
  laenge,i,temp: Integer;
  KAnzahl: Integer;
begin
  laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
  for i:=0 to laenge-1 do
   begin
    KAnzahl:= zahlen[i].Menge div 6;
    if KAnzahl>0 then
      Writeln(KAnzahl,' voller Karton(s) von '+zahlen[i].Artikel);
    zahlen[i].Menge:=zahlen[i].Menge mod 6;
   end;
end;

procedure sortMenge;
var
  laenge,i,j:Integer;
  temp: Bestellung;
begin
  laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
  for i:=0 to laenge-1 do
    for j:=1 to laenge do
      if zahlen[j-1].Menge > zahlen[j].Menge then
      begin
        temp:=zahlen[j-1];
        zahlen[j-1]:=zahlen[j];
        zahlen[j]:=temp;
      end;
end;

procedure sortInhalt;
var
  laenge,i,j:Integer;
  temp: Bestellung;
begin
  laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
  for i:=0 to laenge-1 do
    for j:=1 to laenge do
      if zahlen[j-1].Inhalt > zahlen[j].Inhalt then
      begin
        temp:=zahlen[j-1];
        zahlen[j-1]:=zahlen[j];
        zahlen[j]:=temp;
      end;
end;

procedure Packen(z: TBestellung );
var laenge,i,p,k:Integer;
    maxKarton:Integer;
    KartonNr:Integer;
    FlaschenType:Integer;
    Kistevoll:boolean;
 begin
  laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;  // Anzahl der Array Felder
  maxKarton:=0;
  KartonNr:=0;
  Kistevoll:=False;
  for i:=0 to laenge do inc(maxKarton,z[i].Menge);
  maxKarton:=(maxKarton div 6) + 1;
  P:=0;                                            //Aktuelle Position in Array
  while KartonNr<Maxkarton do
   begin
    k:=0; //KartonInhalt
    Kistevoll:=False;
    Inc(KartonNr);
    Writeln('MischKarton ',KartonNr,' beinhaltet: ');
    if z[p].Inhalt=0 then
     begin
     while ((z[p].menge<6) and (p<=laenge)) and (KisteVoll=False) and (z[p].Inhalt=0) do
      begin
       if (K+z[p].Menge<=6) then
        begin
          writeln(z[p].Menge,' ',z[p].Inhalt,' ',z[p].Artikel);
          inc(k,z[p].Menge);
          inc(p);
          if k=6 then
           begin
            KisteVoll:=True;
            k:=0;
           end;
        end else
        begin
         dec(z[p].Menge,6-k);
         writeln(6-k,' ',z[p].Inhalt,' ',z[p].Artikel);
         Kistevoll:=True;
         k:=0;
        end;
      end;
    end;
     if z[p].Inhalt=1 then
     begin
      while ((z[p].menge<6) and (p<=laenge)) and (KisteVoll=False) and (z[p].Inhalt=1) do
      begin
       if K+z[p].Menge<=6 then
        begin
          writeln(z[p].Menge,' ',z[p].Inhalt,' ',z[p].Artikel);
          inc(k,z[p].Menge);
          inc(p);
          if k=6 then
           begin
            KisteVoll:=True;
            k:=0;
           end;
        end else
        begin
         dec(z[p].Menge,6-k);
         writeln(6-k,' ',z[p].Inhalt,' ',z[p].Artikel);
         Kistevoll:=True;
         k:=0;
        end;
      end;
    end;
   end;

end;

procedure ausgabe(z: TBestellung );
var
  i: Integer;
begin
  for i:=0 to (SizeOf(zahlen) div SizeOf(zahlen[0]))-1 do
  begin
    write(z[i].Menge,' ',z[i].Inhalt,' ',z[i].Artikel);
    writeln(',');
  end;
end;

begin
  GanzerKarton;
  sortMenge;
  sortInhalt;
  Writeln('Sortiert:');
  ausgabe(zahlen);
  Packen(zahlen);
  Writeln('Bitte Taste druecken...');Readln;
end.

Bjoerk 29. Dez 2014 20:47

AW: Lösungsweg für Mischkarton´s gesucht !
 
Habs mal durchlaufen lassen. Schalt mal die Bereichsprüfung an. In der Packen wird p zu groß? Und ist die Sort so richtig (Sollten nicht eher I und J verglichen werden ?

Edit:

Ich meinte eigentlich das:
Delphi-Quellcode:
procedure SortMenge;
var
  I, J: Integer;
  Temp: Bestellung;
begin
  for I := 0 to High(Zahlen) - 1 do
    for J := I + 1 to High(Zahlen) do
      if Zahlen[I].Menge > Zahlen[J].Menge then
      begin
        Temp := Zahlen[I];
        Zahlen[I] := Zahlen[J];
        Zahlen[J] := Temp;
      end;
end;

procedure SortInhalt;
var
  I, J: Integer;
  Temp: Bestellung;
begin
  for I := 0 to High(Zahlen) - 1 do
    for J := I + 1 to High(Zahlen) do
      if Zahlen[I].Inhalt > Zahlen[J].Inhalt then
      begin
        Temp := Zahlen[I];
        Zahlen[I] := Zahlen[J];
        Zahlen[J] := Temp;
      end;
end;

Hotti 29. Dez 2014 21:31

AW: Lösungsweg für Mischkarton´s gesucht !
 
Hi Bjoerk,

"Sollten nicht eher I und J verglichen werden ?"

Ja da hast du recht.

Danke für deine Optimierungen.

Hotti

Sir Rufo 30. Dez 2014 00:21

AW: Lösungsweg für Mischkarton´s gesucht !
 
Eigentlich handelt es sich doch um ein einziges Problem:

Flaschen möglichst ohne große Vermischung auf Kästen aufteilen. Dabei spielt die Flaschengröße eigentlich keine Rolle, wenn man den Algorithmus einmal für Flaschen in der Größe A und dann für Flaschen der Größe B durchläuft.
  • Zunächst also alle ganzen Kisten pro Artikel rausnehmen
  • Pro Flaschengröße eine Liste bilden
  • Diese Listen jeweils an den Algorithmus geben
  • Die aufgerundete Gesamtanzahl der Flaschen durch Kartonkapazität ergibt die Kartonanzahl
    Code:
    2x A, 4x B, 5x C => Ceil( 11 / 6 ) = 2
  • Eine Liste mit den Kartons anlegen und nach freier Anzahl absteigend sortieren
    Code:
    6x 1
    6x 2
  • Die Artikel nach Anzahl absteigend sortieren
    Code:
    5x C
    4x B
    2x A
  • Durch die Artikel-Liste gehen und immer in den ersten Karton der Karton-Liste füllen
    Code:
    5x C in Karton 1 => 6x 2, 1x 1
    4x B in Karton 2 => 2x 2, 1x 1
    2x A in Karton 2 => 1x 1, 0x 2
So müssten sich eigentlich alle Artikel passend einsortieren lassen


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:25 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz