Eight queens problem solved with Ren-C

On the search for nice problems to solve using my computer and our favorite programming language, I came across an old familiar problem. The placing of 8 queens on the chessboard.

So I decided to have my take and solve this using some language specific features that Ren-C has to offer.

; 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 to place on 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]
]

Agreed there is some room for improvement 🙂

Anyway it works and relatively fast also. 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

I don’t think that is bad for an interpreted language. And I like the way this solving method works, I consider it to be rather intuitively.

Agree or disagree?

One thing, do not expect this code to just work out of the box today! Ren-C is subject to many changes lately especially the working of refinement has been changed a little. But the main idea of the solving method still holds.