(sicp17)m2.40〜m2.42

久しぶりなので復習もした。
問題2.42にとても時間がかかった。（解けてしまえばそんなに難しくなかった）

(use pre-sicp) ;;この中にaccumurateとかが定義されている。

;;復習する。

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))
(define (permutations s)
  (if (null? s)
      (list '())
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))
(define (remove item sequence)
  (filter (lambda (x) (not (= x item)))
          sequence))

;;m2.40
;prime-sum-pairsの改良は省略
(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j) (list i j))
                  (enumerate-interval 1 (- i 1))))
             (enumerate-interval 1 n)))

;;m2.41
(define (triple-sum-is-s s n)
  (filter (lambda (xs) (= s (accumulate + 0 xs)))
          (flatmap (lambda (i)
                     (map (lambda (j) (append (list i) j))
                          (unique-pairs (- i 1))))
                   (enumerate-interval 1 n))))

;;面倒なので確認ようの関数を作る。
(define (check-sum-is-s? s n)
  (map (lambda (xs) (list xs (accumulate + 0 xs)))
       (triple-sum-is-s s n)))

;;ついでにlistの要素ごとに改行しつつ出力する関数を作る。
(define (outputs-list seq)
  (cond ((null? seq) "  END")
        (else (display (car seq))
              (newline)
              (outputs-list (cdr seq)))))

;	gosh> (outputs-list (check-sum-is-s? 13 10))
;	((6 4 3) 13)
;	((6 5 2) 13)
;	((7 4 2) 13)
;	((7 5 1) 13)
;	((8 3 2) 13)
;	((8 4 1) 13)
;	((9 3 1) 13)
;	((10 2 1) 13)
;	"  END"


;;m2.42
(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))

