Xperia Z5 Compact タッチ不具合

まずは、何も言わず以下の動画を見てくれ。


Xperia Z5 Compact タッチ不具合

動画にあるとおり、昨日機種変更したXperia Z5 Compactにタッチパネルの不具合がある。

どうも、以下の不具合にぶつかった模様。

Xperia Z5 Compactのタッチパネル不具合、原因はアース不良による「漏電」? | スマホ評価・不具合ニュース

リンク先のタイトルにもある漏電を疑い、色々試してみた結果をまとめておく。

発生条件

木製の机の上で、本体を持たずに操作すると、画面の大部分が反応しない。(一部は反応する)

発生しない条件

机の上でも、以下の条件に合えば上記事象は発現しない

充電する

充電中は、机に置いておいても操作可能。

手で持つ

机の上に置いた状態で、本体に手を添えて操作すると操作できる

アルミホイルの上に置く

アルミホイルの上に置くと、手で触らずとも操作できる。
ただし、ある程度の大きさがないとダメ。
あるいは、小さなアルミホイルを置いて、それに手を添えても操作できる。

どれにも共通するのは、本体が何らかの形(充電ケーブル、手、アルミホイル)で接地されていること。
というわけで、漏電?あるいは接地不良で、タッチパネルの静電気をうまく扱えていないのが原因に見える。

暫定対処策

明日にでもドコモショップ初期不良としてねじ込む予定だが、とりあえずの回避策を考えてみる。

回避策

とにかく、何らかの方法で本体を接地できれば良いようなので、アルミホイルを使って試してみることにした。

最初は、ケースの裏全体にアルミホイルを貼り付けてみたが、うまくゆかず。どうも、ちゃんと接地しきれないらしい。 そこで、アルミホイルの切れ端をスマホスマホケースで挟み、簡単なアースを作ることにした。

f:id:linus404:20160221221039j:plain

こうすると、机に置いているとき自然にアースと指が触れるので、接地されて操作が可能となる。
ちょっと不格好だが、とりあえずドコモショップに持ち込んでみるまではこれで対処しようと思う。

f:id:linus404:20160221221103j:plain

なお、現在ソフトウェアアップデートをDL中なので、もしかしたらそれで解決して終わり・・・かもしれない。
(どう見てもハードウェア要因なので、余り期待はしていないが)

SICP 演習問題 2.2

2.17

#lang Racket
(define (last-pair items)
  (if (null? (cdr items))
      (car items)
      (last-pair (cdr items))))

2.18

繰り返し

(define (reverse items)
  (define (iter items result)
    (if (null? items)
        result
        (iter (cdr items) (cons (car items) result))))
  (iter items (list)))

再帰

(define (reverse items)
  (if (null? items)
      (list)
      (append (reverse (cdr items)) (list (car items)))))

2.19

#lang racket

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else (+ (cc amount (except-first-denomination coin-values))
                 (cc (- amount
                        (first-denomination coin-values))
                     coin-values)))))

(define (no-more? coin-values) (null? coin-values))
(define (except-first-denomination coin-values)
  (define (iter coin-values result max)
    (if (null? coin-values)
        result
        (let ((tmp (car coin-values)))
          (if (> tmp max)
             (iter (cdr coin-values) (cons max result) tmp)
             (iter (cdr coin-values) (cons tmp result) max)))))
  (iter (cdr coin-values) (list) (car coin-values) ))

(define (first-denomination coin-values)
  (define (iter coin-values max)
    (if (null? coin-values)
        max
        (let ((tmp (car coin-values)))
          (if (> tmp max)
            (iter (cdr coin-values) tmp)
            (iter (cdr coin-values) max)))))
  (iter (cdr coin-values) (car coin-values)))

上記実装では、リスト coin-valuesの順は, ccの答に影響しない。

理由
first-denomination、except-first-denominationが、 リスト順に関係なく、常に最大のコインを対象とするように実装しているため。

2.20

#lang racket
(define (same-parity a . b)
  (let ((parity (remainder a 2)))
    (define (iter rest result)
      (if (null? rest)
          result
          (if (= (remainder (car rest) 2) parity)
              (iter (cdr rest) (cons  (car rest) result))
              (iter (cdr rest) result))))
    (reverse (iter b (list)))))

2.21

#lang Racket

(define nil (list))
(define (square x) (* x x))

(define (square-list1 items)
  (if (null? items)
      nil
      (cons (square (car items)) (square-list1 (cdr items)))))

(define (square-list2 items)
  (map (lambda (x) (square x)) items))

2.22

cons は第1引数がリストだと、 carにリスト、cdrに末尾要素への参照が入ってしまうため、 出力が1つのリストにならない。

(cons '(1 2) 3)
; => '((1 2) . 3)

他方、第1引数が非リスト、第2引数がリストの場合は、 carに先頭要素、cdrにリストへの参照が入るため、 1つのリストとして出力される。

(cons 1 '(2 3))
; => '(1 2 3)

問題のprogramは、consの第1引数 answerがリストになるため、正しく動作しない。

以下のように、cons を append にしたら、正しく動く

(define (square-list4 items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things)
              (append answer
                    (list (square (car things)))))))
  (iter items nil))

2.23

(define (for-each proc list)
  (cond ((null? list) #t)
        (else (proc (car list))
              (for-each proc (cdr list)))))

2.24

2.25

(cdr (car (cdr (car (cdr (cdr '(1 3 '(5 7) 9)))))))
(car(cdr(car'('(7)))))
(cdr (car (cdr (car (cdr (car (cdr
  (car (cdr (car (cdr (car (cdr
    (car (cdr (car (cdr (car (cdr
      (car (cdr
        '(1 '(2 '(3 '(4 '(5 '(6 7)))))))))))))))))))))))))))

2,26

(define x (list 1 2 3))
(define y (list 4 5 6))

(append x y)
; => '(1 2 3 4 5 6)
(cons x y)
; => '((1 2 3) 4 5 6)
(list x y)
; => '((1 2 3) (4 5 6))

2.27

(define (deep-reverse items)
  (if (pair? items)
          (append
            (deep-reverse (cdr items))
            (list (deep-reverse (car items))))
          items))

2.28

(define nil (list))
(define (fringe lst)
  (if (null? lst)
      nil
      (let ((first (car lst)))
        (if (pair? first)
                 (append (fringe first) (fringe (cdr lst)))
                 (append (list first) (fringe (cdr lst)))))))

2.29 a-c

#lang Racket
(define (make-mobile left right) (list left right))
(define (make-branch length structure) (list length structure))

; 29a
(define (left-branch m) (car m))
(define (right-branch m) (car (cdr m)))
(define (branch-length b) (car b))
(define (branch-structure b) (car (cdr b)))

; 29b
(define (total-weight m)
  (if (pair? m)
      (+ (total-weight (branch-structure (left-branch m)))
         (total-weight (branch-structure (right-branch m))))
    m))

; 29c
(define (balanced? m)
  (if (pair? m)
    (let ((left-st (branch-structure (left-branch m)))
          (left-len (branch-length (left-branch m)))
          (right-st (branch-structure (right-branch m)))
          (right-len (branch-length (right-branch m))))
      (and
        (= (* left-len (total-weight left-st))
           (* right-len (total-weight right-st)))
        (balanced? left-st)
        (balanced? right-st)))
    #t))

2.29d

アクセッサーを変えればOK(ここが抽象化の壁として機能する)

(define (right-branch m) (cdr m))
(define (branch-structure b) (cdr b))

2.30

#lang racket

(define nil '())

(define (square-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (* tree tree))
        (else (cons (square-tree (car tree))
                    (square-tree (cdr tree))))))

(define (square-tree2 tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree2 sub-tree)
             (* sub-tree sub-tree)))
       tree))
   
(define (map proc items)
  (if (null? items) nil
      (cons (proc (car items))
            (map proc (cdr items)))))

2.31

#lang racket

(define nil '())

(define (square-tree tree)
  (tree-map square tree))

(define (tree-map proc tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (proc tree))
        (else (cons (tree-map proc (car tree))
                    (tree-map proc (cdr tree))))))
(define (square x) (* x x))

2.32

(define (subsets s)
  (if (null? s)
      (list nil)
      (let ((rest (subsets (cdr s))))
        (append rest
                (map
                  (lambda (x)
                    (cons (car s) x))
                  rest))))

2.33

#lang racket

(define nil (list))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (map p sequence)
  (accumulate
   (lambda (x y)
    (cons (p x) y))
   nil
   sequence))

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length sequence)
  (accumulate
   (lambda (x y) (+ 1 y))
   0
   sequence))

(define lst (list 1 2 3 4))
(define lst2 (list 5 6 7 8))
(define (square x) (* x x))

(map square lst)
(append lst lst2)
(length lst)

2.34

#lang racket

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define  (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ (* higher-terms x)
                   this-coeff))
              0
              coefficient-sequence))

2.35

#lang racket

(define nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (map p sequence)
  (accumulate
   (lambda (x y)
    (cons (p x) y))
   nil
   sequence))

(define (fringe lst)
  (if (null? lst)
      nil
      (let ((first (car lst)))
        (if (pair? first)
                 (append (fringe first) (fringe (cdr lst)))
                 (append (list first) (fringe (cdr lst)))))))

(define (count-leaves t)
  (accumulate +
              0
              (map (lambda (x) 1) (fringe t))))

2.36

#lang racket
(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 nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (map p sequence)
  (accumulate
   (lambda (x y)
    (cons (p x) y))
   nil
   sequence))

(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
(accumulate-n + 0 s)

2.37

#lang Racket

; Σ v_i w_i
(define (dot-product v w)
  (accumulate + 0 (map * v w)))

; t_i = Σ m_ij v_j
(define (matrix-*-vector m v)
  (map (lambda (m_i) (dot-product m_i v)) m ))

(define (transpose mat)
  (accumulate-n cons nil mat))

;p_ij = Σ m_ik n_kj
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map
      (lambda (m_i)
        (map
          (lambda (n_j) (dot-product m_i n_j))
          cols))
      m)))

