Algotimizace prostrihu

[Ales Prochaska]

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.