1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2016-09-14

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

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

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?