(define nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(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 (map p sequence)
  (accumulate
   (lambda (x y)
    (cons (p x) y))
   nil
   sequence))

2.38

(fold-right / 1 (list 1 2 3))
;-> 3/2
(fold-left / 1 (list 1 2 3))
;-> 1/6
(fold-right list nil (list 1 2 3))
;-> '(1 (2 (3 ())))
(fold-left list nil (list 1 2 3))
;-> '(((() 1) 2) 3)

等価となる条件は
(op a b) と (op b a) の結果が等しいこと(交換法則)

2.39

(define (reverse-right sequence)
  (fold-right
    (lambda (x y) (append y (list x) ))
    nil
    sequence))

(define (reverse-left sequence)
  (fold-left
    (lambda (x y) (cons y x ))
    nil
    sequence))

2.40

#lang racket
(require math/number-theory)

(define (uniq-pair n)
  (filter prime-sum?
     (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 (uniq-pair n)))

(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

;accumulate
(define nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))
;map
(define (map p sequence)
  (accumulate
    (lambda (x y) (cons (p x) y)) nil sequence))

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

2.41

#lang racket
(require math/number-theory)

; 0<i<j<k=<n
; i+j+k=s

(define (uniq-triple 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)))

(define (sum-triple seq)
  (+ (car seq) (cadr seq) (caddr seq)))

(define (find-s-triple n s)
  (define (s-sum? seq)
    (if (= s (sum-triple seq)) #t #f))
  (filter s-sum? (uniq-triple n)))
   
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

;accumulate
(define nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))
;map
(define (map p sequence)
  (accumulate
    (lambda (x y) (cons (p x) y)) nil sequence))

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

(uniq-triple 10)
(find-s-triple 10 10)

2.42

#lang racket

(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))

;queenの置き方
;queenの置かれた座標のリストとして定義.
;第1要素は今おいたクイーンとする
;((k col_k) (k-1 col_k-1) ... (1 col_1))
(define empty-board '())
(define (adjoin-position new-row k rest-of-queens)
  (cons (cons k new-row) rest-of-queens))

;safe
;考慮すべき条件は以下の2パターン
;同じcolに存在 (col_k = col_i) 
;斜めに存在 (col_k=col_i+(k-i) or col_k=col_i-(k-i) )
(define (safe? k positions)
  (let ((k-queen (car positions)))
    (define (iter rest-pos)
      (if (null? rest-pos)
       #t
       (let ((i-queen (car rest-pos)))
        (if (or (= (cdr k-queen) (cdr i-queen))
                (= (cdr k-queen)
                   (+ (cdr i-queen) (- (car k-queen) (car i-queen))))
                (= (cdr k-queen)
                   (- (cdr i-queen) (- (car k-queen) (car i-queen)))))
            #f
            (iter (cdr rest-pos))))))
    (iter (cdr positions))))

(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))
(define nil (list))
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))
(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) nil sequence))
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

2.43

2.42のflatmap

 (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))))))

Louisのflatmap

(flatmap
 (lambda (new-row)
   (map (lambda (rest-of-queens)
          (adjoin-position new-row k rest-of-queens))
        (queen-cols (- k 1))))
 (enumerate-interval 1 board-size))

2.42 は kが増える都度、(queen-cols (- k 1) のフィルタされた結果に対して適用するのに対して、 Louisは 毎回すべてのアイテムに対して適用を行うため、効率が悪い。

毎回board-size回の適用が必要になるため、結果 board-sizeboard-size 回の不要な演算が必要になる。

2.42の演算回数を T(board-size)とすると、Loiusの場合はT(board-sizeboard-size)となる。

2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

2.45

#lang racket
(require sicp-pict)

;new definition
(define (split first-ope second-ope)
  (define (iter painter n)
    (if (= n 0)
        painter
        (let ((smaller (iter painter (- n 1))))
          (first-ope painter (second-ope smaller smaller)))))
  iter)

(define right-split2 (split beside below))
(define up-split2 (split below beside))

;old definition
(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

;test
(paint (right-split einstein 3))
(paint (right-split2 einstein 3))

(paint (up-split einstein 3))
(paint (up-split2 einstein 3))

2.46

(define (make-vect2 xcor ycor) (cons xcor ycor))

(define (xcor-vect vect) (car vect))
(define (ycor-vect vect) (cdr vect))

(define (add-vect v1 v2)
  (make-vect2 (+ (xcor-vect v1) (xcor-vect v2))
              (+ (ycor-vect v1) (ycor-vect v2))))

(define (sub-vect v1 v2)
  (make-vect2 (- (xcor-vect v1) (xcor-vect v2))
              (- (ycor-vect v1) (ycor-vect v2))))

(define (scale-vect scala vect)
  (make-vect2 (* scala (xcor-vect vect))
              (* scala (ycor-vect vect))))

2.47

;1つめ
(define (make-frame1 origin edge1 edge2)
  (list origin edge1 edge2))

(define (origin-frame1 frame) (car frame))
(define (edge1-frame1 frame) (cadr frame))
(define (edge2-frame1 frame) (caddr frame))


;2つめ
(define (make-frame2 origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

(define (origin-frame2 frame) (car frame))
(define (edge1-frame2 frame) (cadr frame))
(define (edge2-frame2 frame) (cddr frame))

2.48

;segment
(define (make-segment2 start end) (cons start end))
(define (segment-start2 segment) (car segment))
(define (segment-end2 segment) (cdr segment))

2.49

#lang Racket
(require sicp-pict)

;a
(define (frame->painter frame)
  (let ((origin (frame-origin frame))
        (edge1 (frame-edge1 frame))
        (edge2 (frame-edge2 frame))
        (end (vector-sub (vector-add (frame-edge1 frame) (frame-edge2 frame))
                         (frame-origin frame))))
    (segments->painter
      (list
        (make-segment origin edge1)
        (make-segment origin edge2)
        (make-segment edge1 end)
        (make-segment edge2 end)))))

;b
(define (x-frame->painter frame)
  (let ((origin (frame-origin frame))
        (edge1 (frame-edge1 frame))
        (edge2 (frame-edge2 frame))
        (end (vector-sub (vector-add (frame-edge1 frame) (frame-edge2 frame))
                         (frame-origin frame))))
    (segments->painter
      (list
        (make-segment origin end)
        (make-segment edge1 edge2)))))

;c
;frameの頂点ではなく菱型の各頂点を規定する
(define (mid-frame->painter frame)
  (let ((org-edge1
         (vector-scale 0.5
           (vector-add (frame-origin frame)
                       (frame-edge1 frame))))
        (org-edge2
         (vector-scale 0.5
           (vector-add (frame-origin frame)
                       (frame-edge2 frame))))
        (end-edge1
         (vector-scale 0.5
           (vector-add (vector-sub
                         (vector-add (frame-edge1 frame) (frame-edge2 frame))
                         (frame-origin frame))
                       (frame-edge1 frame))))
        (end-edge2
                  (vector-scale 0.5
           (vector-add (vector-sub
                         (vector-add (frame-edge1 frame) (frame-edge2 frame))
                         (frame-origin frame))
                       (frame-edge2 frame)))))
    (segments->painter
      (list
        (make-segment org-edge1 org-edge2)
        (make-segment org-edge1 end-edge1)
        (make-segment org-edge2 end-edge2)
        (make-segment end-edge1 end-edge2)))))
;wave
(define (points->segments points)
  (if (null? (cdr points))
      '()
      (let ((p1 (car points))
            (p2 (cadr points))))
        (cons (make-segment (make-vect (car p1) (cadr p1))
                            (make-vect (car p2) (cadr p2)))
              (points->segments (cdr points))))))

(define wave
  (let ((wp1 '((0.25 0)
               (0.34 0.4)
               (0.35 0.58)
               (0.16 0.5)
               (0 0.68)))
        (wp2 '((0 0.78)
               (0.16 0.61)
               (0.30 0.7)
               (0.42 0.69)
               (0.35 0.82)
               (0.42 1)))
        (wp3 '((0.58 1)
               (0.65 0.82)
               (0.58 0.69)
               (0.70 0.7)
               (0.84 0.61)
               (1.0 0.32)))
        (wp4 '((0.75 0)
               (0.66 0.4)
               (0.65 0.58)
               (0.80 0.5)
               (1.0 0.22)))
        (wp5 '((0.37 0)
               (0.5 0.35)
               (0.63 0))))
    (segments->painter (append-map points->segments
                                   (list wp1 wp2 wp3 wp4 wp5)))))

2.50

#lang Racket
(require sicp-pict)

(define (flip-horiz2 painter)
  ((transform-painter
    (make-vect 1.0 0.0)
    (make-vect 0.0 0.0)
    (make-vect 1.0 1.0))
  painter))

(define (rotate1802 painter)
  ((transform-painter
    (make-vect 1.0 1.0)
    (make-vect 0.0 1.0)
    (make-vect 1.0 0.0))
   painter))
    

(define (rotate2702 painter)
  (rotate180 (rotate90 painter)))

本文のtransform-paintersicp-pictのtransfrom-painterは定義が異なる。 上記は、sicp-pict似合わせた実装。

2.51

(define (below2 painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-bottom
           ((transform-painter
              (make-vect 0.0 0.0)
              (make-vect 1.0 0.0)
              split-point)
            painter1))
          (paint-up
           ((transform-painter
              split-point
              (make-vect 1.0 0.5)
              (make-vect 0.0 1.0))
            painter2)))
      (lambda (frame)
        (paint-bottom frame)
        (paint-up frame)))))

(define (below3 painter1 painter2)
  (rotate270
   (beside
    (rotate90 painter2)
    (rotate90 painter1))))
    

2.52

a

#lang racket
(require sicp-pict)

(define (points->segments points)
  (if (null? (cdr points))
      '()
      (let ((p1 (car points))
            (p2 (car (cdr points))))
        (cons (make-segment (make-vect (car p1) (car (cdr p1)))
                            (make-vect (car p2) (car (cdr p2))))
              (points->segments (cdr points))))))

