だんだん問題解くのが面倒になってきた。
前準備
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
2.33 (リストの基本関数をaccumulateで書き換え)
(define (%map p sequence) (accumulate (lambda (x y) (cons (p x) y)) '() sequence)) (define (%append seq1 seq2) (accumulate cons seq2 seq1)) (define (%length sequence) (accumulate (lambda (_ l) (+ l 1)) 0 sequence))
2.34 (Horner法)
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms)
(+ (* higher-terms x) this-coeff))
0
coefficient-sequence))
2.35 (count-leaves, accumulate版)
(define (count-leaves t)
(accumulate +
0
(map
(lambda (t)
(if (pair? t)
(+ (count-leaves (list (car t)))
(count-leaves (cdr t)))
1))
t)))
2.36 (複数のリストを取るaccumulate-n)
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
(accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
2.37 (行列・ベクトルの演算)
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
(map (lambda (r) (dot-product r v)) m))
(define (transpose m)
(accumulate-n cons '() m))
(accumulate-n * 1 '((1 2 3) (4 5 6)))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (row)
(map (lambda (col) (accumulate + 0 (map * row col))) cols))
m)))
2.38 (fold-left, fold-right)
省略。
;(fold cons '() (list 1 2 3 4 5)) ; => (5 4 3 2 1) ;(fold-right cons '() (list 1 2 3 4 5)) ; => (1 2 3 4 5)
となることを覚えておくと混乱しないかも。
2.39
(define (reverse sequence) (fold-right (lambda (x y) (append y (list x))) '() sequence)) (define (reverse sequence) (fold-left (lambda (x y) (cons x y)) '() sequence))
2.40
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (unique-pairs n)
(flatmap
(lambda (i)
(map
(lambda (j)
(list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum? (unique-pairs n))))flatmapというのはSRFI-1のappend-map.
2.41
(define (filter predicate sequence)
(cond ((null? sequence) '())
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(define (ordered-triples-of-sum<= n)
(filter (lambda (triple)
(<= (accumulate + 0 triple) n))
(flatmap
(lambda (i)
(flatmap
(lambda (j)
(map
(lambda (k)
(list i j k))
(enumerate-interval (+ j 1) n)))
(enumerate-interval (+ i 1) n)))
(enumerate-interval 1 n))
))
2.42 (8-queens puzzle)
やる気がなくなったので以前読んだときにやっていたのでそれを。Gaucheで
;; Exercise 2.42
;; Eight-queens puzzle
(use srfi-1)
(define empty-board '())
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(append-map
(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 (adjoin-position new-row k rest-of-queens)
(append rest-of-queens (list new-row)))
(define (enumerate-interval interval end)
(if (<= end 0) '()
(append (enumerate-interval interval (- end interval)) (list (- end 1)))))
(define (safe? k positions)
(define (sub-safe? pos positions k)
(if (null? positions) #t
(if (= k 0)
(sub-safe? pos (cdr positions) (- k 1))
(and (not (= pos (car positions)))
(sub-safe? pos (cdr positions) (- k 1))))))
(sub-safe? (list-ref positions (- k 1)) positions (- k 1)))
(define (main args)
(display (queens 8)))8 Queens Problem - ミラクル☆モテメンの脱オタ日記というのもあった。
2.43
新しい場所を一つ仮定するたびに、その右側(左側かもしれない)のクイーンの位置を計算しなおしているのでかなり遅くなる。かかる時間は8^8倍より小さいけどこのくらいのオーダかなぁ(自信なし)。
