home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OOTP_4.ZIP / CHAP8.LST / TRIANGLE.PAS next >
Encoding:
Pascal/Delphi Source File  |  1990-02-11  |  3.2 KB  |  120 lines
  1. program TPuzzle;
  2.  
  3. uses Trigl,ListObj,Crt,Dos;
  4.  
  5. const
  6.  
  7. BasicSetups : array[1..4] of String15 = ( 'XXXXXXXXXXXXXXO',
  8.                                           'XXXXOXXXXXXXXXX',
  9.                                           'XXXXXXXXXOXXXXX',
  10.                                           'XXXOXXXXXXXXXXX' );
  11.  
  12. type
  13.  
  14. Pair = array[1..2] of word;
  15.  
  16. BetterTrigl = object(Triangle)
  17.               procedure GenChild( NewPosition : String15 ); virtual;
  18.               function Heuristic : boolean; virtual;
  19.               end;
  20.  
  21. function BetterTrigl.Heuristic : boolean;
  22. begin
  23.      if not ((Generation = 9) and (Position[5] = 'O') and
  24.                                   (Position[8] = 'O') and
  25.                                   (Position[9] = 'O')) then
  26.         Heuristic := true
  27.      else
  28.         Heuristic := false;
  29. end;
  30.  
  31. procedure BetterTrigl.GenChild( NewPosition : String15 );
  32. var
  33.    pNewTriangle : ^BetterTrigl;
  34. begin
  35.      New( pNewTriangle, Init( NewPosition, Succ(Generation) ) );
  36.      { comment out next line for speedup }
  37.      pNewTriangle^.ShowPosition;
  38.  
  39.      Offspring.Prepend( pNewTriangle );
  40.      Offspring.Cursor := OffSpring.Head;
  41. end;
  42.  
  43. procedure TimeDiff( H, M, S, HS : Pair);
  44. var
  45.    MS, SS : string[2];
  46. begin
  47.         if S[2] < S[1] then
  48.            begin
  49.            S[2] := S[2] + 60;
  50.            Dec(M[2]);
  51.            end;
  52.         if M[2] < M[1] then
  53.            begin
  54.            M[2] := M[2] + 60;
  55.            Dec(H[2]);
  56.            end;
  57.         if H[2] < H[1] then
  58.            H[2] := H[2] + 24;
  59.         gotoXY(1,1);
  60.         Str( M[2]-M[1], MS );
  61.         Str( S[2]-S[1], SS );
  62.         if Length(MS) = 1 then MS := Concat( '0', MS );
  63.         if Length(SS) = 1 then SS := Concat( '0', SS );
  64.         GoToXY( 1,3 );
  65.         writeln('Elapsed time = ', H[2]-H[1], ':', MS,
  66.                          ':', SS );
  67. end;
  68.  
  69. var
  70.    T : Triangle;
  71.    B : BetterTrigl;
  72.    H,M,S,HS : Pair;
  73.    Choice : integer;
  74. begin
  75.      ClrScr;
  76.      GoToXY(1,1);
  77.      write( '1:' );
  78.      DisplayPosition( BasicSetups[1], 3, 1 );
  79.      GoToXY(40,1);
  80.      write( '2:' );
  81.      DisplayPosition( BasicSetups[2], 42,1 );
  82.      GoToXY(1,12);
  83.      write( '3:' );
  84.      DisplayPosition( BasicSetups[3], 3, 12 );
  85.      GoToXY(40,12);
  86.      write( '4:' );
  87.      DisplayPosition( BasicSetups[4], 42, 12 );
  88.      repeat
  89.      GoToXY( 5, 23 );
  90.      write( 'Select a starting position (1-4):    ');
  91.      GoToXY( 39,23);
  92.      readln( Choice );
  93.      until (Choice >0) and (Choice<5);
  94.  
  95.      ClrScr;
  96.      writeln('STANDARD TRIANGLE:');
  97.      T.Init( BasicSetups[Choice],0);
  98.      GetTime( H[1], M[1], S[1], HS[1] );
  99.      if T.FindWin = true then
  100.         begin
  101.         GetTime( H[2], M[2], S[2], HS[2] );
  102.         TimeDiff( H,M,S,HS);
  103.         T.ShowWin;
  104.         T.ShowStats;
  105.         end;
  106.  
  107.      ClrScr;
  108.      writeln( 'BETTER TRIANGLE:' );
  109.      InitStats;  { must be done explicitly after the first time }
  110.      B.Init( BasicSetups[Choice],0 );    { Shortest solution time }
  111.      GetTime( H[1], M[1], S[1], HS[1] );
  112.      if B.FindWin = true then
  113.         begin
  114.         GetTime( H[2], M[2], S[2], HS[2] );
  115.         TimeDiff( H,M,S,HS);
  116.         B.ShowWin;
  117.         B.ShowStats;
  118.         end;
  119. end.
  120.