;;未実装の関数を実装する
(define empty-board '())
(define (safe? k positions)
  (define (iter x y target)
    (if (null? target)
        #t
        (let ((next-x (caar target))
              (next-y (cadar target)))
          (if (and (not (= x next-x))
                   (not (= y next-y))
                   (not (= (abs (- next-x x)) (abs (- next-y y)))))
              (iter x y (cdr target))
              #f))))
  (iter k (cadar positions) (cdr positions)))
(define (adjoin-position new-row k rest-of-queens)
   (append (list (list k new-row)) rest-of-queens))
;;ここでも出力
;	gosh> (outputs-list (queens 8))
;	((8 4) (7 2) (6 7) (5 3) (4 6) (3 8) (2 5) (1 1))
;	((8 5) (7 2) (6 4) (5 7) (4 3) (3 8) (2 6) (1 1))
;	((8 3) (7 5) (6 2) (5 8) (4 6) (3 4) (2 7) (1 1))
;	((8 3) (7 6) (6 4) (5 2) (4 8) (3 5) (2 7) (1 1))
;	((8 5) (7 7) (6 1) (5 3) (4 8) (3 6) (2 4) (1 2))
;	((8 4) (7 6) (6 8) (5 3) (4 1) (3 7) (2 5) (1 2))
;	((8 3) (7 6) (6 8) (5 1) (4 4) (3 7) (2 5) (1 2))
;	((8 5) (7 3) (6 8) (5 4) (4 7) (3 1) (2 6) (1 2))
;	((8 5) (7 7) (6 4) (5 1) (4 3) (3 8) (2 6) (1 2))
;	((8 4) (7 1) (6 5) (5 8) (4 6) (3 3) (2 7) (1 2))
;	((8 3) (7 6) (6 4) (5 1) (4 8) (3 5) (2 7) (1 2))
;	((8 4) (7 7) (6 5) (5 3) (4 1) (3 6) (2 8) (1 2))
;	((8 6) (7 4) (6 2) (5 8) (4 5) (3 7) (2 1) (1 3))
;	((8 6) (7 4) (6 7) (5 1) (4 8) (3 2) (2 5) (1 3))
;	((8 1) (7 7) (6 4) (5 6) (4 8) (3 2) (2 5) (1 3))
;	((8 6) (7 8) (6 2) (5 4) (4 1) (3 7) (2 5) (1 3))
;	((8 6) (7 2) (6 7) (5 1) (4 4) (3 8) (2 5) (1 3))
;	((8 4) (7 7) (6 1) (5 8) (4 5) (3 2) (2 6) (1 3))
;	((8 5) (7 8) (6 4) (5 1) (4 7) (3 2) (2 6) (1 3))
;	((8 4) (7 8) (6 1) (5 5) (4 7) (3 2) (2 6) (1 3))
;	((8 2) (7 7) (6 5) (5 8) (4 1) (3 4) (2 6) (1 3))
;	((8 1) (7 7) (6 5) (5 8) (4 2) (3 4) (2 6) (1 3))
;	((8 2) (7 5) (6 7) (5 4) (4 1) (3 8) (2 6) (1 3))
;	((8 4) (7 2) (6 7) (5 5) (4 1) (3 8) (2 6) (1 3))
;	((8 5) (7 7) (6 1) (5 4) (4 2) (3 8) (2 6) (1 3))
;	((8 6) (7 4) (6 1) (5 5) (4 8) (3 2) (2 7) (1 3))
;	((8 5) (7 1) (6 4) (5 6) (4 8) (3 2) (2 7) (1 3))
;	((8 5) (7 2) (6 6) (5 1) (4 7) (3 4) (2 8) (1 3))
;	((8 6) (7 3) (6 7) (5 2) (4 8) (3 5) (2 1) (1 4))
;	((8 2) (7 7) (6 3) (5 6) (4 8) (3 5) (2 1) (1 4))
;	((8 7) (7 3) (6 1) (5 6) (4 8) (3 5) (2 2) (1 4))
;	((8 5) (7 1) (6 8) (5 6) (4 3) (3 7) (2 2) (1 4))
;	((8 1) (7 5) (6 8) (5 6) (4 3) (3 7) (2 2) (1 4))
;	((8 3) (7 6) (6 8) (5 1) (4 5) (3 7) (2 2) (1 4))
;	((8 6) (7 3) (6 1) (5 7) (4 5) (3 8) (2 2) (1 4))
;	((8 7) (7 5) (6 3) (5 1) (4 6) (3 8) (2 2) (1 4))
;	((8 7) (7 3) (6 8) (5 2) (4 5) (3 1) (2 6) (1 4))
;	((8 5) (7 3) (6 1) (5 7) (4 2) (3 8) (2 6) (1 4))
;	((8 2) (7 5) (6 7) (5 1) (4 3) (3 8) (2 6) (1 4))
;	((8 3) (7 6) (6 2) (5 5) (4 8) (3 1) (2 7) (1 4))
;	((8 6) (7 1) (6 5) (5 2) (4 8) (3 3) (2 7) (1 4))
;	((8 8) (7 3) (6 1) (5 6) (4 2) (3 5) (2 7) (1 4))
;	((8 2) (7 8) (6 6) (5 1) (4 3) (3 5) (2 7) (1 4))
;	((8 5) (7 7) (6 2) (5 6) (4 3) (3 1) (2 8) (1 4))
;	((8 3) (7 6) (6 2) (5 7) (4 5) (3 1) (2 8) (1 4))
;	((8 6) (7 2) (6 7) (5 1) (4 3) (3 5) (2 8) (1 4))
;	((8 3) (7 7) (6 2) (5 8) (4 6) (3 4) (2 1) (1 5))
;	((8 6) (7 3) (6 7) (5 2) (4 4) (3 8) (2 1) (1 5))
;	((8 4) (7 2) (6 7) (5 3) (4 6) (3 8) (2 1) (1 5))
;	((8 7) (7 1) (6 3) (5 8) (4 6) (3 4) (2 2) (1 5))
;	((8 1) (7 6) (6 8) (5 3) (4 7) (3 4) (2 2) (1 5))
;	((8 3) (7 8) (6 4) (5 7) (4 1) (3 6) (2 2) (1 5))
;	((8 6) (7 3) (6 7) (5 4) (4 1) (3 8) (2 2) (1 5))
;	((8 7) (7 4) (6 2) (5 8) (4 6) (3 1) (2 3) (1 5))
;	((8 4) (7 6) (6 8) (5 2) (4 7) (3 1) (2 3) (1 5))
;	((8 2) (7 6) (6 1) (5 7) (4 4) (3 8) (2 3) (1 5))
;	((8 2) (7 4) (6 6) (5 8) (4 3) (3 1) (2 7) (1 5))
;	((8 3) (7 6) (6 8) (5 2) (4 4) (3 1) (2 7) (1 5))
;	((8 6) (7 3) (6 1) (5 8) (4 4) (3 2) (2 7) (1 5))
;	((8 8) (7 4) (6 1) (5 3) (4 6) (3 2) (2 7) (1 5))
;	((8 4) (7 8) (6 1) (5 3) (4 6) (3 2) (2 7) (1 5))
;	((8 2) (7 6) (6 8) (5 3) (4 1) (3 4) (2 7) (1 5))
;	((8 7) (7 2) (6 6) (5 3) (4 1) (3 4) (2 8) (1 5))
;	((8 3) (7 6) (6 2) (5 7) (4 1) (3 4) (2 8) (1 5))
;	((8 4) (7 7) (6 3) (5 8) (4 2) (3 5) (2 1) (1 6))
;	((8 4) (7 8) (6 5) (5 3) (4 1) (3 7) (2 2) (1 6))
;	((8 3) (7 5) (6 8) (5 4) (4 1) (3 7) (2 2) (1 6))
;	((8 4) (7 2) (6 8) (5 5) (4 7) (3 1) (2 3) (1 6))
;	((8 5) (7 7) (6 2) (5 4) (4 8) (3 1) (2 3) (1 6))
;	((8 7) (7 4) (6 2) (5 5) (4 8) (3 1) (2 3) (1 6))
;	((8 8) (7 2) (6 4) (5 1) (4 7) (3 5) (2 3) (1 6))
;	((8 7) (7 2) (6 4) (5 1) (4 8) (3 5) (2 3) (1 6))
;	((8 5) (7 1) (6 8) (5 4) (4 2) (3 7) (2 3) (1 6))
;	((8 4) (7 1) (6 5) (5 8) (4 2) (3 7) (2 3) (1 6))
;	((8 5) (7 2) (6 8) (5 1) (4 4) (3 7) (2 3) (1 6))
;	((8 3) (7 7) (6 2) (5 8) (4 5) (3 1) (2 4) (1 6))
;	((8 3) (7 1) (6 7) (5 5) (4 8) (3 2) (2 4) (1 6))
;	((8 8) (7 2) (6 5) (5 3) (4 1) (3 7) (2 4) (1 6))
;	((8 3) (7 5) (6 2) (5 8) (4 1) (3 7) (2 4) (1 6))
;	((8 3) (7 5) (6 7) (5 1) (4 4) (3 2) (2 8) (1 6))
;	((8 5) (7 2) (6 4) (5 6) (4 8) (3 3) (2 1) (1 7))
;	((8 6) (7 3) (6 5) (5 8) (4 1) (3 4) (2 2) (1 7))
;	((8 5) (7 8) (6 4) (5 1) (4 3) (3 6) (2 2) (1 7))
;	((8 4) (7 2) (6 5) (5 8) (4 6) (3 1) (2 3) (1 7))
;	((8 4) (7 6) (6 1) (5 5) (4 2) (3 8) (2 3) (1 7))
;	((8 6) (7 3) (6 1) (5 8) (4 5) (3 2) (2 4) (1 7))
;	((8 5) (7 3) (6 1) (5 6) (4 8) (3 2) (2 4) (1 7))
;	((8 4) (7 2) (6 8) (5 6) (4 1) (3 3) (2 5) (1 7))
;	((8 6) (7 3) (6 5) (5 7) (4 1) (3 4) (2 2) (1 8))
;	((8 6) (7 4) (6 7) (5 1) (4 3) (3 5) (2 2) (1 8))
;	((8 4) (7 7) (6 5) (5 2) (4 6) (3 1) (2 3) (1 8))
;	((8 5) (7 7) (6 2) (5 6) (4 3) (3 1) (2 4) (1 8))
;	"  END"