8 Queens Problem

Code for the "8 Queens problem"

; REN-C solution to the N Queens problem
;
; Place all N queens on the NxN chessboard where every queen is to be placed 
; on a field that is not taken nor covered by any of the other queens.
;
; We know the solutions are not symmetrical themselves but the solutions can be
; mirror images of other solutions or turned solutions.

; This solution works as follows
; By symmetry we only need to test the first half of the row or column with
; the first queen. On an odd sized board we only cannot double the number of
; results for the middle position.

; We do not know or even care if we work horizontally or vertically and even if we are
; starting at the first or last row or column is irrelevant.

; We start with adding our first queen to the board. This is a number in a
; solution block. The we go to the next level and determine the free choices
; for our next queen. This is a collection of all fields minus the ones other
; queens cover. This propagates through all rows / columns. At the end we
; reach an empty set so no solution or a set of solutions.

; This global variable is a quick and dirty fix.
number-of-solutions: 0

reset-number-of-solutions: does [
    number-of-solutions: 0
]

add-one-to-number-of-solutions: does [
    number-of-solutions: number-of-solutions + 1
]

get-number-of-solutions: does [
    number-of-solutions
]

; This variable is to signal that results should not be duplicated for
; this value.
odd-symmetry-limit: 0

reset-symmetry-limit: does [
    odd-symmetry-limit: 0
]

add-to-symmetry-limit: does [
    odd-symmetry-limit: odd-symmetry-limit + 1
]

;
logic-countonly: 0

set-countonly-true: does [
    logic-countonly: 1
]

set-countonly-false: does [
    logic-countonly: 0
]

; Function to print the board for a solution

print-board: function [n [integer!]
                       board-values [block!]
][
    a: copy ""
    for-each b board-values [
        repeat t b - 1 [ append a ". "]
        append a "Q "
        repeat t n - b [ append a ". "]
        append a newline
    ]
    print a
]

; Function for recursion
add-queen: function [n [integer!]
     solution [block!]
     free-places [block!]
][
     ; Determine the free choices for this queen
     forbidden-places: copy []
     can-see: 1
     rsolution: reverse copy solution
     for-each sol rsolution [
         append forbidden-places sol
         append forbidden-places sol + can-see
         append forbidden-places sol - can-see ; too lazy to check for out of bounds
         can-see: can-see + 1
     ]
     free-choices: exclude free-places forbidden-places
     if not empty? free-choices [
         either n = 1 [
             ; now check for a solution, no more recursion possible
             for-each place free-choices [
                 append solution place
                 if logic-countonly = 0 [print-board length-of solution solution]
                 add-one-to-number-of-solutions
                 if any [odd-symmetry-limit > first solution
                         odd-symmetry-limit = 0]
                  [
                     if logic-countonly = 0 [print-board length-of solution reverse copy solution]
                     add-one-to-number-of-solutions
                 ]
                 clear skip solution ((length-of solution) - 1)
             ]
         ][
             for-each place free-choices [
                 append solution place
                 add-queen n - 1 solution free-places
                 clear skip solution ((length-of solution) - 1)
             ]
         ]
     ]
]

; Function for main solution

solve-n-queens: function [
    n [integer!] "The number queens on to place the board of size nxn"
    /countonly "Only print the number of solutions found"
][
    ; We need to know this within our recursive function
    either "/countonly" = mold countonly [
        set-countonly-true
    ][
        set-countonly-false
    ]

    ; make a basic block of the row / column numbers
    places-block: copy []
    count-up i n [append places-block i]

    reset-number-of-solutions

    ; We need only do half of the first row / column for reasons of symmetry
    half: either odd? n [(n + 1) / 2][n / 2]
    reset-symmetry-limit
    if odd? n [
        loop half [add-to-symmetry-limit]
    ]

    either n > 1 [
        count-up first-queen half [
            solution: copy []
            append solution first-queen

            add-queen n - 1 solution places-block

            clear solution ; this is okay because we are in the outermost loop here
        ]
    ][
        add-one-to-number-of-solutions
        print-board n [1]
    ]

    ; print the number of solutions now
    print spaced ["Total number of solutions for n =" n "is" get-number-of-solutions]
]


; Examples

solve-n-queens 1
solve-n-queens 2
solve-n-queens 3
solve-n-queens 4
solve-n-queens 5
solve-n-queens/countonly 5

solve-n-queens/countonly 8
; 92

If we want to know how slow REN-C is on my machine

>> delta-time [solve-n-queens/countonly 5]
Total number of solutions for n = 5 is 10
== 0:00:00.00145

>> delta-time [solve-n-queens/countonly 8]
Total number of solutions for n = 8 is 92
== 0:00:00.041275

>> delta-time [solve-n-queens/countonly 12] 
Total number of solutions for n = 12 is 14200
== 0:00:08.126828

>> delta-time [solve-n-queens/countonly 14] 
Total number of solutions for n = 14 is 365596
== 0:06:21.679977
2 Likes

I didn't notice this when it was originally posted. I've reformulated it so that it can serve as a test. So thanks for the contribution. :+1:


I'm not sure why you would have ever done this:

either "/countonly" = mold countonly [
    set-countonly-true
][
    set-countonly-false
]

Testing for refinements being true or false has always been doable with just either countonly. And setting a logic variable to 1 or 0 undermines the existence of a logic type...?


I changed the function to do a multi-return, where a list of the board configurations that match is the second value (if you don't say /countonly).

[num boards]: solve-n-queens 4
all [
    num = 2
    boards = apply :reduce [/predicate :trim, [
        {. Q . .
         . . . Q
         Q . . .
         . . Q .}

        {. . Q .
         Q . . .
         . . . Q
         . Q . .}
    ]]
]

It's a bit unfortunate that we no longer have the ability to have a function like SOLVE-N-QUEENS "sense" whether the second parameter is being requested, and use that to decide whether to count-only or not. But that feature broke multi-return function composition, and the cases that want to be conditional like this are somewhat rare. But when they show up, I do feel a bit of a loss.


If we want to know how slow REN-C is on my machine

Regarding performance...unfortunately, current Ren-C is even slower than older Ren-C. But this is a by-product of pursuing big design questions and trying to hammer out the essential character of the language.

I'm sure it can be improved significantly with an investment of effort. But no matter how much better it gets, there are going to be limits with the medium. Interpreted code doing calculation is never going to rival native or JIT-compiled code. So the answer for people who reach those limits--but want to stay somewhat within the medium--would be to use something along the lines of a Red/System that can be compiled but still pick apart blocks and dialects.

But still, any brute force algorithm will hit limits regardless of language. If Ren-C clogs up with an approach at 14 you'll probably find a faster language taking the same approach would do poorly at 28, any N^2 algorithm will eventually cripple your machine.

2 Likes

Coming from R2 and Red and just testing for the refinement, there had been some changes with how they were handled, and just coming up with a way that worked for my case. It is a single check so performance-wise it is not important. I just got this working as is, which was the important part.

And about the slowness, sure it is compared to compiled and yes even those will face increasingly hard times for larger tasks. The nice thing though is that Rebol / Ren-C allows for this kind of solution by their flexing-skills and to my personal taste I think this solution is much more intuitive than the regular algorithms used to program this in other languages.