(define wave
  (let ((wp1 '((0.25 0)
               (0.34 0.4)
               (0.35 0.58)
               (0.16 0.5)
               (0 0.68)))
        (wp2 '((0 0.78)
               (0.16 0.61)
               (0.30 0.7)
               (0.42 0.69)
               (0.35 0.82)
               (0.42 1)))
        (wp3 '((0.58 1)
               (0.65 0.82)
               (0.58 0.69)
               (0.70 0.7)
               (0.84 0.61)
               (1.0 0.32)))
        (wp4 '((0.75 0)
               (0.66 0.4)
               (0.65 0.58)
               (0.80 0.5)
               (1.0 0.22)))
        (wp5 '((0.37 0)
               (0.5 0.35)
               (0.63 0))))
    (segments->painter (append-map points->segments
                                   (list wp1 wp2 wp3 wp4 wp5)))))

(define left
  (let ((eye '((0.40 0.84)
                (0.43 0.88)
                (0.47 0.84)))
        (mouth '((0.46 0.74)
                 (0.5 0.70))))
    (segments->painter (append-map points->segments
                                   (list eye mouth)))))
(define right (flip-horiz left))
                            
(define (smiled-wave frame)
  (left frame)
  (right frame)
  (wave frame))

;test
(paint smiled-wave)

b

和田先生訳がよくわからなかったので以下のように解釈。

b.Change the pattern constructed by corner-split (for example, by using only one copy of the up-split and right-split images instead of two).

corner-splitが描くパターンを変更せよ。 例)up-splitとright-splitが描くイメージを2つずつではなく1つずつだけ使用する)

#lang racket
(require sicp-pict)

(define (corner-split2 painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((corner (corner-split2 painter (- n 1))))
          (beside (below painter up)
                  (below right corner))))))

;helper

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

;wave
(define (points->segments points)
  (if (null? (cdr points))
      '()
      (let ((p1 (car points))
            (p2 (car (cdr points))))
        (cons (make-segment (make-vect (car p1) (car (cdr p1)))
                            (make-vect (car p2) (car (cdr p2))))
              (points->segments (cdr points))))))

(define wave
  (let ((wp1 '((0.25 0)
               (0.34 0.4)
               (0.35 0.58)
               (0.16 0.5)
               (0 0.68)))
        (wp2 '((0 0.78)
               (0.16 0.61)
               (0.30 0.7)
               (0.42 0.69)
               (0.35 0.82)
               (0.42 1)))
        (wp3 '((0.58 1)
               (0.65 0.82)
               (0.58 0.69)
               (0.70 0.7)
               (0.84 0.61)
               (1.0 0.32)))
        (wp4 '((0.75 0)
               (0.66 0.4)
               (0.65 0.58)
               (0.80 0.5)
               (1.0 0.22)))
        (wp5 '((0.37 0)
               (0.5 0.35)
               (0.63 0))))
    (segments->painter (append-map points->segments
                                   (list wp1 wp2 wp3 wp4 wp5)))))

(define left
  (let ((eye '((0.40 0.84)
                (0.43 0.88)
                (0.47 0.84)))
        (mouth '((0.46 0.74)
                 (0.5 0.70))))
    (segments->painter (append-map points->segments
                                   (list eye mouth)))))
(define right (flip-horiz left))
                            
(define (smiled-wave frame)
  (left frame)
  (right frame)
  (wave frame))

;test
(paint (corner-split2 smiled-wave 2))

c

c.Modify the version of square-limit that uses square-of-four so as to assemble the corners in a different pattern. (For example, you might make the big Mr. Rogers look outward from each corner of the square.)

square-limit (square-of-four使う版)が違う絵を描くように変更しろ。 (例: 一番大きいMrRogerの絵が四角の四隅に配置されるようにする)

#lang racket
(require sicp-pict)

(define (square-limit2 painter n)
  (let ((combine4 (square-of-four flip-vert rotate180
                                  identity flip-horiz)))
    (combine4 (corner-split2 painter n))))


;helper

(define (square-of-four tl tr bl br)
  (lambda (painter)
    (let ((top (beside (tl painter) (tr painter)))
          (bottom (beside (bl painter) (br painter))))
      (below bottom top))))

(define (corner-split2 painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((corner (corner-split2 painter (- n 1))))
          (beside (below painter up)
                  (below right corner))))))

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

;wave
(define (points->segments points)
  (if (null? (cdr points))
      '()
      (let ((p1 (car points))
            (p2 (car (cdr points))))
        (cons (make-segment (make-vect (car p1) (car (cdr p1)))
                            (make-vect (car p2) (car (cdr p2))))
              (points->segments (cdr points))))))

(define wave
  (let ((wp1 '((0.25 0)
               (0.34 0.4)
               (0.35 0.58)
               (0.16 0.5)
               (0 0.68)))
        (wp2 '((0 0.78)
               (0.16 0.61)
               (0.30 0.7)
               (0.42 0.69)
               (0.35 0.82)
               (0.42 1)))
        (wp3 '((0.58 1)
               (0.65 0.82)
               (0.58 0.69)
               (0.70 0.7)
               (0.84 0.61)
               (1.0 0.32)))
        (wp4 '((0.75 0)
               (0.66 0.4)
               (0.65 0.58)
               (0.80 0.5)
               (1.0 0.22)))
        (wp5 '((0.37 0)
               (0.5 0.35)
               (0.63 0))))
    (segments->painter (append-map points->segments
                                   (list wp1 wp2 wp3 wp4 wp5)))))

(define left
  (let ((eye '((0.40 0.84)
                (0.43 0.88)
                (0.47 0.84)))
        (mouth '((0.46 0.74)
                 (0.5 0.70))))
    (segments->painter (append-map points->segments
                                   (list eye mouth)))))
(define right (flip-horiz left))
                            
(define (smiled-wave frame)
  (left frame)
  (right frame)
  (wave frame))

;test
(paint (square-limit2 smiled-wave 2))

SICP 演習問題 2.1

2.1

#lang racket

(define (make-rat n d)
  (let ((g (gcd n d)))
    (cond ((< (* n d) 0)
            (cons
              (* -1 (abs (/ n g)))
              (abs (/ d g))))
          (else
            (cons (abs(/ n g)) (abs(/ d g)))))))

(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))

(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))

(define (equal-rat? x y)
  (= (* (numer x)(denom y))
     (* (numer y)(denom x))))

(define (numer x) (car x))
(define (denom x) (cdr x))

(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x)))

2.2

#lang Racket
;点の定義
(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
;線分の定義
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))

(define (midpoint-segment seg)
  (let ((start (start-segment seg))
        (end (end-segment seg)))
    (make-point
      (/ (+ (x-point start) (x-point end)) 2)
      (/ (+ (y-point start) (y-point end)) 2))))

(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

2.3

実装1
(長辺と短辺を1つずつ指定。各辺は斜めでもOK。指定する2辺が長方形を構成可能かどうかの判断は省略)

#lang Racket
;周長
(define (perimeter-rectangle rec)
  (* (+ (long-rectangle-length rec)
        (short-rectangle-length rec))
     2))
;面積
(define (area-rectangle rec)
  (* (long-rectangle-length rec)
     (short-rectangle-length rec)))

;辺の長さ
(define (length-segment seg)
   (let ((start (start-segment seg))
        (end (end-segment seg)))
     (sqrt
      (+ (square (- (x-point end) (x-point start)))
         (square (- (y-point end) (y-point start)))))))
;長方形の定義: (cons 長辺 短辺)
(define (make-rectangle long short) (cons long short))
;長編の長さ
(define (long-rectangle-length rec) (length-segment (car rec)))
;短辺の長さ
(define (short-rectangle-length rec) (length-segment (cdr rec)))

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (square x) (* x x))

実装2 (4点を指定。効率は悪い。ホントは3点でも一意に定まるが、、、)

#lang racket

;長方形の定義 (cons 左上 右上 左下 右下)
(define (make-rectangle top-left top-right bottom-left bottom-right)
  (cons (cons top-left top-right)
        (cons bottom-left bottom-right)))

;短辺の長さ(ここに抽象化の壁がある)
(define (short-rectangle-length rec)
  (let ((vertical
          (length-segment
             (make-segment (car (car rec)) (car (cdr rec)))))
        (horizontal
          (length-segment
             (make-segment (car (car rec)) (cdr (car rec))))))
    (if (< vertical horizontal) vertical horizontal)))

;長辺の長さ(ここに抽象化の壁がある)
(define (long-rectangle-length rec)
  (let ((vertical
          (length-segment
             (make-segment (car (car rec)) (car (cdr rec)))))
        (horizontal
          (length-segment
             (make-segment (car (car rec)) (cdr (car rec))))))
    (if (> vertical horizontal) vertical horizontal)))

;面積と周長の関数定義はそのまま
(define (perimeter-rectangle rec)
  (* (+ (long-rectangle-length rec)
        (short-rectangle-length rec))
     2))
(define (area-rectangle rec)
  (* (long-rectangle-length rec)
     (short-rectangle-length rec)))

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (make-segment start end) (cons start end))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (length-segment seg)
   (let ((start (start-segment seg))
        (end (end-segment seg)))
     (sqrt
      (+ (square (- (x-point end) (x-point start)))
         (square (- (y-point end) (y-point start)))))))
(define (square x) (* x x))

2.4

cdrの定義

#lang Racket
(define (cdr z)
  (z (lambda (p q) q)))

(define (cons x y)
  (lambda (m) (m x y)))
(define (car z)
  (z (lambda (p q) p)))

(car (cons x y))がxを生じることを証明

(car (cons x y))
;carを展開
;->((cons x y) (lambda (p q) p))
;consを展開
;->((lambda (m) (m x y)) (lambda (p q) p))
;mに(lambda (p q) p)を束縛
;->((lambda (p q) p) x y)
; p, q に x, y を束縛
;-> x

2.5

非負の整数の対は数と算術演算だけを使って表現出来ることを示せ

(a b) -> 2^a*3^b なので、
与えられた非負整数nが
奇数の場合:
  2^0*3^bなので、1になるまで3で除算し、除算回数をbとする(b->log3(n))
偶数の場合:
  2^a*3^bなので、奇数mが得られるまで2で除算し、除算回数をaとする。
  奇数mは2^0*3^bとなるので、bはnが奇数の場合と同じ求め方で得る(b->log3(m))

