104 lines
2.5 KiB
Scheme
104 lines
2.5 KiB
Scheme
|
|
(define allqueens
|
|
(lambda (n doneproc)
|
|
(letrec
|
|
((diag1
|
|
(lambda (board col)
|
|
(if (null? board) '()
|
|
(cons (+ col (car board))
|
|
(diag1 (cdr board) (+ col 1))))))
|
|
(diag2
|
|
(lambda (board col)
|
|
(if (null? board) '()
|
|
(cons (- col (car board))
|
|
(diag2 (cdr board) (+ col 1))))))
|
|
(consistent?
|
|
(lambda (board col new)
|
|
(not
|
|
(or (member new board)
|
|
(member (+ col new)
|
|
(diag1 board 1))
|
|
(member (- col new)
|
|
(diag2 board 1))))))
|
|
(check
|
|
(lambda (board col)
|
|
(if (> col n) (doneproc board)
|
|
(for-each
|
|
(lambda (row)
|
|
(if (consistent? board col row)
|
|
(check (append board (list row))
|
|
(+ 1 col))))
|
|
(list-n n))))))
|
|
(check '() 1))))
|
|
|
|
(define showqueens
|
|
(lambda (n)
|
|
(allqueens
|
|
n (lambda (sol) (display sol) (newline)))))
|
|
|
|
(showqueens 4)
|
|
|
|
(define queens
|
|
(lambda (n)
|
|
(letrec
|
|
((y-reflect reverse)
|
|
(rotate
|
|
(lambda (board)
|
|
(map
|
|
(lambda (row)
|
|
(- (+ 1 n) (length (member row board))))
|
|
(list-n n))))
|
|
(symmetries
|
|
(lambda (board)
|
|
(list
|
|
board
|
|
(rotate board)
|
|
(rotate (rotate board))
|
|
(rotate (rotate (rotate board)))
|
|
(y-reflect board)
|
|
(rotate (y-reflect board))
|
|
(rotate (rotate (y-reflect board)))
|
|
(rotate (rotate (rotate (y-reflect board)))))))
|
|
(result '())
|
|
(new?
|
|
(lambda (rlist sol)
|
|
(if (null? rlist) #t
|
|
(if (member sol (car rlist)) #f
|
|
(new? (cdr rlist) sol))))))
|
|
(allqueens
|
|
n
|
|
(lambda (sol)
|
|
(if (new? result sol)
|
|
(set! result (cons (symmetries sol) result)))))
|
|
(map car result))))
|
|
|
|
(define printunique
|
|
(lambda (n)
|
|
(for-each
|
|
(lambda (sol)
|
|
(let ((vect (make-vector (* n n) #\.)))
|
|
(for-each
|
|
(lambda (col)
|
|
(vector-set!
|
|
vect
|
|
(- (+ (* n (- n (list-ref sol (- col 1)))) col) 1)
|
|
#\*))
|
|
(list-n n))
|
|
(for-each
|
|
(lambda (pos)
|
|
(display (vector-ref vect (- pos 1)))
|
|
(display #\space)
|
|
(if (zero? (remainder pos n)) (newline)))
|
|
(reverse (list-n (* n n))))
|
|
(newline)))
|
|
(queens n))))
|
|
|
|
(printunique 5)
|
|
|
|
(define values
|
|
(lambda (n)
|
|
(map length
|
|
(map (lambda (k)
|
|
(display k) (newline) (queens k))
|
|
(reverse (list-n n))))))
|