8 Queens Problem in Racket

queens.rkt

#lang racket


(define (all-positions n)
  (for*/list ([i n]
              [j n])
    (cons i j)))

(define (single-solutions n)
  (for/list ([i (all-positions n)])
    (list i)))

(define (safe? p sol)
  (for/and ([i sol])
    (and (not (= (car i) (car p)))
         (not (= (cdr i) (cdr p)))
         (not (= (abs (- (car i) (car p)))
                 (abs (- (cdr i) (cdr p))))))))

(define (merge p sols)
  (map (λ (s) (cons p s))
       (filter (λ (x) (safe? p x)) sols)))

(define (merge-all ps sols)
  (apply append
         (map (λ (p) (merge p sols)) ps)))

(define (same-sol? s1 s2)
  (and (= (length s1)
          (length s2))
       (for/and ([i s1])
         (member i s2))))

(define (queens size qn)
  (let ([pos (all-positions size)]
        [s (single-solutions size)])
    (for/fold ([result s])
              ([i (- qn 1)])
      (merge-all pos result))))

(define (remove-duplicates sls uniq-ls)
  (cond
    ((empty? sls) uniq-ls)
    (else (if (member (car sls)
                      uniq-ls
                      same-sol?)
              (remove-duplicates (cdr sls) uniq-ls)
              (remove-duplicates (cdr sls) (cons (car sls) uniq-ls))))))

(define (show-solution sol n)
  (let ([grid (for/list ([i n])
                 (for/list ([j n])
                   (if (member (cons i j) sol)
                       "Q"
                       ".")))])
    (string-join (map (λ (x) (string-join x " ")) grid) "\n")))


;(define q4 (remove-duplicates (queens 4 4) '()))

;(define q8 (remove-duplicates (queens 8 8) '()))


(define (show-queens n data)
  (string-join
   (for/list ([i n])
     (string-join
      (for/list ([j n])
        (if (member (cons i j) data)
            "Q"
            "."))
      " "))
   "\n"))

;(for ([i q8])
;    (displayln (show-queens 8 i))
;    (displayln "\n\n"))

;(for ([i q4])
;    (displayln (show-queens 4 i))
;    (displayln "\n\n"))