SICP 読み (28)

問題 2.42 の解を。
勘違いしていたのは以下の adjoin-positions です。

(define (adjoin-position new-row k seq)
 (append seq (list new-row)))

ナゼに k が必要なんだろな、と思いつつスルーしていた。この問題は試験ドリブンで解くべきだったな、と今さらながらに (以下略

以下が解。safe? とかもう少しスマートにならんものか、と思いつつ晒す。

(define (filter predicate sequence)
 (cond ((null? sequence) '())
       ((predicate (car sequence))
        (cons (car sequence)
              (filter predicate (cdr sequence))))
       (else
        (filter predicate (cdr sequence)))))

(define (accumulate op init seq)
 (if (null? seq)
     init
     (op (car seq)
         (accumulate op init (cdr seq)))))

(define (flatmap proc seq)
 (accumulate append '() (map proc seq)))

(define (enumulate-interval low high)
 (if (> low high)
     '()
     (cons low (enumulate-interval (+ low 1) high))))

(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))
                (enumulate-interval 1 board-size)))
         (queen-cols (- k 1))))))
 (queen-cols board-size))

(define empty-board '(()))

(define (tailend seq)
 (let f ((seq seq) (ret '()))
   (if (null? seq)
       ret
       (f (cdr seq) (car seq)))))

(define (safe? k seq)
 (define (safe-iter p k seq)
   (cond ((= (- k p) 0) #t)
	 ((= (abs (- (car seq) (tailend seq))) (- k p)) #f)
	 ((= (car seq) (tailend seq)) #f)
	 (else
	  (safe-iter (+ p 1) k (cdr seq)))))
 (safe-iter 1 k seq))

(define (adjoin-position new-row k seq)
 (if (= k 1)
     (list new-row)
     (append seq (list new-row))))

問題 2.43 はとても良い課題だな、と思いはするものの_さくっと_イメージできん。