All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > General
No Safety from the Queen (Posted on 2004-09-23) Difficulty: 3 of 5
Given a 5x5 chess board, place the fewest number of queens possible on the board such that no queens are under attack but every other space is under attack.

See The Solution Submitted by logischer Verstand    
Rating: 3.0000 (7 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
re: 8x8 version--programs | Comment 4 of 13 |
(In reply to 8x8 version by Charlie)

To find solutions:

DECLARE SUB placeQueen (num!)
DIM SHARED d
d = 8
DIM SHARED board(d, d)
DIM SHARED hit(d, d)
DIM SHARED qrow(d), qcol(d)

CLS
OPEN "queens" + LTRIM$(STR$(d)) + ".txt" FOR OUTPUT AS #2
placeQueen 1
CLOSE

SUB placeQueen (num)
  FOR r = 1 TO d
   FOR c = 1 TO d
    IF num = 1 OR r > qrow(num - 1) THEN
      IF hit(r, c) = 0 THEN
        board(r, c) = 1: hit(r, c) = 1
        good = 1
        FOR i = 1 TO d + 1
          IF r - i > 0 THEN
            IF c - i > 0 THEN IF board(r - i, c - i) THEN good = 0: EXIT FOR
            IF board(r - i, c) THEN good = 0: EXIT FOR
            IF c + i < d + 1 THEN IF board(r - i, c + i) THEN good = 0: EXIT FOR
          END IF
          IF r + i < d + 1 THEN
            IF c - i > 0 THEN IF board(r + i, c - i) THEN good = 0: EXIT FOR
            IF board(r + i, c) THEN good = 0: EXIT FOR
            IF c + i < d + 1 THEN IF board(r + i, c + i) THEN good = 0: EXIT FOR
          END IF
          IF c - i > 0 THEN IF board(r, c - i) THEN good = 0: EXIT FOR
          IF c + i < d + 1 THEN IF board(r, c + i) THEN good = 0: EXIT FOR
        NEXT i
        IF good THEN
          FOR i = 1 TO d + 1
            IF r - i > 0 THEN
              IF c - i > 0 THEN hit(r - i, c - i) = hit(r - i, c - i) + 1
              hit(r - i, c) = hit(r - i, c) + 1
              IF c + i < d + 1 THEN hit(r - i, c + i) = hit(r - i, c + i) + 1
            END IF
            IF r + i < d + 1 THEN
              IF c - i > 0 THEN hit(r + i, c - i) = hit(r + i, c - i) + 1
              hit(r + i, c) = hit(r + i, c) + 1
              IF c + i < d + 1 THEN hit(r + i, c + i) = hit(r + i, c + i) + 1
            END IF
            IF c - i > 0 THEN hit(r, c - i) = hit(r, c - i) + 1
            IF c + i < d + 1 THEN hit(r, c + i) = hit(r, c + i) + 1
          NEXT i

          qrow(num) = r: qcol(num) = c

          FOR i = 1 TO d
            FOR j = 1 TO d
              IF hit(i, j) = 0 THEN good = 0: EXIT FOR
            NEXT
            IF good = 0 THEN EXIT FOR
          NEXT
          IF good THEN
            FOR i = 1 TO d
             FOR j = 1 TO d
              IF board(i, j) THEN PRINT #2, "Q "; :  ELSE PRINT #2, ". ";
             NEXT
             PRINT #2, num
            NEXT
            PRINT #2,
          ELSE
           '************
           IF num < d - 3 THEN
            placeQueen num + 1
           END IF
           '************
          END IF

          FOR i = 1 TO d + 1
            IF r - i > 0 THEN
              IF c - i > 0 THEN hit(r - i, c - i) = hit(r - i, c - i) - 1
              hit(r - i, c) = hit(r - i, c) - 1
              IF c + i < d + 1 THEN hit(r - i, c + i) = hit(r - i, c + i) - 1
            END IF
            IF r + i < d + 1 THEN
              IF c - i > 0 THEN hit(r + i, c - i) = hit(r + i, c - i) - 1
              hit(r + i, c) = hit(r + i, c) - 1
              IF c + i < d + 1 THEN hit(r + i, c + i) = hit(r + i, c + i) - 1
            END IF
            IF c - i > 0 THEN hit(r, c - i) = hit(r, c - i) - 1
            IF c + i < d + 1 THEN hit(r, c + i) = hit(r, c + i) - 1
          NEXT i
        END IF

        board(r, c) = 0: hit(r, c) = 0
      END IF
    END IF
   NEXT
  NEXT
END SUB

To eliminate rotations and reflections:

size = 8: name$ = "8"
DIM SHARED board(8, 8), ct

OPEN "queens" + name$ + ".txt" FOR INPUT AS #1
OPEN "q" + name$ + ".txt" FOR OUTPUT AS #2
DO
 FOR i = 1 TO size
  LINE INPUT #1, l$: lct = lct + 1
  ll = LEN(l$) + 2
  PRINT #2, l$
 NEXT
 PRINT #2, SPACE$(ll - 2)
 ct = ct + 1
 IF EOF(1) = 0 THEN LINE INPUT #1, l$: lct = lct + 1
LOOP UNTIL EOF(1)
CLOSE

phase2:

OPEN "q" + name$ + ".txt" FOR BINARY AS #1
OPEN "queens" + name$ + ".out" FOR OUTPUT AS #2
row$ = SPACE$(ll)
FOR soln = 1 TO ct
  stPos = (soln - 1) * ll * (size + 1) + 1
  FOR row = 1 TO size
    GET #1, stPos + (row - 1) * ll, row$
    FOR col = 1 TO size
      IF MID$(row$, col * 2 - 1, 1) = "*" OR MID$(row$, col * 2 - 1, 1) = "Q" THEN
        board(row, col) = 1
      ELSE
        board(row, col) = 0
      END IF
    NEXT
  NEXT
  good = 1
  FOR solRef = 1 TO soln - 1
    stPos = (solRef - 1) * ll * (size + 1) + 1
    FOR row = 1 TO size
      GET #1, stPos + (row - 1) * ll, row$
      FOR col = 1 TO size
        IF MID$(row$, col * 2 - 1, 1) = "*" OR MID$(row$, col * 2 - 1, 1) = "Q" THEN
          board2(row, col) = 1
        ELSE
          board2(row, col) = 0
        END IF
      NEXT
    NEXT
    FOR rotRef = 1 TO 7
      bad = 1
      FOR r = 1 TO size
        FOR c = 1 TO size
          SELECT CASE rotRef
            CASE 1
              r2 = size + 1 - r
              c2 = c
            CASE 2
              r2 = size + 1 - r
              c2 = size + 1 - c
            CASE 3
              r2 = r
              c2 = size + 1 - c
            CASE 4
              r2 = size + 1 - c
              c2 = r
            CASE 5
              r2 = size + 1 - c
              c2 = size + 1 - r
            CASE 6
              r2 = c
              c2 = size + 1 - r
            CASE 7
              r2 = c
              c2 = r
          END SELECT
          IF board(r, c) <> board2(r2, c2) THEN bad = 0: EXIT FOR
        NEXT
        IF bad = 0 THEN EXIT FOR
      NEXT
      IF bad THEN good = 0: EXIT FOR
    NEXT
    IF good = 0 THEN EXIT FOR
  NEXT
  IF good THEN
    stPos = (soln - 1) * ll * (size + 1) + 1
    FOR row = 1 TO size
      GET #1, stPos + (row - 1) * ll, row$
      PRINT #2, row$;
    NEXT
    PRINT #2,
    ct2 = ct2 + 1
  END IF
NEXT
PRINT ct2

 


  Posted by Charlie on 2004-09-23 09:34:32
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (5)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information