2.2.3 集積
SICP/2.2.3.scm at master · cocodrips/SICP
(display "*********2.2.3**********")
(newline)
;; 標準インタフェース
;; 奇数の葉の二乗の合計を計算
(define (sum-odd-squares tree)
(cond
((null? tree) 0)
((not (pair? tree)) (if (odd? tree) (square tree) 0))
(else
(+ (sum-odd-squares (car tree))
(sum-odd-squares (cdr tree))))))
;;by @hioさん
; p.40, 1.2.2 木の再帰
(define (fib n)
(define (iter a b count)
(if
(= count 0)
b
(iter (+ a b) a (- count 1))))
(iter 1 0 n))
;; フィボナッチ数のうち、偶数のものをかえすリストを構築する
(define (even-fibs n)
(define (next k)
(if (> k n)
()
(let ((f (fib k)))
(if
(even? f)
(cons f (next (+ k 1)))
(next (+ k 1))))))
(next 0))
(display (even-fibs 10))
(newline)
;(0 2 8 34)
;; Filter
(define (filter predicate sequence)
(cond
((null? sequence) ())
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(display (filter odd? (list 1 2 3 4 5)))
(newline)
;; 集積 accumulate
(define (accumulate op initial sequence)
(if
(null? sequence)
initial
(op (car sequence) (accumulate op initial (cdr sequence)))))
(display (accumulate + 0 (list 1 2 3 4 5)))(newline)
;15
(display (accumulate * 1 (list 1 2 3 4 5)))(newline)
;120
(display (accumulate cons () (list 1 2 3 4 5)))(newline)
;(1 2 3 4 5)
よくわからなくなるのでメモ：
accumulate
(accumulate f(array[i], 今までのaccumulate結果) 初期値 array)
-> 初期値にmergeされてく
map
(map f(array[i]) array)
-> 配列が返る
2.33
(display "======Ex.2.33======")
(newline)
;練習問題 2.33: 基本的なリスト操作のいくつかを集積として定義
;したものを以下に示す。欠けている式を埋めて、完成させよ。
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) () sequence))
(define (double x)
(* 2 x))
(display (map double (list 1 2 3 4 5)))
(newline)
;(2 4 6 8 10)
(define (append seq1 seq2)
(accumulate cons seq1 seq2))
(display (append (list 1 2 3) (list 4 5 8)))
(newline)
;(4 5 8 1 2 3)
(define (length sequence)
(accumulate (lambda (_ x) (+ x 1)) 0 sequence))
(display (length (list 1 2 3)) )
(newline)
;3
2.34
(display "======Ex.2.34======")
(newline)
(define (horner-eval x coefficient-sequence)
(accumulate
(lambda (this-coeff higher-terms) (+ (* higher-terms x) this-coeff))
0
coefficient-sequence))
(display (horner-eval 2 (list 1 3 0 5 0 1)))
;; 79
Ex 2.35
(display "======Ex.2.35======")
(newline)
(define (count-leaves t)
(accumulate + 0 (map (lambda (x) 1) (enumerate-tree t))))
(define tree (cons (list 1 2) (list 3 4)))
(display (count-leaves tree))
(newline)
; 4
(define tree (cons (list 1 2) (list 3 4 5)))
(display (count-leaves tree))
(newline)
;5
@hioさんの実装｜再帰的に足してく
(define (count-leaves t)
(accumulate
+
0
(map
(lambda (x)
(if
(pair? x)
(count-leaves x)
1))
t)))
Ex 2.36
(display "======Ex.2.36======")
(newline)
(define (accumulate-n op init seqs)
(if (null? (car seqs))
nil
(cons (accumulate op init (map car seqs)) (accumulate-n op init (map cdr seqs)))))
(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
(display (accumulate-n + 0 s))
Ex 2.37
(display "======Ex.2.37======")
(newline)
;(define (map proc items)
; (if (null? items)
; nil
; (cons (proc (car items)) (map proc (cdr items)))))
(define (dot-product v w)
(accumulate + 0 (_map * v w)))
(define m1 (list (list 1 2 3 4) (list 4 5 6 7)))
(define v1 (list 1 2))
(define v2 (list 10 20))
(display (dot-product v1 v2))
(newline)
;50
(define (matrix-*-vector m v)
(_map (lambda (m_i) (dot-product m_i v)) m)) ;; By @hioさん
(display (matrix-*-vector m1 v2))
(newline)
;(50 140)
(define (transpose mat)
(accumulate-n cons nil mat))
(display (transpose m1))
(newline)
;((1 4) (2 5) (3 6) (4 7))
;(define (matrix-*-matrix m n)
;(let ((cols (transpose n)))
;(map ⟨??⟩ m)))
;cols???
Ex 2.38
(display "======Ex.2.38======")
(newline)
;練習問題 2.38: accumulate 手続きは、列の最初の要素と、右の
;すべての要素を組み合わせた結果とを組み合わせるため、foldright
;としても知られている。fold-left というものもあり、これ
;は fold-right に似ているが、要素の組み合わせを逆方向に行うと
;いう点が違う。
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence) (accumulate op initial (cdr sequence)))))
(define fold-right accumulate)
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter initial sequence))
(display (fold-right / 1 (list 1 2 3))) (newline)
; (/ 1 (/ 2 (/ 3 1)))
; 2 / 3
(display (fold-left / 1 (list 1 2 3))) (newline)
; (/ (/ (/ 1 2) 2 ) 3)
(display (fold-right list nil (list 1 2 3)))(newline)
;(1 (2 (3 ())))
(display (fold-left list nil (list 1 2 3))) (newline)
;(((() 1) 2) 3)
;; 可換な演算ならright/fold-leftで結果がおなじになる
Ex 2.39
(display "======Ex.2.39======")
(newline)
;練習問題 2.39: 以下の reverse(練習問題 2.18) 手続きの定義を、練
;習問題 2.38の fold-right と fold-left によって完成させよ。
(define (reverse sequence)
(fold-right (lambda (x y) (append (list x) y)) (list) sequence))
(define l (list 1 3 5))
(display (reverse l))
(newline)
;(5 3 1)
(define (reverse sequence)
(fold-left (lambda (x y) (cons y x)) nil sequence))
(display (reverse l))
(newline)
;(5 3 1)
マップのネスト
;; マップのネスト
(define (enumerate-interval low high)
(if
(> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
(display (enumerate-interval 2 7))
(newline)
(define n 3)
(display (accumulate
append nil (map (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))
(newline)
;((3 1) (3 2) (2 1))
(load "../1.2/smallest-divisor.scm")
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
;; [proc(seq[0]), proc(seq[1]) .....] みたいなのが出来る？
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum? (flatmap
(lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))))
(display (prime-sum-pairs 3))
(newline)
;((3 2 5) (2 1 3))
Ex 2.40
(display "======Ex.2.40======")
(newline)
;整数 n に対し、1 ≤ j < i ≤ n となるペア (i, j) の
;列を生成する手続き unique-pairs を定義せよ。unique-pairs を
;使って上の prime-sum-pairs の定義を簡単にせよ。
;; 自分の
(define (unique-pairs n)
(define (itr base i stack)
;(print base ":" i "\n")
(cond
((>= base n) stack)
((> i n) (itr (+ base 1) (+ base 2) stack))
(else (itr base (+ i 1) (cons (list base i) stack)))))
(itr 1 2 nil))
(display (unique-pairs 4))
(newline)
;((3 4) (2 4) (2 3) (1 4) (1 3) (1 2))
;(define (accumulate op initial sequence)
(define (prime-sum-pairs n)
(accumulate
(lambda (i acc)
(if (prime? (+ (car i) (car (cdr i))))
(cons i acc)
acc))
nil
(unique-pairs n)))
(display (prime-sum-pairs 3))
(newline)
;((2 3) (1 2))
;; hioさんの
;(define (unique-pairs n)
; (flatmap
; (lambda (i)
; (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1))))
; (enumerate-interval 1 n)
; )
;)
;(display (unique-pairs 4))
;(newline)
;((4 1) (4 2) (4 3) (3 1) (3 2) (2 1))
;2.41が小さい順にならんでいるというのが条件として満たさないと
;正しい挙動をしない実装をしてしまったため、コメントアウト
Ex 2.41
(display "======Ex.2.41======")
(newline)
;ある整数 n 以下の異なる正の整数が大小順に並ん
;だ三つ組 i, j, k の中で、合計がある整数 s となるものすべてを見
;つける手続きを書け。
(define (first p) (car p))
(define (second p) (car (cdr p)))
(define (unique-tri n s)
(define (add-pattern p stack)
(define (itr p i stack)
;(print p i stack)
(cond
((> i n) stack)
((>= (second p) i) (itr p (+ i 1) stack))
((> (second p) n) stack)
(else
(if
(= (+ (first p) (second p) i) s)
(itr p (+ i 1) (cons (list (first p) (second p) i) stack))
stack))
)
)
(itr p 1 stack)
)
(accumulate
add-pattern
nil
(unique-pairs n))
)
(display "わたしの:")
(display (unique-tri 5 10))(newline)
;わたしの:((1 4 5))
;全ペア((3 4 5) (2 4 5) (2 3 5) (2 3 4) (1 4 5) (1 3 5) (1 3 4) (1 2 5) (1 2 4) (1 2 3))
(display "hioさんの:")
(define (unique-triples n)
(flatmap
(lambda (i)
(flatmap
(lambda (j)
(map
(lambda (k)
(list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(display (unique-triples 5))
(newline)
;hioさんの:((5 4 1) (5 4 2) (5 4 3) (5 3 1) (5 3 2) (5 2 1) (4 3 1) (4 3 2) (4 2 1) (3 2 1))
; なるほど、こういうことなのね；； 納得；；
Ex2.42
8Queen
(display "======Ex.2.42======")
(newline)
(define (make-position row col)
(cons row col))
(define (position-row position)
(car position))
(define (position-col position)
(cdr position))
(define empty-board nil)
(define (queens board-size)
(define (queen-cols col)
;(print col)
(if (= col 0)
(list empty-board)
(filter
(lambda (positions) (safe? col positions))
(flatmap
(lambda (rest-of-queens)
(map
(lambda (new-row) (adjoin-position new-row col rest-of-queens)) ;;kだけbitかけたやつをかえすかんじ？
(enumerate-interval 1 board-size) ; [1...k]
))
(queen-cols (- col 1))))))
(queen-cols board-size))
(define (safe? col positions)
(let ((kth-queen (list-ref positions (- col 1)))
(other-queens (filter (lambda (q)
(not (= col (position-col q))))
positions)))
(define (valid-position? p1 p2)
;(print "valid-position:" p1 p2)
(not (or
(= (position-row p1) (position-row p2))
(= (position-col p1) (position-col p2))
(=
(abs (- (position-row p1) (position-col p1)))
(abs (- (position-row p2) (position-col p2)))))))
(define (iter queen-position board)
(or (null? board)
(and (valid-position? queen-position (car board))
(iter queen-position (cdr board)))))
(iter kth-queen other-queens))
)
(define (adjoin-position row col positions)
(append (list (make-position row col)) positions))
(display (queens 0))
(newline)
(display (queens 4))
(newline)
;(((4 . 1) (1 . 2) (3 . 3) (2 . 4)) ((4 . 1) (2 . 2) (1 . 3) (3 . 4)) ((3 . 1) (2 . 2) (4 . 3) (1 . 4)) ((2 . 1) (4 . 2) (3 . 3) (1 . 4)))
(display (queens 5))
(newline)
;(((3 . 1) (5 . 2) (2 . 3) (4 . 4) (1 . 5)) ((4 . 1) (2 . 2) (5 . 3) (3 . 4) (1 . 5)) ((5 . 1) (3 . 2) (1 . 3) (4 . 4) (2 . 5)) ((5 . 1) (2 . 2) (4 . 3) (1 . 4) (3 . 5)))
http://www.billthelizard.com/2011/06/sicp-242-243-n-queens-problem.htmlを参考にしつつ・・・。
2.42 やりなおし
Schemeで考えると難しいのでとりあえずまずPythonでかいた
class QueenN():
def __init__(self):
pass
def create(self, n):
boards = [[-1] * n]
for row in range(n):
boards = self.add_row(row, n, boards)
print n, "Pattern:", len(boards)
for board in boards:
for col in board:
for i in xrange(n):
if i == col:
print "Q",
else:
print "_",
print
print
def add_row(self, row, n, boards):
next_boards = []
for board in boards:
for col in range(n):
array = board[:]
if self.is_safe(board, row, col):
array[row] = col
next_boards.append(array)
return next_boards
def is_safe(self, board, row, col):
# cols
if col in board:
return False
# x
for i in range(row):
if (i - board[i]) == (row - col):
return False
if abs(board[i] + i) == (row + col):
return False
return True
if __name__ == '__main__':
queen = QueenN()
for i in range(3, 9):
queen.create(i)
上をふまえて書き直し
;; 2016/10/19 #24
(newline)
(print "===Ex 2.42 もういっかい===")
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions)) ;; 渡ってきたboardが正しい配置か
(flatmap ;; 全列挙して、↑を満たすものだけ残す
(lambda (rest-of-queens)
(map
(lambda (new-row)
(adjoin-position
new-row k rest-of-queens)) ;; 新しい列に[1..8]を追加して、みる
(enumerate-interval 1 board-size) ;; [1..8]
)) ;;
(queen-cols (- k 1)))))) ;;はじめは()
(queen-cols board-size))
(define empty-board nil)
(define (safe? row positions)
;(print "safe?" positions)
(and
(not (same-col? row positions))
(not (slash? row positions))
)
)
(define (adjoin-position new-row k rest-of-queens) (append (list new-row) rest-of-queens))
; 同じ列にないか
(define (same-col? row positions)
(accumulate
(lambda (i acc) (or acc (= (list-ref positions (- row 1)) (list-ref positions i))))
#f
(enumerate-interval 0 (- row 2))
))
(define (test-same-col?)
(print "--test (same-col? 3 (list 1 3 3)) #t")
(print (same-col? 3 (list 1 3 3)))
(print "--test (same-col? 3 (list 1 3 5)) #f")
(print (same-col? 3 (list 1 3 5)))
)
(test-same-col?)
;右斜にないか
(define (slash? row positions)
;(print (- row 1) "," (list-ref positions (- row 1)))
(accumulate
(lambda
(i acc)
;(print i acc)
;(print i " " (list-ref positions i) " "
; " " acc " " (+ (- row 1) (list-ref positions (- row 1))) "=" (+ i (list-ref positions i))
; "," (- (- row 1) (list-ref positions (- row 1))) "=" (- i (list-ref positions i)))
(or
acc
(=
(+ (- row 1) (list-ref positions (- row 1))) ;; <- list-ref使うと遅い 順番にindexごと確認してくほうが早い
(+ i (list-ref positions i))
)
(=
(- (- row 1) (list-ref positions (- row 1)))
(- i (list-ref positions i))
)
)
)
#f
(enumerate-interval 0 (- row 2)))
)
(define (test-slash?)
(print "--test (slash? 3 (list 3 2 1)) #t")
(print (slash? 3 (list 3 2 1)))
(print "--test (slash? 3 (list 5 3 1)) #f")
(print (slash? 3 (list 5 3 1)))
(print "--test (slash? 2 (list 1 2)) #t")
(print (slash? 2 (list 1 2)))
(print "--test (slash? 2 (list 1 3)) #f")
(print (slash? 2 (list 1 3)))
(print "--test (slash? 3 (list 2 4 3)) #t")
(print (slash? 3 (list 2 4 3)))
)
(test-slash?)
;--test (same-col? 3 (list 1 3 3)) #t
;#t
;--test (same-col? 3 (list 1 3 5)) #f
;#f
;--test (slash? 3 (list 3 2 1)) #t
;#t
;--test (slash? 3 (list 5 3 1)) #f
;#f
;--test (slash? 2 (list 1 2)) #t
;#t
;--test (slash? 2 (list 1 3)) #f
;#f
;--test (slash? 3 (list 2 4 3)) #t
;#t
(define (test-nqueen?)
(print "1-queens: " (length (queens 1)))
(print "4-queens: " (length (queens 4)))
(print "8-queens: " (length (queens 8)))
)
(test-nqueen?)
;1-queens: 1
;4-queens: 2
;8-queens: 92
(time (length (queens 8)))
(time (length (queens 9)))
;(time (length (queens 8)))
; real 0.777
; user 1.030
; sys 0.020
;(time (length (queens 9)))
; real 14.940
; user 21.090
; sys 0.470
;; 遅い原因はlist-ref?
Ex 2.43
新しく追加された行だけでなく、毎回全てのボードの中身をチェックしてるから。