DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »mpasc4«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »mpasc4« 

TextFile

(*  18.12.81  (. CHANGED TO Æ
              .) CHANGED TO Å
              () CHANGED TO blanks
              1..MAXSIZE CHANGED TO INTEGER 
              the hco pascal-compiler detects index-errors which
              are not detected by the motorola pascal-compiler.
*)
PROGRAM QUEENS(INPUT,OUTPUT);
CONST MAXSIZE = 15;
VAR
 N,      (*BOARD SIZE*)
 CURCOLNBR,   (*CURRENT COLUMN INDEX*)
 I, J,        (*LOOP VARIABLES      *)
 DIAGNBR      (*DIAGONAL NUMBER     *)  : INTEGER;
 PLACEDAQUEEN                           : BOOLEAN;
 COL          (*COLS. OF BOARD      *)  : ARRAY Æ1 .. MAXSIZEÅ OF INTEGER;

 BEGIN
  WRITELN('This program will determine all the ways to arrange');
  WRITELN('N queens on a N by N chessboard so that no queen');
  WRITELN('can be taken by any other queen.');
  WRITELN('  ');
  WRITELN('PLEASE ENTER THE VALUE OF N.  (8 GIVES THE SOLUTION FOR CHESS)');
   READLN(N);
   IF (N <= 0) OR (N > MAXSIZE)
      THEN WRITELN('INVALID BOARD SIZE')
      ELSE
        BEGIN
          (*GENERATE AND PRINT SOLUTIONS*)
          FOR CURCOLNBR := 1 TO N DO
          COLÆCURCOLNBRÅ := 0;
          CURCOLNBR := 1;
          WHILE CURCOLNBR > 0  DO
           BEGIN (*PLACE A QUEEN OR BACKTRACK*)
              PLACEDAQUEEN := FALSE;
              I := COLÆCURCOLNBRÅ + 1;
              WHILE (I <= N) AND (NOT PLACEDAQUEEN) DO
               BEGIN
                (*COMPUTE PLACEDAQUEEN-TRUE IF PIECE AT (CURCOLNBR, I)
                 IS ALL RIGHT                                        *)
                 PLACEDAQUEEN := TRUE;
                 J := 1;
                 WHILE PLACEDAQUEEN AND (J < CURCOLNBR) DO
                   BEGIN
                     PLACEDAQUEEN := COLÆJÅ<>I;
                     J := J + 1
                   END;
                 IF PLACEDAQUEEN THEN (*ROW IS OK*)
                    BEGIN    (*CHECK UPWARD DIAGONAL*)
                     DIAGNBR := I + CURCOLNBR;
                     J := 1;
                     WHILE PLACEDAQUEEN AND (J < CURCOLNBR) DO
                       BEGIN
                        PLACEDAQUEEN := (COLÆJÅ + J) <> DIAGNBR;
                        J := J + 1
                       END    (*WHILE*)
                     END;(*THEN*)
                 IF PLACEDAQUEEN THEN (*UPWARD DIAGONAL IS OK*)
                    BEGIN (*CHECK DOWNWARD DIAGONAL*)
                      DIAGNBR := I - CURCOLNBR;
                      J := 1;
                      WHILE PLACEDAQUEEN AND (J < CURCOLNBR) DO
                         BEGIN
                            PLACEDAQUEEN := (COLÆJÅ - J) <> DIAGNBR;
                            J := J + 1
                         END (*WHILE*)
                    END; (*THEN*)
                (*PIECE AT I IS NOW KNOWN TO BE VALID OR NOT*)
                 IF NOT PLACEDAQUEEN
                        THEN I := I + 1
                        ELSE COLÆCURCOLNBRÅ := I
               END;
                 IF NOT PLACEDAQUEEN (*COLUMN IS EXHAUSTED SO BACKTRACK*)
                      THEN
                        BEGIN
                         COLÆCURCOLNBRÅ := 0;
                         CURCOLNBR := CURCOLNBR - 1
                        END
                      ELSE
                        IF CURCOLNBR = N
                           THEN (*WE HAVE A SOLUTION*)
                              BEGIN   (*OUTPUT THE SOLUTION*)
                                  WRITE (' SOLUTION :');
                                FOR I := 1 TO N DO
                                WRITE (COLÆIÅ:4);
                                WRITELN
                              END
                           ELSE  CURCOLNBR := CURCOLNBR + 1
           END; (*OF PLACE A QUEEN LOOP*)
            WRITELN(' SEARCH COMPLETE')
        END
 END.

▶EOF◀