Source code in the racket programming language

#lang racket

(struct Q (x y) #:transparent)

;; returns true if given q1 and q2 do not conflict
(define (safe? q1 q2)
  (match* (q1 q2)
    [((Q x1 y1) (Q x2 y2))
     (not (or (= x1 x2) (= y1 y2)
              (= (abs (- x1 x2)) (abs (- y1 y2)))))]))

;; returns true if given q doesn't conflict with anything in given list of qs
(define (safe-lst? q qs) (for/and ([q2 qs]) (safe? q q2)))

(define (nqueens n)
  ;; qs is partial solution; x y is current position to try
  (let loop ([qs null] [x 0] [y 0])
    (cond [(= (length qs) n) qs]          ; found a solution
          [(>= x n) (loop qs 0 (add1 y))] ; go to next row
          [(>= y n) #f]                   ; current solution is invalid
          [else
           (define q (Q x y))
           (if (safe-lst? q qs) ; is current position safe?
               (or (loop (cons q qs) 0 (add1 y)) ; optimistically place a queen
                                                 ; (and move pos to next row)
                   (loop qs (add1 x) y))  ; backtrack if it fails
               (loop qs (add1 x) y))])))

(nqueens 8)
; => (list (Q 3 7) (Q 1 6) (Q 6 5) (Q 2 4) (Q 5 3) (Q 7 2) (Q 4 1) (Q 0 0))

(require htdp/show-queen)

(define (show-nqueens n)
  (define qs (time (nqueens n)))
  (show-queen
   (for/list ([row n])
     (for/list ([col n])
       (if (member (Q row col) qs) #t #f)))))

(show-nqueens 8)

#lang racket

(struct Q (x y) #:transparent)

(define-syntax-rule (lcons x y) (cons x (lazy y)))

(define (lazy-filter p? lst)
  (define flst (force lst))
  (if (null? flst) '()
      (let ([x (car flst)])
        (if (p? x)
            (lcons x (lazy-filter p? (cdr flst)))
            (lazy-filter p? (cdr flst))))))

(define (lazy-foldr f base lst)
  (define flst (force lst))
  (if (null? flst) base
      (f (car flst) (lazy (lazy-foldr f base (cdr flst))))))

(define (tails lst)
  (if (null? lst) '(())
      (cons lst (tails (cdr lst)))))

(define (safe? q1 q2)
  (match* (q1 q2)
    [((Q x1 y1) (Q x2 y2))
     (not (or (= x1 x2) (= y1 y2)
              (= (abs (- x1 x2)) (abs (- y1 y2)))))]))

(define (safe-lst? lst)
  (or (null? lst)
      (let ([q1 (car lst)])
        (for/and ([q2 (cdr lst)]) (safe? q1 q2)))))

(define (valid? lst) (andmap safe-lst? (tails lst)))

(define (nqueens n)
  (define all-possible-solutions
    (for/fold ([qss-so-far '(())]) ([row (in-range n)])
      (lazy-foldr
       (λ (qs new-qss)
         (append (for/list ([col (in-range n)]) (cons (Q row col) qs))
                 new-qss))
       '() qss-so-far)))
  (lazy-filter valid? all-possible-solutions))

(car (nqueens 8))
;; => (list (Q 7 3) (Q 6 1) (Q 5 6) (Q 4 2) (Q 3 5) (Q 2 7) (Q 1 4) (Q 0 0))

(define (force-and-print qs)
  (define forced (force qs))
  (unless (null? forced)
    (printf "~v\n" (car forced))
    (force-and-print (cdr forced))))

(force-and-print (nqueens 8))

; =>
;(list (Q 7 3) (Q 6 1) (Q 5 6) (Q 4 2) (Q 3 5) (Q 2 7) (Q 1 4) (Q 0 0))
;(list (Q 7 4) (Q 6 1) (Q 5 3) (Q 4 6) (Q 3 2) (Q 2 7) (Q 1 5) (Q 0 0))
;(list (Q 7 2) (Q 6 4) (Q 5 1) (Q 4 7) (Q 3 5) (Q 2 3) (Q 1 6) (Q 0 0))
;(list (Q 7 2) (Q 6 5) (Q 5 3) (Q 4 1) (Q 3 7) (Q 2 4) (Q 1 6) (Q 0 0))
...
;(list (Q 7 5) (Q 6 3) (Q 5 6) (Q 4 0) (Q 3 2) (Q 2 4) (Q 1 1) (Q 0 7))
;(list (Q 7 3) (Q 6 6) (Q 5 4) (Q 4 1) (Q 3 5) (Q 2 0) (Q 1 2) (Q 0 7))
;(list (Q 7 4) (Q 6 6) (Q 5 1) (Q 4 5) (Q 3 2) (Q 2 0) (Q 1 3) (Q 0 7))

#lang racket
(define (remove x lst)
  (for/list ([i (in-range (length lst))]
             #:when (not (= x i)))
    (list-ref lst i)))

(define (switch-pairs lst)
  (cond [(null? lst) '()]
        [(null? (cdr lst)) (list '() (car lst))]
        [else (append (list (cadr lst) (car lst))
                      (switch-pairs (cddr lst)))]))

(define (switch-places a1 a2 lst)
  (for/list ([i (length lst)])
    (list-ref lst (cond [(= a1 i) a2] [(= a2 i) a1] [else i]))))

(define (position-queens n)
  (cond [(= 1 n) (list (list 1))]
        [(> 4 n) #f]
        [else (possible-queens n)]))

(define (possible-queens n)
  (define rem (remainder n 12))
  (define lst (build-list n add1))
  (define evens (filter even? lst))
  (define odds (filter odd? lst))
  (cond [(or (= rem 9) (= rem 3)) (case3or9 evens odds)]
        [(= rem 8) (case8 evens odds)]
        [(= rem 2) (case2 evens odds)]
        [else (append evens odds)]))

(define (case3or9 evens odds)
  (for/fold ([acum (append (cdr evens) (list (car evens)) odds)])
            ([i (in-list '(1 3))])
    (append (remove (list-ref acum i) acum) (list i))))

(define (case8 evens odds)
  (append evens (switch-pairs odds)))

(define (case2 evens odds)
  (define nums (append evens odds))
  (define idx (map (λ(i) (list-ref nums i)) '(1 3 5)))
  (append (remove (caddr idx)
                  (switch-places (car idx) (cadr idx) nums))
          '(5)))

(define (queens n)
  (define position-numbers (position-queens n))
  (define positions-on-board
    (for/list ([i n]) (cons i (sub1 (list-ref position-numbers i)))))
  (for/list ([x n])
    (for/list ([y n])
      (if (member (cons x y) positions-on-board) "Q" "."))))

(define (print-queens n)
  (for ([x (queens n)]) (displayln (string-join x))))