(sicp21)昨日の続き

8queens-puzzleも解いた。前回よりも回答にたどり着くまでの時間は短かったけど、
あまりキレイな書き方にはなってないような気がする。

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;;すっごい愚直な感じ　> safe
(define (safe? k pos)
  (define (iter seq xkey ykey)
    (if (null? seq)
        #t
        (if (or (= xkey (caar seq))
                (= ykey (cadar seq))
                (= (abs (- xkey (caar seq))) (abs (- ykey (cadar seq)))))
            #f
            (iter (cdr seq) xkey ykey))))
  (iter (cdr pos) (caar pos) (cadar pos)))

(define empty-board '())

(define (adjoin-position new-row k rest-of-queens)
  (cons (list new-row k) rest-of-queens))

 (adjoin-position  1 2 '((3 4) (5 6)))
;;	gosh> ((1 2) (3 4) (5 6))

(queens 4)
;;	gosh> (((3 4) (1 3) (4 2) (2 1)) ((2 4) (4 3) (1 2) (3 1)))

;;せっかくなので4queens-puzzleの結果を表示してみる。
(define (view seq max)
  (print "")
  (for-each
   (lambda (n)
     (print (make-string (- n 1) #\-) "O" (make-string (- max n) #\-)))
   (map cadr (sort seq (lambda (x y) (< (car x) (car y)))))))

(let ((n 4))
  (for-each (lambda (x) (view x n)) (queens n)))
;;	gosh>	
;;	--O-
;;	O---
;;	---O
;;	-O--

;;	-O--
;;	---O
;;	O---
;;	--O-
;;	#<undef>