Bin packing problem

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
Benutzeravatar
BoraBora
Beiträge: 42
Registriert: So 11. Apr 2021, 16:00
OS, Lazarus, FPC: FPC 3..2.2, L 2.2.0 , Linux Mint, WIN 10&11, Android,
CPU-Target: xxBit

Bin packing problem

Beitrag von BoraBora »

Hallo,

ich bin im Netz über das sogenannte "bin packing problem" (Behälterproblem: packe n unregelmässige Quader möglichst dicht in einen größeren Quader/Behälter/Karton) gestolpert.
Wie programmiert man so etwas (von der vielleicht grafischen Ausgabe mal ganz abgesehen)?
Ich programmiere eigentlich nur kaufmännische Anwendungen und finde mit meinem Wissen überhaupt keinen Ansatz...

Bin für jeden Denkanstoss dankbar.

Benutzeravatar
theo
Beiträge: 10497
Registriert: Mo 11. Sep 2006, 19:01

Re: Bin packing problem

Beitrag von theo »


Benutzeravatar
BoraBora
Beiträge: 42
Registriert: So 11. Apr 2021, 16:00
OS, Lazarus, FPC: FPC 3..2.2, L 2.2.0 , Linux Mint, WIN 10&11, Android,
CPU-Target: xxBit

Re: Bin packing problem

Beitrag von BoraBora »

Ja- hatte ich schon gefunden und unter meinem alten XE2 zum Laufen bekommen.
Nur- was macht diese Anwendung?

Benutzeravatar
theo
Beiträge: 10497
Registriert: Mo 11. Sep 2006, 19:01

Re: Bin packing problem

Beitrag von theo »

Na was soll sie schon machen? Ist das hier dein Problem oder meins? :wink:
Hab's mal kurz getestet., scheint soweit zu laufen. Bin aber nicht in die Details gegangen.

Code: Alles auswählen

unit Unit1;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  BinPacking.MaxRectsBinPack, fgl;

type

  { TForm1 }
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FMaxRectsBinPack: TMaxRectsBinPack;
    procedure TestInsert;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
 FMaxRectsBinPack := TMaxRectsBinPack.Create;
 TestInsert;
 for i:=0 to FMaxRectsBinPack.URectangles.Count-1 do
   Memo1.Lines.Add('L:'+Inttostr(FMaxRectsBinPack.URectangles[i].Left)+' T:'+Inttostr(FMaxRectsBinPack.URectangles[i].Top)+
   ' W:'+Inttostr(FMaxRectsBinPack.URectangles[i].Width)+' H:'+Inttostr(FMaxRectsBinPack.URectangles[i].Height));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FMaxRectsBinPack.Free;
 FMaxRectsBinPack := nil;
end;


procedure TForm1.TestInsert;
var
  method: TFreeRectChoiceHeuristic;
  dst: TFPGList<TRect>;
  rects: TFPGList<TRect>;
  expectedOccupancy : Single;
begin
  FMaxRectsBinPack.Init(500,500,False);

  method := frchRectBestAreaFit;
  dst := TFPGList<TRect>.create;
  rects := TFPGList<TRect>.create;
  rects.Add(Rect(0,0,100, 100));
  rects.Add(Rect(0,0,100, 100));
  rects.Add(Rect(0,0,100, 100));
  rects.Add(Rect(0,0,100, 100));
  rects.Add(Rect(0,0,100, 100));
  rects.Add(Rect(0,0,50, 100));
  rects.Add(Rect(0,0,100, 50));
  rects.Add(Rect(0,0,1000, 1000));

  FMaxRectsBinPack.Insert(rects, dst, method);
end;

end.
Dateianhänge
BinPacking.MaxRectsBinPack.pas
(23.6 KiB) 54-mal heruntergeladen

Antworten