これに対応する手続き cons, carおよびcdrの定義

#lang Racket
;cons
(define (cons x y)
  (* (base 2 x) (base 3 y)))
;car
(define (car z)
  (count-n z 2))
;cdr
(define (cdr z)
  (count-n z 3))


(define (base x n)
  (if (= n 0) 1
      (* x (base x (- n 1)))))
(define (count-n x divider)
  (define (iter x divider n)
    (if (= (remainder x divider) 0)
        (iter (/ x divider) divider (+ n 1))
        n))
  (iter x divider 0))

2.6

oneの定義

;one
(add-1 zero)
(lambda (f) (lambda (x) (f ((zero f) x))))
(lambda (f) (lambda (x) (f (lambda (f) (lambda (x) x) f) x)))
(lambda (f) (lambda (x) (f (lambda (x) x) x)))
(lambda (f) (lambda (x) (f x)))

twoの定義

;two
(add-1 one)
(lambda (f) (lambda (x) (f ((one f) x))))
(lambda (f) (lambda (x) (f ((lambda (f) (lamda (x) (f x))) f) x)))
(lambda (f) (lambda (x) (f (lambda (x) (f x)) x)))
(lambda (f) (lambda (x) (f (f x))))

加算手続きの定義

(define (add a b)
  (lambda (f) (lambda (x) ((a f) ((b f) x)))))
;(add one two)
(lambda (f) (lambda (x) ((one f) ((two f) x))))
(lambda (f) (lambda (x)
  (((lambda (f) (lambda(x) (f x))) f)
   (((lambda (f) (lambda(x) (f (f x)))) f) x))))
(lambda (f) (lambda (x)
  ((lambda (x) (f x)) (lambda (x) (f (f x)) x))))
(lambda (f) (lambda (x)
  ((lambda (x) (f x)) (f (f x)))))
(lambda (f) (lambda (x) (f (f (f x)))))
; =>three

2.7

#lang Racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

2.8

(define (sub-interval x y)
  (make-interval
    (- (lower-bound x) (upper-bound y))
    (- (upper-bound x) (lower-bound y))))

2.9

区間Xの幅

 X_width = X_max - X_min

和の幅

 (X_max + Y_max) - (X_min + Y_min)
 = (X_max - X_min) + (Y_max - Y_min)
 = X_width + Y_width

差の幅

 (X_max - Y_min) - (X_min - Y_max)
 = (X_max - X_min) + (Y_max - Y_min)
 = X_width + Y_width

積の幅

 max(X_maxY_min X_maxY_max X_minY_min X_minY_max)
 -  min(X_maxY_min X_maxY_max X_minY_min X_minY_max)
 よって、以下の16パターンだが、いずれもwidthのみの関数にはならない
 X_max(Ymin - Y_max)
 X_max(Ymax - Y_min)
 X_min(Ymin - Y_max)
 ...
 Y_min(Xmax - X_min)
 X_maxY_max-X_minY_min
 X_minY_min-X_maxY_max

商の幅も席の幅と同様、widthだけの関数にならない。

 max(X_max/Y_min X_max/Y_max X_min/Y_min X_min/Y_max)
 -  min(X_max/Y_min X_max/Y_max X_min/Y_min X_min/Y_max)

2.10

0をまたがる区間で割ると、正負それぞれの0近傍で+∞,-∞に発散してしまう。 また、0では解無しとなる。

エラーを返すコード

(define (div-interval x y)
  (if (> 0 (* (lower-bound y) (upper-bound y)))
      (print "error")
      (mul-interval
        x
        (make-interval
          (/ 1.0 (upper-bound y))
          (/ 1.0 (lower-bound y))))))

2.11

区間 [min,max] の符号のパターンは、 [正,正],[負,正],[負,負]となる。 よって、x,yを考慮すると3*3=9通りになる。

それぞれのパターンにおける、min,maxは具体例を交えると以下のようになる。 ( [負,正]の場合はminとmaxの絶対値の大小関係により場合分けして考える)

[正,正] * [正,正]
[1,2] * [2,4]
min: x_min * y_min >0
max: x_max * y_max > max(x_min*y_max, x_max*y_min) > x_min*y_min (max<0)

[正,正] * [負,正]
[1,2] * [-2,4]
[1,2] * [-4,2]
何方のパターンも同じ
min: x_max * y_min < x_min*y_min < 0
max: x_max * y_max > x_min*y_max > 0

[正,正] * [負,負]
[1,2] * [-4, -2]
min: x_max * y_min < min(x_min*y_min,x_max*y_min) < 0
max: x_min * y_max > max(x_min*y_min,x_max*y_min) (max<0)

[負,正] * [正,正]
[-1,2] * [2,4]
[-2,1] * [2,4]
何方のパターンも同じ
min: x_min * y_max < x_min*y_min < 0
max: x_max * y_max > x_max*y_min > 0

[負,正] * [負,正]
[-1,2] * [-2,4]
[-2,1] * [-4,2]
パターンごとに大小が変化する
min: min(x_min * y_max, x_max * y_min) <0
max: max(x_max * y_max, x_min * y_min) >0

[負,正] * [負,負]
[-1,2] * [-4,-2]
[-2,1] * [-4,-2]
何方のパターンも同じ
min: x_max * y_min < x_max*y_max < 0
max: x_min * y_min > x_min*y_max > 0

[負,負] * [正,正]
[-2,-1] * [2,4]
min: x_min * y_max < x_min*y_min < x_max*y_max
max: x_max * y_min > x_max*y_max (max<0)

[負,負] * [負,正]
[-2,-1] * [-2,4]
[-2,-1] * [-4,2]
何方のパターンも同じ
min: x_min * y_max < x_max*y_max < 0
max: x_min * y_min > x_max*y_min > 0

[負,負] * [負,負]
[-2,-1] * [-4,-2]
min: x_max * y_max < min(x_min*y_max, x_max*y_min) (0<min)
max: x_min * y_min > max(x_min*y_max, x_max*y_min)

よって、 [負,正] * [負,正]のパターン以外は、 最大、最小の組み合わせが一意に定まるので 乗算回数は2回で良い。

これを実装する

#lang racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

(define (mul-interval2 x y)
  (let ((xl (lower-bound x))
        (xu (upper-bound x))
        (yl (lower-bound y))
        (yu (upper-bound y)))
    (cond     
      ((and (< 0 (* xl xu)) (< 0 (* yl yu)))
        (cond
          ((and (< 0 xl) (< 0 yl))
            ;[正,正]*[正,正]
            (make-interval (* xl yl) (* xu yu)))
          ((and (< xl 0) (< yl 0))
            ;[負,負]*[負,負]
           (make-interval (* xu yu) (* xl yl)))
          ((and (< xl 0) (< 0 yl))
            ;[負,負]*[正,正]
           (make-interval (* xl yu) (* xu yl))))
          ((and (< 0 xl) (< yl 0))
            ;[正,正]*[負,負]
           (make-interval (* xu yl) (* xl yu))))
      ((< (* xl xu yl yu) 0)
        (if (< 0 (* xl xu))
          (if (< 0 xl)
             ;[正,正] * [負,正]
             (make-interval (* xu yl) (* xu yu))
             ;[負,負] * [負,正]
             (make-interval (* xl yu) (* xl yl)))
          (if (< 0 yl)
             ;[負,正] * [正,正]
             (make-interval (* xl yu) (* xu yu))
             ;[負,正] * [負,負]
             (make-interval (* xu yl) (* xl yl)))))
      (else
        ;[負,正] * [負,正]
        (make-interval
          (min (* xl yu) (* xu yl))
          (max (* xu yu) (* xl yl)))))))

動作確認

;test methods
(define (old-mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))
(define (eql-interval? x y)
  (and (= (lower-bound x) (lower-bound y))
       (= (upper-bound x) (upper-bound y))))

(define (mul-test xl xu yl yu)
  (let ((x (make-interval xl xu))
        (y (make-interval yl yu)))
    (if
      (eql-interval?
        (old-mul-interval x y)
        (mul-interval2 x y))
      true
      (error "failed"
             x
             y
             (old-mul-interval x y)
             (mul-interval2 x y)))))

;test code
(mul-test 2 3 4 5)
(mul-test 2 3 -4 5)
(mul-test 2 3 4 -5)
(mul-test 2 3 -4 -5)
(mul-test 2 3 0 5)
(mul-test 2 3 -4 0)

(mul-test -2 3 4 5)
(mul-test -2 3 -4 5)
(mul-test -2 3 4 -5)
(mul-test -2 3 -4 -5)
(mul-test -2 3 0 5)
(mul-test -2 3 -4 0)

(mul-test 2 -3 4 5)
(mul-test 2 -3 -4 5)
(mul-test 2 -3 4 -5)
(mul-test 2 -3 -4 -5)
(mul-test 2 -3 0 5)
(mul-test 2 -3 -4 0)

(mul-test -2 -3 4 5)
(mul-test -2 -3 -4 5)
(mul-test -2 -3 4 -5)
(mul-test -2 -3 -4 -5)
(mul-test -2 -3 0 5)
(mul-test -2 -3 -4 0)

(mul-test -2 0 4 5)
(mul-test -2 0 -4 5)
(mul-test -2 0 4 -5)
(mul-test -2 0 -4 -5)
(mul-test -2 0 0 5)
(mul-test -2 0 -4 0)

(mul-test 0 3 4 5)
(mul-test 0 3 -4 5)
(mul-test 0 3 4 -5)
(mul-test 0 3 -4 -5)
(mul-test 0 3 0 5)
(mul-test 0 3 -4 0)

2.12

#lang racket
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))

(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))

(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2.0))

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2.0))

(define (make-center-percent c p)
  (let ((w (* c (/ p 100))))
    (make-interval (- c w) (+ c w))))

(define (percent i)
   (* (/ (width i) (center i)) 100))

;test
(define i (make-interval 900 1100))
(center i)
(width i)
(percent i)

(define i2 (make-center-percent 1000 10))
(lower-bound i)
(upper-bound i)
(center i)
(width i)
(percent i)

2.13

Ci,Wi をインターバルi の 中央値(center)、許容誤差(width)と仮定

