SICP読書女子会 2.2.3 (#21,22,23,24)

  • 0
    Like
  • 0
    Comment

    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

    新しく追加された行だけでなく、毎回全てのボードの中身をチェックしてるから。