home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPTC16.ZIP / PUZZLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  4.7 KB  |  206 lines
  1.  
  2. program Puzzle;
  3.  
  4. (*
  5.    Benchmark demo for Turbo Object Optimizer
  6. *)
  7.  
  8. const
  9.   XSize = 511;                { d*d*d-1}
  10.   ClassMax = 3;
  11.   TypeMax = 12;
  12.   D = 8;
  13.  
  14. type
  15.   PieceClass = 0..ClassMax;
  16.   PieceType = 0..TypeMax;
  17.   Position = 0..XSize;
  18.  
  19. var
  20.   PieceCount : array[PieceClass] of 0..13;
  21.   Class : array[PieceType] of PieceClass;
  22.   PieceMax : array[PieceType] of Position;
  23.   Puzzle : array[Position] of Boolean;
  24.   P : array[PieceType] of array[Position] of Boolean;
  25. (*  P : array[PieceType,Position] of Boolean;  *)
  26.   M, N : Position;
  27.   I, J, K : 0..13;
  28.   Kount : Integer;
  29.  
  30.   function Fit(I : PieceType; J : Position) : Boolean;
  31.   label
  32.     1;
  33.   var
  34.     K : Position;
  35.   begin
  36.     Fit := False;
  37.     for K := 0 to PieceMax[I] do
  38.       if P[I, K] then
  39.         if Puzzle[J+K] then
  40.           goto 1;
  41.     Fit := True;
  42. 1:
  43.   end;
  44.  
  45.   function Place(I : PieceType; J : Position) : Position;
  46.   label
  47.     1;
  48.   var
  49.     K : Position;
  50.   begin
  51.     for K := 0 to PieceMax[I] do
  52.       if P[I, K] then
  53.         Puzzle[J+K] := True;
  54.     PieceCount[Class[I]] := PieceCount[Class[I]]-1;
  55.     for K := J to XSize do
  56.       if not Puzzle[K] then
  57.         begin
  58.           Place := K;
  59.           goto 1;
  60.         end;
  61.     WriteLn('Puzzle filled');
  62.     Place := 0;
  63. 1:
  64.   end;
  65.  
  66.   procedure Remove(I : PieceType; J : Position);
  67.   var
  68.     K : Position;
  69.   begin
  70.     for K := 0 to PieceMax[I] do
  71.       if P[I, K] then
  72.         Puzzle[J+K] := False;
  73.     PieceCount[Class[I]] := PieceCount[Class[I]]+1;
  74.   end;
  75.  
  76.   function Trial(J : Position) : Boolean;
  77.   label
  78.     1;
  79.   var
  80.     I : PieceType;
  81.     K : Position;
  82.   begin
  83.     for I := 0 to TypeMax do
  84.       if PieceCount[Class[I]] <> 0 then
  85.         if Fit(I, J) then
  86.           begin
  87.             K := Place(I, J);
  88.             if Trial(K) or (K = 0) then
  89.               begin
  90.                 {writeln( 'Piece', i + 1, ' at', k + 1);}
  91.                 Trial := True;
  92.                 goto 1;
  93.               end
  94.             else
  95.               Remove(I, J);
  96.           end;
  97.     Trial := False;
  98.     Kount := Kount+1;
  99. 1:
  100.   end;
  101.  
  102. begin
  103.   WriteLn('Solving puzzle...');
  104.   for M := 0 to XSize do
  105.     Puzzle[M] := True;
  106.   for I := 1 to 5 do
  107.     for J := 1 to 5 do
  108.       for K := 1 to 5 do
  109.         Puzzle[I+D*(J+D*K)] := False;
  110.   for I := 0 to TypeMax do
  111.     for M := 0 to XSize do
  112.       P[I, M] := False;
  113.   for I := 0 to 3 do
  114.     for J := 0 to 1 do
  115.       for K := 0 to 0 do
  116.         P[0, I+D*(J+D*K)] := True;
  117.   Class[0] := 0;
  118.   PieceMax[0] := 3+D*1+D*D*0;
  119.   for I := 0 to 1 do
  120.     for J := 0 to 0 do
  121.       for K := 0 to 3 do
  122.         P[1, I+D*(J+D*K)] := True;
  123.   Class[1] := 0;
  124.   PieceMax[1] := 1+D*0+D*D*3;
  125.   for I := 0 to 0 do
  126.     for J := 0 to 3 do
  127.       for K := 0 to 1 do
  128.         P[2, I+D*(J+D*K)] := True;
  129.   Class[2] := 0;
  130.   PieceMax[2] := 0+D*3+D*D*1;
  131.   for I := 0 to 1 do
  132.     for J := 0 to 3 do
  133.       for K := 0 to 0 do
  134.         P[3, I+D*(J+D*K)] := True;
  135.   Class[3] := 0;
  136.   PieceMax[3] := 1+D*3+D*D*0;
  137.   for I := 0 to 3 do
  138.     for J := 0 to 0 do
  139.       for K := 0 to 1 do
  140.         P[4, I+D*(J+D*K)] := True;
  141.   Class[4] := 0;
  142.   PieceMax[4] := 3+D*0+D*D*1;
  143.   for I := 0 to 0 do
  144.     for J := 0 to 1 do
  145.       for K := 0 to 3 do
  146.         P[5, I+D*(J+D*K)] := True;
  147.   Class[5] := 0;
  148.   PieceMax[5] := 0+D*1+D*D*3;
  149.   for I := 0 to 2 do
  150.     for J := 0 to 0 do
  151.       for K := 0 to 0 do
  152.         P[6, I+D*(J+D*K)] := True;
  153.   Class[6] := 1;
  154.   PieceMax[6] := 2+D*0+D*D*0;
  155.   for I := 0 to 0 do
  156.     for J := 0 to 2 do
  157.       for K := 0 to 0 do
  158.         P[7, I+D*(J+D*K)] := True;
  159.   Class[7] := 1;
  160.   PieceMax[7] := 0+D*2+D*D*0;
  161.   for I := 0 to 0 do
  162.     for J := 0 to 0 do
  163.       for K := 0 to 2 do
  164.         P[8, I+D*(J+D*K)] := True;
  165.   Class[8] := 1;
  166.   PieceMax[8] := 0+D*0+D*D*2;
  167.   for I := 0 to 1 do
  168.     for J := 0 to 1 do
  169.       for K := 0 to 0 do
  170.         P[9, I+D*(J+D*K)] := True;
  171.   Class[9] := 2;
  172.   PieceMax[9] := 1+D*1+D*D*0;
  173.   for I := 0 to 1 do
  174.     for J := 0 to 0 do
  175.       for K := 0 to 1 do
  176.         P[10, I+D*(J+D*K)] := True;
  177.   Class[10] := 2;
  178.   PieceMax[10] := 1+D*0+D*D*1;
  179.   for I := 0 to 0 do
  180.     for J := 0 to 1 do
  181.       for K := 0 to 1 do
  182.         P[11, I+D*(J+D*K)] := True;
  183.   Class[11] := 2;
  184.   PieceMax[11] := 0+D*1+D*D*1;
  185.   for I := 0 to 1 do
  186.     for J := 0 to 1 do
  187.       for K := 0 to 1 do
  188.         P[12, I+D*(J+D*K)] := True;
  189.   Class[12] := 3;
  190.   PieceMax[12] := 1+D*1+D*D*1;
  191.   PieceCount[0] := 13;
  192.   PieceCount[1] := 3;
  193.   PieceCount[2] := 1;
  194.   PieceCount[3] := 1;
  195.   M := 1+D*(1+D*1);
  196.   Kount := 0;
  197.   if Fit(0, M) then
  198.     N := Place(0, M)
  199.   else
  200.     WriteLn(' error 1');
  201.   if Trial(N) then
  202.     WriteLn(' success in ', Kount, ' trials')
  203.   else
  204.     WriteLn(' failure');
  205. end.
  206.