この時、x,yは以下のように示せる

x = [x_min, x_max]
  x_min = Cx*(1-0.5*Wx)
  x_max = Cx*(1-0.5*Wx)

y = [y_min, y_max]
  y_min = Cy*(1-0.5*Wy)
  y_max = Cy*(1-0.5*Wy)

すべての数が正の場合、 xy = [x_miny_min, x_maxy_max] = [CxCy(1-0.5(Wx+Wy)+WxWy), CxCy*(1+0.5(Wx+Wy)-WxWy)]

相対許容誤差が小さいと仮定できる場合、 WxWyは無視できる。

よって xy≒ [CxCy(1-0.5(Wx+Wy)), CxCy(1+0.5(Wx+Wy))] となり、 xyの許容誤差は (Wx+Wy) となる。

2.14

(define A (make-interval 89999 90001))
(define B (make-interval 100 900))

(define (test x y)
  (let ((ans (div-interval x y)))
    (center ans)
    (percent ans)))
(display "C_a ")
(center A)
(display "P_a ")
(percent A)
(display "C_b ")
(center B)
(display "P_b ")
(percent B)
(newline)
(display "A/A ")
(test A A)
(display "A/B ")
(test A B)
(display "B/B ")
(test B B)
(display "B/A ")
(test B A)

実行結果

C_a 90000.0
P_a 0.0011111111111111111
C_b 500.0
P_b 80.0

A/A 0.002222222221954537
A/B 80.00039999644447
B/B 97.56097560975611
B/A 80.0003999964445

A/A, B/B は本来1となるべきなのに、 相対誤差が増大している。

これは本プログラムが、A,Bを一つの値ではなく 「区間の中のいずれかの値」と規定しているが、 その「いずれかの値」を固定できないからである。

※以下、「固定」という言い方が正しいか自信無いので具体例...

本来は、同じ区間A[1,3],B[1,3]があった場合、 式中のAとBはそれぞれ1<a<3, 1<b<3を満たす任意の数値a,bになる。 (a, bの間に相関はないが、式中のa,bはそれぞれ一意の値となる) そのため、A/A=B/B=1かつA/B≠1 となるべきだが、本プログラムでは、 A/A,B/B共に1にならない。

これが、計算式によって答えに差分が生じる原因である。

2.15

Evaは正しい。 2.14の結果を踏まえると、上記プログラムを使う限り、 par1よりpar2のほうが正確な値を出力する。

par1のように、同じ値を示す区間変数が複数回登場する場合、2.14で述べた通り本来同じ値となるべきところを違う値として評価してしまうためである。

2.16

2.14に書いたとおり。 intervalのデータ構造にシリアル番号のような識別子を追加し、 識別子が同じ場合を特別扱いするような改造をすれば、問題は解決できるのではないか。

識別子が同じ場合、減算結果は0、除算結果は1とする。 (加算と積算は通常通りの区間演算で良い)

SICP 演習問題 1.3

Exercise 1.29

;h = (b-a)/n
;y_k=func(a+kh)
;sum = (y_0 + 4y_1 + 2y_2 + 4y_3 + ... + y_n)
;
#lang Racket
(define (simpthon a b func n)
  (* (/ (h a b n) 3)
    (sum-simpthon a b func 0 n)))

(define (sum-simpthon a b func k n)
  (if (> k n)
    0
    (+ (cond ((or (= k 0) (= k n)) (y a b func k n))
       ((odd? k) (* 4 (y a b func k n)))
       ((even? k) (* 2 (y a b func k n))))
     (sum-simpthon a b func (+ k 1) n))))

(define (h a b n) (/ (- b a) n))
(define (y a b func k n) (func (+ a (* k (h a b n)))))
(define (odd? k) (= (remainder k 2) 1))
(define (even? k) (= (remainder k 2) 0))

(define (linear x) x)
(define (square x) (* x x))

(simpthon 0 1 linear 1)
(simpthon 0 1 linear 10)
(simpthon 0 1 linear 100)
(simpthon 0 1 square 10)

Exercise 1.30

#lang Racket
(define (sum term a next b)
  (if (> a b)
    0
    (+ (term a) (sum term (next a) next b))))

(define (sum2 term a next b)
  (define (iter a result)
    (if (> a b)
      result
      (iter (next a) (+ (term a) result))))
  (iter a 0))

(define (square x) (* x x))
(define (step x) (+ x 1))

(sum square 1 step 4)
(sum2 square 1 step 4)

Exercise 1.31

1.31a

#lang Racket
(require racket/flonum)

(define (product term a next b)
  (define (iter a result)
    (if (> a b)
      result
      (iter (next a) (* (term a) result))))
  (iter a 1))

(define (factorial n) (product abs 1 inc n))
(define (inc x) (+ x 1))

(define (pi n) (* 4 (product wallis 2 inc n)))

(define (wallis x)
  (fl/ (->fl (wallis-even x))
       (->fl (wallis-odd  x))))
(define (wallis-even x) (if (odd?  x) (+ x 1) x))
(define (wallis-odd  x) (if (even? x) (+ x 1) x))

(factorial 5)
(pi 1000000)

1.31b

#lang Racket
(define (product term a next b)
  (if (> a b)
      1
      (* (term a)
        (product term (next a) next b))))

Exercise 1.32

1.32a

;sum
(define (sum term a next b)  (accumlate + 0 term a next b))

;product
(define (product term a next b)  (accumulate * 1 term a next b))

1.32b

(define (accumulate combiner null-value term a next b)
  (if (> a b)
      null-value
      (combiner
        (term a)
        (accumulate combiner null-value term (next a) next b))))

Exercise 1.33

#lang Racket
(define
  (filtered-accumulate combiner null-value filter term a next b)
  (define (iter a result)
    (cond ((> a b) result)
      ((filter a) (iter (next a) (combiner (term a) result)))
      (else (iter (next a) result))))
  (iter a null-value))

1.33a

#lang Racket
(define (prime-square-sum a b)
  (filtered-accumulate + 0 prime? square a inc b))
(define (prime? n) (= n (smallest-divisor n)))
(define (smallest-divisor n) (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next test-divisor)))))
(define (divides? a b) (= (remainder b a) 0))
(define (square n) (* n n))
(define (next n)  (if (= n 2) 3 (+ n 2)))
(define (inc x) (+ x 1))
(prime-square-sum 1 5)

1.33b

#lang Racket
(define (disjoint-product n)
  (define (disjoint? x) (= (gcd x n) 1))
  (filtered-accumulate * 1 disjoint? abs 1 inc n))
(disjoint-product 6)

Exercise 1.33

#lang Racket
(define
  (filtered-accumulate combiner null-value filter term a next b)
  (define (iter a result)
    (cond ((> a b) result)
      ((filter a) (iter (next a) (combiner (term a) result)))
      (else (iter (next a) result))))
  (iter a null-value))

a

#lang Racket
(define (prime-square-sum a b)
  (filtered-accumulate + 0 prime? square a inc b))
(define (prime? n) (= n (smallest-divisor n)))
(define (smallest-divisor n) (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next test-divisor)))))
(define (divides? a b) (= (remainder b a) 0))
(define (square n) (* n n))
(define (next n)  (if (= n 2) 3 (+ n 2)))
(define (inc x) (+ x 1))
(prime-square-sum 1 5)

b

#lang Racket
(define (disjoint-product n)
  (define (disjoint? x) (= (gcd x n) 1))
  (filtered-accumulate * 1 disjoint? abs 1 inc n))
(disjoint-product 6)

Excercise 1.34

(2 2) はひょうかできましぇん

#lang racket
(define (f g) (g 2))
(define (square x) (* x x))
(f square)
(f (lambda (z) (* z (+ z 1))))
(f f)

1.35

#lang Racket
(require racket/flonum)

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(fixed-point (lambda (x) (fl+ 1.0 (fl/ 1.0 x))) 1.0)

1.36

#lang Racket
(require racket/flonum)

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (display "***")(display guess)(newline)
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(fixed-point (lambda (x) (fl/ (log 1000) (log x))) 1.1)

(define (average x y) (/ (+ x y) 2))
(fixed-point (lambda (x) (average x (fl/ (log 1000) (log x)))) 1.1)

tolerance 0.00001 38 steps (4.555538934848503) vs 14 steps (4.555536364911781)

tolerance 0.00000000000001 87 steps (4.555535705195124) vs 27 steps (4.555535705195128)

1.37

a

#lang Racket
(require racket/flonum)

(define (cont-frac-try n d k i)
  (if (> i k) 0.0
    (fl/ (n i) (fl+ (d i) (cont-frac-try n d k (+ i 1))))))

(define (cont-frac n d k)
  (cont-frac-try n d k 1))

(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 11)
(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 12)
(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 13)

b

(define (cont-frac n d k)
  (define (cont-frac-try i result)
    (if (<= i 0)
        result
        (cont-frac-try (- i 1) (/ (n i) (+ (d i) result)))))
  (cont-frac-try k 0.0))

1.38

(define (dfc k)
  (+ 2
     (cont-frac
      (lambda (x) 1.0)
      (lambda (x)
        (cond ((= (remainder x 3) 2) (*  (+ (floor(/ x 3)) 1) 2))
              (else 1.0)))
      k)))

(dfc 1000)

1.39

#lang Racket
(require racket/flonum)

(define (tan-cf x k)
  (define (tan-cf-try i)
    (if (> i k)
        0
        (/ (* x x)
           (- (- (* i 2) 1) (tan-cf-try (+ i 1))))))
  (/ x (- 1 (tan-cf-try 2))))

(define pi 3.141592)
(tan-cf (/ pi 4) 1000)
(tan-cf (/ pi 3) 1000)
(tan-cf pi 1000)

1.40

#lang Racket
(define dx 0.00001)
(define tolerance 0.00001)

(define (deriv g)
  (lambda (x) (/ (- (g (+ x dx)) (g x)) dx)))
