75 lines
2.3 KiB
Scheme
75 lines
2.3 KiB
Scheme
(import (scheme base)
|
|
(scheme write)
|
|
(srfi 1))
|
|
|
|
;; return list of solutions to n-queens problem
|
|
(define (n-queens n) ; breadth-first solution
|
|
(define (place-initial-row) ; puts a queen on each column of row 0
|
|
(list-tabulate n (lambda (col) (list (cons 0 col)))))
|
|
(define (place-on-row soln-so-far row)
|
|
(define (invalid? col)
|
|
(any (lambda (posn)
|
|
(or (= col (cdr posn)) ; on same column
|
|
(= (abs (- row (car posn))) ; on same diagonal
|
|
(abs (- col (cdr posn))))))
|
|
soln-so-far))
|
|
;
|
|
(do ((col 0 (+ 1 col))
|
|
(res '() (if (invalid? col)
|
|
res
|
|
(cons (cons (cons row col) soln-so-far)
|
|
res))))
|
|
((= col n) res)))
|
|
;
|
|
(do ((res (place-initial-row)
|
|
(apply append
|
|
(map (lambda (soln-so-far) (place-on-row soln-so-far row))
|
|
res)))
|
|
(row 1 (+ 1 row)))
|
|
((= row n) res)))
|
|
|
|
;; display solutions in 2-d array form
|
|
(define (pretty-print solutions n)
|
|
(define (posn->index posn)
|
|
(+ (* n (cdr posn))
|
|
(car posn)))
|
|
(define (pp solution)
|
|
(let ((board (make-vector (square n) ".")))
|
|
(for-each (lambda (queen) (vector-set! board
|
|
(posn->index queen)
|
|
"Q"))
|
|
solution)
|
|
(let loop ((row 0)
|
|
(col 0))
|
|
(cond ((= row n)
|
|
(newline))
|
|
((= col n)
|
|
(newline)
|
|
(loop (+ 1 row) 0))
|
|
(else
|
|
(display (vector-ref board (posn->index (cons row col))))
|
|
(loop row (+ 1 col)))))))
|
|
;
|
|
(display (string-append "Found "
|
|
(number->string (length solutions))
|
|
" solutions for n="
|
|
(number->string n)
|
|
"\n\n"))
|
|
(for-each pp solutions))
|
|
|
|
;; create table of number of solutions
|
|
(do ((n 1 (+ 1 n)))
|
|
((> n 10) )
|
|
(display n)
|
|
(display " ")
|
|
(display (length (n-queens n)))
|
|
(newline))
|
|
|
|
;; show some examples
|
|
(pretty-print (n-queens 1) 1)
|
|
(pretty-print (n-queens 2) 2)
|
|
(pretty-print (n-queens 3) 3)
|
|
(pretty-print (n-queens 4) 4)
|
|
(pretty-print (n-queens 5) 5)
|
|
(pretty-print (n-queens 8) 8)
|