Comparing a sequential and parallel version of 13-Queens in Racket

parallel.rkt

#lang racket

(provide main)

; Represent a position as a struct with x (file) and y (rank) members
(struct pos (x y) #:prefab)

; Indicate whether q1 is attacking q2
(define (is-attacking? q1 q2)
  (let ([q1x (pos-x q1)] [q1y (pos-y q1)] [q2x (pos-x q2)] [q2y (pos-y q2)])
    (or (= q1y q2y)
        (= (abs (- q1y q2y))
           (abs (- q1x q2x))))))

; Indicate whether the stack of positions is valid
(define (valid? stack)
  (not (ormap (curry is-attacking? (car stack)) (cdr stack))))

; Return a stack representing the next position, or #f if none exist
(define (next-position n stack)
  (cond [ (null? stack) #f ]
        [ else (match-define (pos x y) (car stack))
              (if (< y n)
                  (cons (pos x (+ y 1)) (cdr stack))
                  (next-position n (cdr stack))) ]))

; Accept a board size and partial list of moves, and return
; the next solution if one exists, or #f if not
(define (queens n stack)
  (let loop ([stack stack])
    (match-define (pos x y) (car stack))
    (cond [ (> x n) (cdr stack)                                ] ; Return solution
          [ (valid? stack) (loop (cons (pos (+ x 1) 1) stack)) ] ; Go to next file
          [ (< y n) (loop (cons (pos x (+ y 1)) (cdr stack)))  ] ; Go to next rank
          [ else (let ([next (next-position n (cdr stack))])     ; Backtrack
                  (if next (loop next) #f))                    ])))

(define (prefix-matches? prefix stack)
  (let ([plen (length prefix)]
        [slen (length stack)])
    (and (>= slen plen)
         (equal? prefix (take-right stack plen)))))

; Accept a partial list of moves (prefix), and return a list of solutions with the same prefix.
(define (solutions-for-prefix n prefix ch)
  (let loop ([solution (queens n prefix)])
    (when (and solution (prefix-matches? prefix solution))
      (begin
        (place-channel-put ch solution)
        (let ([stack (next-position n solution)])
          (when stack ; Also verify stack matches prefix?
            (loop (queens n stack))))))))

(define (main)
  (define n 13)
  (define num-solutions 73712)
  (define-values (parent child) (place-channel))

  ; Create worker places
  (for ([i '(1 2 3 4 5 6 7)])
       (define p
         (place ch
                (define n (place-channel-get ch))
                (define queue (place-channel-get ch))
                (let loop ([prefix (place-channel-get queue)])
                  (solutions-for-prefix n prefix queue)
                  (loop (place-channel-get queue)))))
       
       (place-channel-put p n)
       (place-channel-put p child))

  (for ([i (in-range 1 (+ n 1) 1)])
       (place-channel-put parent (list (pos 1 i))))

  (define count 0)
  (let loop ([solutions (list (place-channel-get parent))])
    (set! count (+ count 1))
    (if (< count num-solutions)
      (loop (cons (place-channel-get parent) solutions))
      (length solutions))))

sequential.rkt

#lang racket
; Represent a position as a struct with x (file) and y (rank) members
(struct pos (x y) #:transparent)

; Indicate whether q1 is attacking q2
(define (is-attacking? q1 q2)
  (let ([q1x (pos-x q1)] [q1y (pos-y q1)] [q2x (pos-x q2)] [q2y (pos-y q2)])
    (or (= q1y q2y)
        (= (abs (- q1y q2y))
           (abs (- q1x q2x))))))

; Indicate whether the stack of positions is valid
(define (valid? stack)
  (not (ormap (curry is-attacking? (car stack)) (cdr stack))))

; Return a stack representing the next position, or #f if none exist
(define (next-position n stack)
  (cond [ (null? stack) #f ]
        [ else (match-define (pos x y) (car stack))
              (if (< y n)
                  (cons (pos x (+ y 1)) (cdr stack))
                  (next-position n (cdr stack))) ]))

; Accept a board size and partial list of moves, and return the next solution
(define (queens n stack)
  (let loop ([stack stack])
    (match-define (pos x y) (car stack))
    (cond [ (> x n) (cdr stack)                                ] ; Return solution
          [ (valid? stack) (loop (cons (pos (+ x 1) 1) stack)) ] ; Go to next file
          [ (< y n) (loop (cons (pos x (+ y 1)) (cdr stack)))  ] ; Go to next rank
          [ else (let ([next (next-position n (cdr stack))])     ; Backtrack
                  (if next (loop next) #f))                    ])))

; Return a list of all solutions for the specified board size
(define (main n)
  (let loop ([stack (list (pos 1 1))]
             [solutions '()])
    (if stack
        (let ([solution (queens n stack)])
          (if solution
              (loop (next-position n solution) (cons solution solutions))
              solutions))
        solutions)))

(length (main 13))