(define (newton-transform g)
  (lambda (x) (- x (/ (g x) ((deriv g) x)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (newtons-method g guess)
  (fixed-point (newton-transform g) guess))

(define (cubic a b c) (lambda (x) (+ (* x x x) (* a x x) (* b x) c)))

(newtons-method (cubic -3 3 -1) 1.1)
(newtons-method (cubic -6 12 -8) 1.1)

1.41

#lang racket
(define (double f)
  (lambda (x) (f (f x))))
(define (inc x) (+ x 1))
((double inc) 1)
(((double (double double)) inc) 5)
(((double (double double)) inc) 5)
(((double (lambda (x) (double (double x)))) inc) 5)
(((lambda (x) (double (double (double (double x))))) inc) 5)
((double (double (double (double inc)))) 5)
((double (double (double (lambda (x) (inc (inc x)))))) 5)
((double (double (lambda (x) (inc (inc (inc (inc x))))))) 5)
((double (lambda (x) (inc (inc (inc (inc (inc (inc (inc (inc x)))))))))) 5)
((lambda (x) (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc x))))))))))))))))) 5)
(inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc 5)))))))))))))))))

1.42

#lang racket
(define (compose f g) (lambda (x) (f (g x))))

(define (square x) (* x x))
(define (inc x) (+ x 1))

((compose square inc) 6)

1.43

#lang Racket

1.44

#lang Racket

(define dx 0.0001)
(define (smooth f)
  (lambda (x) (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3)))
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (n-fold-smooth f n) ((repeated smooth n) f))

1.45

#lang Racket

(define tolerance 0.00001)
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (average-damp f) (lambda (x) (average x (f x))))
(define (average x y) (/ (+ x y) 2))
(define (pow x n)
  (if (<= n 0) 1 (* x (pow x (- n 1)))))

(define (n-root x n k)
  (fixed-point
    ((repeated average-damp k)
       (lambda (y) (/ x (pow  y (- n 1)))))
    1.1 ))

(n-root 2 2 1)
(n-root 2 3 1)
(n-root 2 4 2)
(n-root 2 5 2)
(n-root 2 6 2)
(n-root 2 7 2)
(n-root 2 8 3)
(n-root 2 10 3)
(n-root 2 15 3)
(n-root 2 16 4)
(n-root 2 20 4)
(n-root 2 30 4)
(n-root 2 31 4)
(n-root 2 32 5)
(n-root 2 40 5)
(n-root 2 63 5)
(n-root 2 64 6)

log2(n) の模様 したがって

#lang Racket

(define tolerance 0.00001)
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (average-damp f) (lambda (x) (average x (f x))))
(define (average x y) (/ (+ x y) 2))
(define (pow x n)
  (if (<= n 0) 1 (* x (pow x (- n 1)))))
(define (log2 x)
  (/ (log x) (log 2)))

(define (n-root x n)
  (fixed-point
    ((repeated average-damp (floor (log2 n)))
       (lambda (y) (/ x (pow  y (- n 1)))))
    1.1 ))

Excercise 1.46

#lang Racket

(define (iterative-improve evaluate improve)
  (lambda (x)
    (let ((next (improve x)))
    (if (evaluate x next)
      next
      ((iterative-improve evaluate improve) next)))))

(define tolerance 0.00001)

(define (close-enough? v1 v2)
  (< (abs (- v1 v2)) tolerance))

(define (sqrt x)
  ((iterative-improve
    close-enough?
    (lambda (y)
      (/ (+(/ x y) y) 2))) 1.0))


(define (fixed-point f first-guess)
  ((iterative-improve
     close-enough?
     f)
   first-guess))

SICP 演習問題 1.2

 

Exercise 1.9

(define (+ a b)
(if (= a 0) b (inc (+ (dec a) b))))

(+ 4 5)
(inc (+ 3 5))
(inc (inc (+ 2 5)))
(inc (inc (inc (+ 1 5))))
(inc (inc (inc (inc (+ 0 5)))))
(inc (inc (inc (inc 5))))
(inc (inc (inc 6))
(inc (inc 7)
(inc 8)
9

再帰

(define (+ a b)
(if (= a 0) b (+ (dec a) (inc b))))

(+ 4 5)
(+ (dec 4) (inc 5))
(+ 3 (inc 5))
(+ (dec 3) (inc (inc 5)))
(+ 2 (inc(inc 5)))
(+ (dec 2) (inc (inc (inc 5))))
(+ 1 (inc (inc (inc 5))))
(+ (dec 1) (inc (inc (inc (inc 5)))))
(+ 0 (inc (inc (inc (inc 5)))))
(inc (inc (inc (inc 5))))
9

反復

Exercise 1.10

(A 1 10)
(A 0 (A 1 9)
(A 0 (A 0 A(1 8)))
(A 0 (A 0 A(0 A(1 7))))
...
1024
(A 2 4)
(A 1 (A 2 3))
(A 1 (A 1 (A 2 2)))
(A 1 (A 1 (A 1 (A 2 1))))
(A 1 (A 1 (A 1 2)))
(A 1 (A 1 (A 0 (A 1 1))))
(A 1 (A 1 (* 2 2)))
(A 1 (A 0 (A 1 3)))
(A 1 (A 0 (A 0 (A 1 2))))
...
2^16

 

(A 3 3)
(A 2 (A 3 2))
(A 2 (A 2 (A 3 1)))
(A 2 (A 2 2))
(A 2 (A 1 (A 2 1)))
(A 2 (A 1 2))
(A 2 (A 0 (A 1 1)))
(A 2 (A 0 2))
(A 2 4)
...
2^16

 

(define (f n) (A 0 n))
(f n) -> 2n

(define (g n) (A 1 n))
(g n) -> 2^n

(define (h n) (A 2 n))
(h n) -> 2^(2^n)

2の2のn乗乗??

Exercise 1.11

(define (f n)
(cond (< n 3) n)
(else (+ (f (- n 1)) (f (- n 2)) (f (- n 3))))
)

Excercise 1.12

#lang racket
(define (pascal x y)
(cond ((< y 1) 0)
((> y x) 0)
((= y 1) 1)
((= y x) 1)
(else (+ (pascal (- x 1) (- y 1))
(pascal (- x 1) y)))))

Exercise 1.13

Fib(0)=0
Fib(1)=1
Fib(n)=Fib(n-1)+Fib(n-2)

Fib(n)=(φ^(n) - ψ^(n))/a
( a = 5^(1/2) )
を証明
n=0のとき、n=1のとき、成立
Fib(k) = (φ^(k) - ψ^(k))/a
Fib(k+1) = (φ^(k+1) - ψ^(k+1))/a
が成立すると仮定して、
Fib(k+2)のとき
Fib(k+2)=(φ^(k+2) - ψ^(k+2))/a
を示す.
Fib(n+2)
= ( φ^(n+1) - ψ^(n+1) + φ^(n) - ψ^(n) )/a
= ( φ^n(φ+1)-ψ^n(ψ+1) )/a
= (φ^(k+2) - ψ^(k+2))/a
∵ φ+1 = φ^2 , ψ+1 = ψ^2

よって帰納法により、
Fib(n)=(φ^(n) - ψ^(n))/a

Exercise 1.14

はれないので省略

Exercise 1.15

12.15/3 = 4.05
4.05/3 = 1.35
1.35/3 = 0.45
0.45/3 = 0.15
0.15/3 = 0.03

4回

aに対しては3を底とする対数のオーダーなのでO(logn)となる。

 

Exercise 1.16

(define (fast-expt b n)
(expt-iter 1 b n ))
(define (expt-iter a b n)
(cond ((= n 0) a)
((even? n) (expt-iter (* (square b) a) b (/ n 2)))
(else (expt-iter (* b a) b (- n 1)))))

Exercise 1.17

(define (fast-* a b)
(cond (= b 0) 0
(even? n) (+ (double a) (* a (halve b) ))
(else (+ a (* a (- b 1) )))))

Exercise 1.18

(define (fast-* a b c)
(cond (= b 0) 0
(even? n) (* a (halve b) (+ (double a) c) )
(else (* a (- b 1) (+ a c) ))))

Exercise 1.19

a <- bq + aq + ap
b <- bp + aq

a <- (bp+aq)q + (bq + aq + ap)q + (bq + aq + ap)p
= bpq + aq^2 + bq^2 + aq^2 + apq + bpq + apq + ap^2
= b(2pq + q^2) + a(2q^2 + 2pq + p^2)
= b(2pq + q^2) + a(2pq+q^2) + a(q^2+p^2)

b <- (bp + aq)p + (bq + aq + ap)q
= b(p^2 + q^2) + a(2pq + q^2)
i.e.
P' = (p^2 + q^2)
q' = (2pq + q^2)
(define (fib n)
(fib-iter 1 0 0 1 n))
(define (fib-iter a b p q count)
(cond
((= count 0) b)
((even? count)
(fib-iter a
b
(+ (* p p) (* q q))
(+ (* 2 p q) (* q q))
(/ count 2)))
(else (fib-iter (+ (* b q) (* a q) (* a p))
(+ (* b q) (* a q))
p
q
(- count 1)))))

Exercise 1.20

(define (gcd a b)
(if (= b 0)
a
(gcd b (remainder a b))))

適用順

(gcd 206 40)
(gcd 40 (remainder 206 40))
(gcd 40 6)
(gcd 6 (remainder 40 6))
(gcd 6 4)
(gcd 4 (remainder 6 4))
(gcd 4 2)
(gcd 2 (remainder 4 2))
(gcd 2 0)
2

正規化順

(gcd 206 40)
(gcd 40 (remainder 206 40))
(if (= (remainder 206 40) 0)
40
(gcd (remainder 206 40) (remainder 40 (remainder 206 40))))
(if (= 6 0)
40
(gcd (remainder 206 40) (remainder 40 (remainder 206 40))))
(gcd (remainder 206 40) (remainder 40 (remainder 206 40))))
(if (= (remainder 40 (remainder 206 40)) 0)
(remainder 206 40)
(gcd (remainder 40 (remainder 206 40))
(remainde 6 (remainder 40 (remainder 206 40)))))

Exercise 1.21

#lang racket
(define (smallest-divisor n) (find-divisor n 2))

(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (next test-divisor)))))

(define (divides? a b) (= (remainder b a) 0))

(define (prime? n) (= n (smallest-divisor n)))

