Algotimizace prostrihu

[nesvacil@posys.eu]

Nejste moc daleko od nejake prakticke realizace.

Obecne zde mate nekolik cyklu for, ktere daji casove zabrat. Evolucni 
algoritmy se zaobariaji jen tim, ze vam rychleji pomohou najit ty promenne 
orient_LH, ... . Je to pomerne jednoduche.

Jirka
----- Original Message ----- 
From: "Ales Prochaska" <prochaska@alsoft.cz>
To: <hw-list@list.hw.cz>
Sent: Saturday, March 24, 2007 7:36 PM
Subject: Re: Algotimizace prostrihu


Docela me zaujalo jak tu navrhujete geneticke algoritmy a podobne
teoreticky dobre zvladnute uvahy, ale nejak mi pripada, ze by bylo
tezke z toho neco vydolovat pro praxi. Takze jsem pustil delfi a na
treti preklad mi vypadlo tohle. Najde to nejlepsi pokryti zalozene na
sireni pokryti ze vsech rohu papiru soucasne. Urcite to pujde urychlit
doplnenim dynamickych mezi cyklu a nahradou tech poli [0..1]
promennymi a dosazovanim do nich a podobne.

Ales Prochaska


program rezani;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  papir_x     = 210;
  papir_y     = 297;
  papirek_x   = 50;
  papirek_y   = 100;

var
  orient_LH   : integer; // 0 = na sirku, 1 = na delku
  orient_PH   : integer;
  orient_LD   : integer;
  orient_PD   : integer;

  pocet_LH_x   : integer;
  pocet_LH_y   : integer;
  pocet_PH_x   : integer;
  pocet_PH_y   : integer;
  pocet_LD_x   : integer;
  pocet_LD_y   : integer;
  pocet_PD_x   : integer;
  pocet_PD_y   : integer;

  rozmer_x     : array [0..1] of integer; // transformace rozmeru (rotace 
papiru)
  rozmer_y     : array [0..1] of integer;


  plocha       : integer; // pokryta plocha v jedne iteraci
  max_plocha   : integer; // maximalni dosud nalezene pokryti plochy

begin
  rozmer_x[0]:=papirek_x;
  rozmer_x[1]:=papirek_y;
  rozmer_y[0]:=papirek_y;
  rozmer_y[1]:=papirek_x;

  max_plocha := 0;

  // vyzkouset vsechny orientace v rozich
  for orient_LH:=0 to 1 do begin
  for orient_PH:=0 to 1 do begin
  for orient_LD:=0 to 1 do begin
  for orient_PD:=0 to 1 do begin

    // plnit papir zkusmo ze vsech rohu
    for pocet_LH_x:=0 to papir_x div rozmer_x[orient_LH] do begin
    for pocet_LH_y:=0 to papir_y div rozmer_y[orient_LH] do begin
    for pocet_PH_x:=0 to papir_x div rozmer_x[orient_PH] do begin
    for pocet_PH_y:=0 to papir_y div rozmer_y[orient_PH] do begin
    for pocet_LD_x:=0 to papir_x div rozmer_x[orient_LD] do begin
    for pocet_LD_y:=0 to papir_y div rozmer_y[orient_LD] do begin
    for pocet_PD_x:=0 to papir_x div rozmer_x[orient_PD] do begin
    for pocet_PD_y:=0 to papir_y div rozmer_y[orient_PD] do begin

      // neprekryvaji se potvory?
      if  (pocet_LH_x * rozmer_x[orient_LH] + pocet_PH_x * 
rozmer_x[orient_PH] <= papir_x)
      and (pocet_LD_x * rozmer_x[orient_LD] + pocet_PD_x * 
rozmer_x[orient_PD] <= papir_x)
      and (pocet_LH_y * rozmer_y[orient_LH] + pocet_LD_y * 
rozmer_y[orient_LD] <= papir_y)
      and (pocet_PH_y * rozmer_y[orient_PH] + pocet_PD_y * 
rozmer_y[orient_PD] <= papir_y)
      and ((pocet_LH_x * rozmer_x[orient_LH] + pocet_PD_x * 
rozmer_x[orient_PD] <= papir_x)
           or (pocet_LH_y * rozmer_y[orient_LH] + pocet_PD_y * 
rozmer_y[orient_PD] <= papir_y))
      and ((pocet_LD_x * rozmer_x[orient_LD] + pocet_PH_x * 
rozmer_x[orient_PH] <= papir_x)
           or (pocet_LD_y * rozmer_y[orient_LD] + pocet_PH_y * 
rozmer_y[orient_PH] <= papir_y))
      then begin
        plocha := pocet_LH_x * rozmer_x[orient_LH] * pocet_LH_y * 
rozmer_y[orient_LH]
                + pocet_PH_x * rozmer_x[orient_PH] * pocet_PH_y * 
rozmer_y[orient_PH]
                + pocet_LD_x * rozmer_x[orient_LD] * pocet_LD_y * 
rozmer_y[orient_LD]
                + pocet_PD_x * rozmer_x[orient_PD] * pocet_PD_y * 
rozmer_y[orient_PD];

        if plocha > max_plocha then begin
          max_plocha:=plocha;
          // kontrolni vypis
          writeln('Pokryta plocha: ',plocha/(papir_x*papir_y)*100:3:2,' %');
          // zde doprogramovat ulozeni rozlozeni papirku
          end; //if

        end; //if

      end; //for
      end; //for
      end; //for
      end; //for
      end; //for
      end; //for
      end; //for
      end; //for

    end; //for
    end; //for
    end; //for
    end; //for

    readln;
end.




_______________________________________________
HW-list mailing list  -  sponsored by www.HW.cz
Hw-list@list.hw.cz
http://list.hw.cz/mailman/listinfo/hw-list