home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / insidetp / 1990_04 / queen2.pas < prev    next >
Pascal/Delphi Source File  |  1990-03-19  |  2KB  |  104 lines
  1. {************************************************
  2. * QUEEN2 - the first attempt at solving the     *
  3. * queens problem.                               *
  4. *                                               *
  5. * INP:  c - the column # to place a queen in    *
  6. *       n - the maximum column (& row) number   *
  7. * USES: Soln - updates this solution counter    *
  8. *       whenever a queen is successfully placed *
  9. *       in the n'th column.                     *
  10. ************************************************}
  11.  
  12. UNIT Queen2;
  13.  
  14. INTERFACE
  15.  
  16. CONST
  17.   MaxBrd = 25;
  18.  
  19. VAR
  20.   {Chess brd}
  21.   Board : ARRAY[0..MaxBrd+1,0..MaxBrd+1] OF Byte;
  22.   Solns : Integer;
  23.  
  24. PROCEDURE InitBoard;
  25. PROCEDURE Queens(C,N: Integer);
  26.  
  27.  
  28. IMPLEMENTATION
  29.  
  30.  
  31. PROCEDURE InitBoard;
  32.   BEGIN
  33.     FillChar(Board,SizeOf(Board),#0);
  34.     Solns := 0
  35.   END;
  36.  
  37.  
  38. PROCEDURE Queens;
  39.  
  40. LABEL
  41.   Break;
  42.  
  43. VAR
  44.   I,J : Integer;
  45.   Legal : Boolean;
  46.  
  47. BEGIN
  48.   {Have we found a solution?}
  49.  
  50.   IF C=N THEN
  51.     Inc(Solns)
  52.   ELSE
  53.  
  54.    {Check each spot in the column}
  55.  
  56.     BEGIN
  57.       FOR I:= 0 TO N-1 DO
  58.         BEGIN
  59.  
  60.           Legal := TRUE;  {Legal until disproven}
  61.  
  62.           FOR J := 1 TO C DO
  63.  
  64.             BEGIN
  65.  
  66.               {-- Check row --}
  67.  
  68.               IF (Board[I,C-J] <> 0) THEN
  69.                 BEGIN
  70.                   Legal := FALSE;
  71.                   GOTO Break
  72.                 END;
  73.  
  74.               {-- Check diagonal 1 --}
  75.  
  76.               IF ((I+J) < N) THEN
  77.                 IF (Board[I+J,C-J] <> 0) THEN
  78.                   BEGIN
  79.                     Legal := FALSE;
  80.                     GOTO Break
  81.                   END;
  82.  
  83.               {-- Check diagonal 2 --}
  84.  
  85.               IF ((I-J) >= 0) THEN
  86.                 IF (Board[I-J,C-J] <> 0) THEN
  87.                   BEGIN
  88.                     Legal := FALSE;
  89.                     GOTO Break
  90.                   END
  91.             END;
  92. Break:
  93.           IF (Legal) THEN
  94.             BEGIN
  95.               Board[I,C] := 1; {Put queen here}
  96.               Queens(C+1,N);   {Process next col}
  97.               Board[I,C] := 0  {Remove & try next}
  98.             END;
  99.         END;
  100.     END;
  101. END;
  102.  
  103. END.
  104.