(define (square n) (* n n))

(define (next n) (+ n 1))

(smallest-divisor 199)
;->199
(smallest-divisor 1999)
;->1999
(smallest-divisor 19999)
;->7

 

Exercise 1.22

#lang Racket
(define (smallest-divisor n) (find-divisor n 2))
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (next test-divisor)))))
(define (divides? a b) (= (remainder b a) 0))
(define (prime? n) (= n (smallest-divisor n)))
(define (square n) (* n n))
(define (next n) (+ n 1))

(define (timed-prime-test n)
(newline) (display n) (start-prime-test n (current-inexact-milliseconds)))

(define (start-prime-test n start-time)
(if (prime? n) (report-prime (- (current-inexact-milliseconds) start-time)) -1))

(define (report-prime elapsed-time)
(display " *** ") (display elapsed-time))

(define (runtime) (current-milliseconds))
(timed-prime-test 1009)
(timed-prime-test 1013)
(timed-prime-test 1019)
(timed-prime-test 10007)
(timed-prime-test 10009)
(timed-prime-test 10037)
(timed-prime-test 100003)
(timed-prime-test 100019)
(timed-prime-test 100043)
(timed-prime-test 1000003)
(timed-prime-test 1000033)
(timed-prime-test 1000037)

結果

1009 *** 0.1689453125
1013 *** 0.004150390625
1019 *** 0.00390625
10007 *** 0.01220703125
10009 *** 0.010986328125
10037 *** 0.010986328125
100003 *** 0.031982421875
100019 *** 0.031982421875
100043 *** 0.031982421875
1000003 *** 0.10009765625
1000033 *** 0.10009765625
1000037 *** 0.10009765625

1009だけ異様に遅い。。。

他はおおむね理論通り。

Exercise 1.23

#lang racket
(define (smallest-divisor n) (find-divisor n 2))

(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (next test-divisor)))))

(define (divides? a b) (= (remainder b a) 0))

(define (prime? n) (= n (smallest-divisor n)))

(define (square n) (* n n))

(define (next n)
(cond ((= n 2) 3)
(else (+ n 2))))
(define (timed-prime-test n)
(newline) (display n) (start-prime-test n (current-inexact-milliseconds)))

(define (start-prime-test n start-time)
(if (prime? n) (report-prime (- (current-inexact-milliseconds) start-time)) -1))

(define (report-prime elapsed-time)
(display " *** ") (display elapsed-time))

(timed-prime-test 1009)
(timed-prime-test 1013)
(timed-prime-test 1019)
(timed-prime-test 10007)
(timed-prime-test 10009)
(timed-prime-test 10037)
(timed-prime-test 100003)
(timed-prime-test 100019)
(timed-prime-test 100043)
(timed-prime-test 1000003)
(timed-prime-test 1000033)
(timed-prime-test 1000037)

結果

1009 *** 0.200927734375
1013 *** 0.003173828125
1019 *** 0.0029296875
10007 *** 0.007080078125
10009 *** 0.005859375
10037 *** 0.007080078125
100003 *** 0.01904296875
100019 *** 0.01904296875
100043 *** 0.02001953125
1000003 *** 0.06005859375
1000033 *** 0.06005859375
1000037 *** 0.05908203125

半分ではなく、3:2ぐらいの減り具合。   これは(next n) のオーバヘッドのせいではないか。

Exercise 1.24

#lang Racket
(define (expmod base exp m)
(cond ((= exp 0) 1)
((even? exp)
(remainder
(square (expmod base (/ exp 2) m)) m))
(else
(remainder
(* base (expmod base (- exp 1) m)) m))))

(define (square a) (* a a))

(define (fermat-test n)
(define (try-it a)
(= (expmod a n n) a))
(try-it (+ 1 (random (- n 1)))))

(define (fast-prime? n times)
(cond ((= times 0) true)
((fermat-test n) (fast-prime? n (- times 1)))
(else false)))
(define (timed-prime-test n)
(newline) (display n) (start-prime-test n (current-inexact-milliseconds)))

(define (start-prime-test n start-time)
(if (prime? n) (report-prime (- (current-inexact-milliseconds) start-time)) -1))

(define (report-prime elapsed-time)
(display " *** ") (display elapsed-time))

(timed-prime-test 1009)
(timed-prime-test 1013)
(timed-prime-test 1019)
(timed-prime-test 10007)
(timed-prime-test 10009)
(timed-prime-test 10037)
(timed-prime-test 100003)
(timed-prime-test 100019)
(timed-prime-test 100043)
(timed-prime-test 1000003)
(timed-prime-test 1000033)
(timed-prime-test 1000037)

Exercise 1.25

巨大な数の演算をしてしまう。。。

#lang Racket
(define (expmod base exp m)
(cond
((= exp 0) 1)
(( even? exp)
(remainder
(square (expmod base (/ exp 2) m)) m))
(else
(remainder
(* base (expmod base (- exp 1) m)) m))))

(define (square a) (* a a))

(define (expmod2 base exp m)
(remainder (fast-expt base exp) m))

(define (fast-expt base exp)
(cond
((= exp 0) 1)
(( even? exp) (square (fast-expt base (/ exp 2))))
(else (* base (fast-expt base (- exp 1))))))

Exercise 1.26

(remainder (* (expmod base (/ exp 2) m)
(expmod base (/ exp 2) m))

これは、expmodを二回計算してしまうため、計算料の節約が帳消しになる。

 

Exercise 1.27

#lang Racket
(define (expmod base exp m)
(cond ((= exp 0) 1)
((even? exp)
(remainder
(square (expmod base (/ exp 2) m)) m))
(else
(remainder
(* base (expmod base (- exp 1) m)) m))))

(define (square a) (* a a))

(define (fermat-test n a)
(= (expmod a n n) a))

(define (carmichael-prime? n times)
(cond ((= times 0) true)
((fermat-test n times) (carmichael-prime? n (- times 1)))
(else false)))

(define (carmichael-test n) (carmichael-prime? n (- n 1)))

(carmichael-test 6601)

Exercise 1.28

;(= expmod( a n-1 n) 1)
; n is prime
;任意のaについていかが成り立つ
; 0 < a < n (a∈N)
; a^(n-1) ≡ 1 (mod n)
;かつ、以下を満たすaが存在しない
; 1 < a < n-1
; a^2 ≡ 1 (mod n)

#lang Racket
(define (expmod base exp m)
(cond ((= exp 0) 1)
((even? exp)
(if (= (remainder (square base) m) 1) 0
(remainder
(square (expmod base (/ exp 2) m)) m)))
(else
(remainder
(* base (expmod base (- exp 1) m)) m))))

(define (square a) (* a a))

(define (miller-rabin-test n)
(define (try-it a)
(= (expmod a (- n 1) n) 1))
(try-it (+ 1 (random (- n 1)))))

(define (fast-prime2? n times)
(cond ((= times 0) true)
((miller-rabin-test n) (fast-prime2? n (- times 1)))
(else false)))

(fast-prime2? 2821 10)
(fast-prime2? 6601 100)
(fast-prime2? 10007 100)

 

SICP 演習問題 1.1

実はちょっと前からやっていたんだけど、長続きしないと恥ずかしいからアップするのを控えていた。

それなりに続いているし、このまま止まらないようにアップして自分を追い詰めることにした。

とりあえず1章から順番に。。。

Exercise 1.1

10
# -> 10
​
(+ 5 3 4)
# -> 12
​
(- 9 1)
#-> 8
​
(/ 6 2)
# -> 3
​
(+ (*2 4) (- 4 6))
# -> (+ 8 -2)
# -> 6
​
(define a 3)
(define b (+ a 1)
(+ a b (*a b))
# -> (+ 3 4 12)
# -> 19
​
(= a b)
# -> false
​
(if (and (> b a) (< b (*a b)))
b
a)
# -> (if (and true true)) b a)
# -> b
​
(cond ((= a 4) 6)
((= b 4) (+ 6 7 a))
(else 25))
# -> (cond (fase 6) (true 16) (else 25))
# -> 16
​
(* (cond ((> a b) a)
((< a b) b)
(else -1))
(+ a 1))
# -> (* b 4)
# -> 16

Exercise 1.2

(/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5)))))
(* 3 (- 6 2) (- 2 7)))

Exercise 1.3

#lang Racket
(define (sum-sqrt a b) (+ (* a a) (* b b))) 
(define (major-sum-sqrt x y z)
(cond ((and (< x y) (< x z)) (sum-sqrt y z)) 
((and (< y x) (< y z)) (sum-sqrt x z))
(else (sum-sqrt x y))))
​
(major-sum-sqrt 1 2 3)
(major-sum-sqrt 4 2 3)
(major-sum-sqrt 1 4 3)

Exercise 1.4

b>0のとき

(if (> b 0) + -)

の評価結果は + となり、 (+ a b) が評価される。 ​

他方b<0のとき

(if (> b 0) + -)

の評価結果は - となり、 (- a b) が評価される。 ​

上記の通り、 評価結果として手続き ( + or - ) が返せる =「演算子が複合式であるような組み合わせが作れる」 ということ? ​

Exercise 1.5

適用順序評価の場合、以下のように評価され、0を返す。

