(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))))))