(test 0 (p)) ; (testを評価
(if (= x 0) 0 (p)) ; (= x 0) を評価
0

正規順序評価の場合、無限ループする

(test 0 (p)) ; (p) を評価
(test 0 (p)) ; (p) を評価
...

Exercise 1.6

new-if ではtrue 節、 else 節両方が評価されてしまうため、処理が終了しない。

(define (new-if predicate then-clause else-clause)
(cond (predicate then-clause)
(else else-clause)))
​
(define (sqrt-iter guess x)
(new-if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
​
(sqrt-iter 1.0 2)
;sqrt-iterを展開
(new-if (good-enough? 1.0 2) 1.0 (sqrt-iter (improve 1.0 2) 2))
;new-if を展開
(cond (good-enough? 1.0 2) 1.0 (sqrt-iter (improve 1.0 2) 2))
;good-enough?を評価
;sqrt-iterを展開
;以下略

​ 以下の例を実行すると、
ture, else 双方が評価されていることが分かる。
(=返り値が正しくても副作用がある場合バグる

#lang Racket
(define (new-if predicate then-clause else-clause)
(cond (predicate then-clause)
(else else-clause)))
(define (then-stub) (display "I'm then-clause")(newline)(= 0 0))
(define (else-stub) (display "I'm else-clause")(newline)(= 0 1))
​
;返り値は#t(true)だが、displayはthen, else 両方出る
(new-if (> 1 0)
(then-stub)
(else-stub))
;返り値は#f(false)だが、displayはthen, else 両方出る
(new-if (> 0 1)
(then-stub)
(else-stub))

Exercise 1.7

小さい数の場合、推測値が誤差許容範囲(0.0001)よりも小さくなると、 誤差判定を必ずパスしてしまう。
(例: 10^-4のオーダーで引き算したら必ず答えは 0.0001より小さくなる) ​

大きい数の場合、小数桁がけた落ちしてしまうので、 小さい差分の比較ができなくなる。(評価が終わらない) ​ ​

Exercise 1.8

#lang Racket
(define (cube-root guess x)
(if (good-enough? guess x)
guess
(cube-root (improve guess x) x)))
(define (good-enough? guess x)
(< (abs (- (cube guess) x)) 0.001))
(define (improve guess x)
(/ (+ (/ x (square guess)) (* 2 guess)) 3))
(define (square x) (* x x))
(define (cube x) (* x x x))

(cube-root 1.0 8)

Katagaitai CTF勉強会 関東med (Crypt 理論編?)

先週末に行ってきた勉強会。とてもタメになった。

が、なかなか本腰いれて取り組めないので、少しずつアップすることにした。

今回は午前中のcryptについて、理論面を整理。 実装は、きっとこのあとやる・・・はず。

問題

CSAW CTF 2014 – Crypto300 – feal.py

FEAL(the Fast Data Encipherment Algorithm)

https://ja.wikipedia.org/wiki/FEAL

の復号を扱う問題。

第1段階

特定条件を満たす値が要求される

  • a sha1 sum ending in 16bits set to 1
  • it must be of length 21 bytes
  • starting with [毎度変化する乱数]

時間制限は特に無いもよう。 何度か試したが乱数は必ず16byteなので、21-16=5byteのブルートフォースを考える。

以下のループを作る。(速度考えC言語

  • 末尾5byteを1bitずつインクリメントする
  • 各ループでSHA1hashを計算
  • 計算したSHA1hashの末尾16bitが1になっていたらbreak

また、ネットワーク経由で回答するので、以下のスクリプトを用意

第2段階

暗号文の復号を求められる。

任意の値を入力すると、その暗号化結果を返してくる。 (この時、同じ鍵を使って暗号化している)

↑重要。しばらくこれに気づかなかったので解法のアプローチが理解できなかった

問題名をググるとFEAL暗号に行き着く。

金言:暗号問題は、とにかくググッて暗号文アルゴリズムと解法を見つける

FEAL暗号の仕組みを書こうとすると勉強会スライドのコピペになってしまいそうなので、自分が理解する過程で書いたメモをここにおいておく。

注意点(自分へのToDoも兼ねて)

  • ページ数は勉強会資料のスライド番号
  • 勉強会資料のURLは公開され次第反映予定(覚えていれば
  • 勉強会当時と内容が修正されている場合、ページ数に齟齬が出るかも(覚えていれば修正する
  • 以降勉強会資料中では XOR演算を + と表記しているので、ここでもそれに習います。 (+ は加算ではないので注意)

FEALの概要 (pp25-27)

暗号解析のアプローチ(pp28-29)

僅かに異なる2つの入力を与えてみて、暗号化結果の相関を見る。 (共通部分が同じ暗号化結果になる場合、それはヒントになり得る)

差分解析

FEALにおける差分解析の有効性(pp30-31)

4ラウンドあるので、1ラウンドずつ見ていく。(p30)

  • 8byte毎に分割した4つの入力を処理しているので、これらの組み合わせ(同じ/違う)を考える
  • ラウンド内にある関数G0,G1は入力が(0,0)の場合に特定の値(0 or 4)を吐き出す。
    • Gn(a,b) = (n or a or b) mod 256 <<< 2
    • G0(0,0) = (0 or 0 or 0) mod 256 <<< 2 = 0 <<< 0 = 0
    • G1(0,0) = (1 or 0 or 0) mod 256 <<< 2 = 1 <<< 2 = 4

x0~x4までの値の組み合わせを工夫して、G0とG1への入力を0にする方法を考える
(考えるというか、誰かが考えた内容を見つけて理解する)

解析手順(p32)

  • 途中にXOR演算が存在する
  • XOR演算の箇所に同じ値が入るようにすれば 0 が作れる

具体的な値を入れて差分をとってみる(pp33- )

(pp33-34)

図中でも書いてくれているが、自分で各値を計算して整理してみたのが以下。
(計算して資料と合わない点は質問ちう)

(x0,x1,x2,x3) → (y0,y1,y2,y3)
とした時、y0~y3の定義は

y0 = G0(x0, y1)
= G0(x0, G1(x0+x1, x2+x3))
y1 = G1(x0+x1, x2+x3)
y2 = G0(y1, x2+x3)
= G0(G1(x0+y1,x2+x3), x2+x3)
y3 = G1(y2, x3)
= G1(G0(G1(x0+y1,x2+x3), x2+x3),x3)

ここで、x0=x1, x2=x3 とすると、x0+x1=0, x2+x3=0のため、

y0 = G0(x0, G1(x0+x1, x2+x3))
= G0(x0, G1(0,0))
= G0(x0, 4)
y1 = G1(0,0)
= 4
y2 = G0(y1,0)
= G0(4,0)
= 16
y3 = G1(16,x3)

スライドだとy2=32だが? →(2/6追記)
bataさんより、本問は3bitシフトなので32で正しいとご指摘いただいた。

確かに、ソースを見たらその通りだった。
何故見ようとしなかったのだろう・・・

def rot3(x):
    return ((x<<3)|(x>>5))&0xff
def gBox(a,b,mode):
    return rot3((a+b+mode)%256)

(追記おわり)

もう一つの入力

(x'0,x'1,x'2,x'3) → (y'0,y'1,y'2,y'3)

については、x,yをx',y'にするだけなので省略

差分は

⊿y0 = G0(x0,4)+G0(x'0,4)
⊿y1 = 4 + 4
= 0 (※一見おかしいけど、 + は xor なので正しい)
⊿y2 = 32 + 32
= 0
⊿y3 = G1(32,x3) + G1(32,x'3)

出力差分がx1, x3のみに依存する=偏る

(pp35-36)

  • X = 0x00000000 (X0=0x00, X1=0x00, X2=0x00, X3=0x00)
  • X' = 0x80800000 (X0=0x80, X1=0x80, X2=0x00, X3=0x00)
y0 = G0(0,4) = 0x10
y'0 = G0(0x80,4) = 0x84 <<< 3 = 0x12 
⊿y0 = 0x02

y3 = y'3 = G1(32, 0)
⊿y3 = 0
  • 特定の⊿xになる入力で⊿yを推測可能 *

(pp37-41)

以上は1ラウンドだけの話
これを4ラウンド続けたらどうなるか。

Y, Y'を計算してから⊿Yを導いてみる

  • X = 0x00000000 (X0=0x00, X1=0x00, X2=0x00, X3=0x00)
  • X' = 0x80800000 (X0=0x80, X1=0x80, X2=0x00, X3=0x00)

1段目入力

左:P1l=X+K4 ⊿P1l=⊿X
右:P1r=K4+K5 ⊿P1r=0

1段目出力

左:C1l=X+K4+f(K0+K4+K5)
⊿C1l = ⊿X = 0x80800000
右;C1r=K4+K5
⊿C1r = 0

2段目入力

左:P2l=P1r ⊿P2l = 0
右:P2r=C1l ⊿P2r = 0x80800000

2段目出力

左:C2l=P2l+f(K1+C1l)
⊿C2l = f(0x80800000) = 0x02000000
右:C2r=P2r
⊿C2r = 0x80800000

3段目入力

左:P3l=C2r ⊿P3l=0x80800000
右:P3r=C2l ⊿P3r=0x02000000

3段目出力

左:C3l=P3l+f(K2+P3r)
⊿C3l = 0x80800000 + ⊿f(K2+P3r) = ???
右:C3r=P3r
⊿C3r = 0x02000000

4段目入力

左:P4l=C3r ⊿P4l=0x02000000
右:P4r=C3l ⊿P4r=不明

4段目出力

左:C4l=P4l+f(K3+P4r)
⊿不明
右:C4r=P4r
⊿P4r=不明

(pp42-46)

最終的な出力から考えてみると、

左出力: Cl = C4l
右出力: Cr = C4r+C4l = P4r + Cl

よって、

P4r=Cr+Cl となる。

つまり、狙った差分の入力X,X'から、C, C'を得られれば、逆算可能。
(そして、C,C'は暗号化結果なので取得可能な値)

(pp47-53)

4つの値(左右入出力差分)がわかったので、Key3が逆算可能

あとは芋づる式に K2, K1 K0, K4, K5 を求める。

K3:
⊿C1= ⊿P4l+f(C4r+K3)+f(C'4r+K3)
=0x02000000+f(Cl+Cr+K3)+f(C'l+C'r+K3)
C4r=Cr+Cl
C4l=Cl
K2:
⊿C3l=⊿P3l+f(C3r+K2)+f(C'3r+K2)
C3r=C4l+f(C4r+K3)
C3l=C4r
K1:
⊿C2l=⊿P2l+f(C2r+K1)+f(C'2r+K1)
C2r=C3l+f(C3r+K2)
=C1+C2+f(C3r+K2)
C2l=C3r
K0:
⊿C1l=⊿P1l+f(C1r+K0)+f(C'1r+K0)
C1r=C2l+f(C2r+K0)
C1l=C2r
K4:
K4=P1l+Pl=C1l+f(C1r+K0)+Pl
K5:
K5=C1r+Pr+K4+Pl

後はこれを実装すれば、きっと・・・(まだやっていない)