SICPゼミ第33回

練習問題4.1

左から右

(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (let ((val (eval (first-operand exps) env)))
        (cons val
          (list-of-values (rest-operands exps) env)))))

右から左

(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (let ((val (list-of-values (rest-operands exps) env)))
        (cons (eval (first-operand exps) env) val))))

by pine

SICPゼミ第32回

練習問題3.81

(define (rand-stream stream)
  (define (rand-stream-iter stream mt)
    (if (stream-null? stream)
        the-empty-stream
        (let ((message (stream-car stream)))
          (if (eq? message 'generate)
              (cons-stream (mt-random-integer mt 1000) (rand-stream-iter (stream-cdr stream) mt))
              (let ((new-mt (make <mersenne-twister> :seed message)))
                (cons-stream (mt-random-integer new-mt 1000) (rand-stream-iter (stream-cdr stream) new-mt)))))))
  (rand-stream-iter stream (make <mersenne-twister> :seed (sys-time))))

(define (rand-stream stream)
  (define (rand-stream-iter stream last)
    (if (stream-null? stream)
        the-empty-stream
        (let ((message (stream-car stream)))
          (if (eq? message 'generate)
              (let ((new-num (rand-update last)))
                (cons-stream new-num (rand-stream-iter (stream-cdr stream) new-num)))
              (cons-stream message (rand-stream-iter (stream-cdr stream) message))))))
  (rand-stream-iter stream (rand)))

by pine

練習問題3.82

racket だと (random) で 0~1 の乱数が出てくるので(0,0), (1,1) の長方形でやりました。

(define (estimate-integral P x1 x2 y1 y2)
  (define (estimate-integral-iter passed failed)
    (define (guessed-value passed failed)
      (let ((rectangle-area (* (- x2 x1) (- y2 y1))))
        (* 4 (* rectangle-area (/ (* passed 1.0) (+ passed failed))))))
    (define (next passed failed)
      (cons-stream
       (guessed-value passed failed)
       (estimate-integral-iter passed failed)))
    (let ((x (random))
          (y (random)))
      (if (P x y)
          (next (+ passed 1) failed)
          (next passed (+ failed 1)))))
  (estimate-integral-iter 0 0))
(define (P x y)
    (< (+ (* (- x 0.5) (- x 0.5)) (* (- y 0.5) (- y 0.5))) 0.25))

実行結果

by tube

SICPゼミ第31回

練習問題3.77

(define (integral delayed-integrand initial-value dt)
  (cons-stream
   initial-value
   (let ((integrand (force delayed-integrand)))
     (if (stream-null? integrand)
       the-empty-stream
       (integral (delay (stream-cdr integrand))
                 (+ (* dt (stream-car integrand))
                    initial-value)
                 dt)))))

by tube

練習問題3.78

(define (solve-2nd a b y0 dy0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (add-streams (scale-stream dy a)
                          (scale-stream y b)))
  y)

下のコードで動かしてみた。cos になればOK

(display-stream-count (solve-2nd 0 -1 1 0 0.001) 10000)

結果

やったー！

by tube

練習問題3.79

(define (solve-2nd f y0 dy0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (stream-map f y))
  y)

結果。sin になればOK

(display-stream-count (solve-2nd (lambda (y) (* y -1)) 0 1 0.001) 10000)

やったーー！
by tube

練習問題3.80

(define (solve-2-1st-ode f g s0 t0 dt)
  (define s (integral (delay ds) s0 dt))
  (define t (integral (delay dtt) t0 dt))
  (define ds (stream-map f s t))
  (define dtt (stream-map g s t))　　
  (cons s t)
)

(define (RLC R L C dt)
  (define (f v i) (- (/ i C)))
  (define (g v i)  (- (/ v L) (/ (* R i) L)))
  (define (return vc0 il0)
    (solve-2-1st-ode f g vc0 il0 dt)
    )
  return)

by dolicas

(display-stream-count ((RLC 1 1 0.2 0.1) 10 0) 500)

(define (rlc-circuit R L C dt)
  (define (get-initial Vc0 iL0)
    (define Vc (integral (delay dVc) Vc0 dt))
    (define dVc (scale-stream iL (- (/ 1 C))))
    (define diL (add-streams (scale-stream Vc (/ 1 L)) (scale-stream iL (- (/ R L))) ))
    (define iL (integral (delay diL) iL0 dt))
    (cons Vc iL))
  get-initial)

なぜか動かない。

SICPゼミ第30回

練習問題3.73

(define (RC R C dt)
  (define (calc i v0)
    (add-streams (scale-stream i R) (integral (scale-stream i (/ 1 C)) v0 dt)))
  calc)

民主主義しゅき〜〜（ドナルド・トランプ）

練習問題3.74

(define (sign-change-detector now last)
  (if (> (* now last) 0)
      0
      (if (= last 0)
          (if (>= now 0) 0 -1)
          (if (< last 0) 1 0))))
              

(define zero-crossings
  (stream-map sign-change-detector
              sense-data
              (cons-stream 0 sense-data)))

練習問題3.75

(define (make-zero-crossings input-stream last-value last-average)
  (let ((avpt (/ (+ (stream-car input-stream)
    last-value)
    2)))
  (cons-stream
    (sign-change-detector avpt last-average)
    (make-zero-crossings
      (stream-cdr input-stream) (stream-car input-stream) avpt))))

by dolicas

練習問題3.76

(define (smooth input-stream)
  (cons-stream (/ (+ (stream-car input-stream)
                     (stream-car (stream-cdr input-stream)))
                  2)
               (smooth (stream-cdr input-stream))))

SICPゼミ第29回

練習問題3.67

(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (interleave
     (stream-map (lambda (x) (list (stream-car t) x))
                 (stream-cdr s))
     (stream-map (lambda (x) (list x (stream-car t)))
                 (stream-cdr s)))
    (pairs (stream-cdr s) (stream-cdr t)))))

実行結果

> (display-stream-count (pairs integers integers) 10)

(1 1)
(1 2)
(2 2)
(2 1)
(2 3)
(1 3)
(3 3)
(3 1)
(3 2)
(1 4)

by tube

練習問題3.68

無限ループする。

関数呼び出しをするとまず引数が評価されるので、Reasonerの(pairs s t)をすると定義内のinterleaveの第2引数である(pairs (stream-cdr s) (stream-cdr t))が評価される。これはpairsの呼び出しの無限ループを引き起こす。

by dolicas

練習問題3.69

(define (triples s t u)
  (cons-stream
    (list (stream-car s) (stream-car t) (stream-car u))
    (interleave
      (stream-map (lambda (x) (cons (stream-car s) x)) (stream-cdr (pairs t u)))
      (triples (stream-cdr s) (stream-cdr t) (stream-cdr u))
      )
    )
  )

by dolicas

(define pythagoras
  (stream-filter
   (lambda (triple)
     (= (+ (square (car triple))
           (square (cadr triple)))
        (square (caddr triple))))
   (triples integers integers integers)))

実行結果

> (display-stream-count pythagoras 4)

(3 4 5)
(6 8 10)
(5 12 13)
(9 12 15)

by tube

練習問題3.70

(define (merge-weighted s1 s2 weight)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
          (let ((s1car (stream-car s1))
                (s2car (stream-car s2)))
            (if (weight s1car s2car)
                (cons-stream
                  s1car
                  (merge-weighted (stream-cdr s1) s2 weight))
                (cons-stream
                  s2car
                  (merge-weighted s1 (stream-cdr s2) weight)))))))

(define (weighted-pairs s t weight)
  (cons-stream
    (list (stream-car s) (stream-car t))
    (merge-weighted
      (stream-map (lambda (x) (list (stream-car s) x))
                  (stream-cdr t))
      (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
      weight)))

(define (weight1 p1 p2)
  (let ((s1 (+ (car p1) (cadr p1)))
        (s2 (+ (car p2) (cadr p2))))
    (< s1 s2)))

(define (weight2 p1 p2)
  (let ((s1 (+ (* (car p1) 2) (* (cadr p1) 3) (* (car p1) (cadr p1) 5)))
        (s2 (+ (* (car p2) 2) (* (cadr p2) 3) (* (car p2) (cadr p2) 5))))
    (< s1 s2)))

(define a (weighted-pairs integers integers weight1))

(define b
  (stream-filter
    (lambda (x)
      (and (not (= (remainder (car x) 2) 0))
           (not (= (remainder (car x) 3) 0))
           (not (= (remainder (car x) 5) 0))
           (not (= (remainder (cadr x) 2) 0))
           (not (= (remainder (cadr x) 3) 0))
           (not (= (remainder (cadr x) 5) 0))))
    (weighted-pairs integers integers weight2)))

by pine

(define (merge-weighted weight s1 s2)
  (cond (( stream-null? s1) s2)
        (( stream-null? s2) s1)
        (else
         (let (( s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((<= (weight s1car) (weight s2car))
                  (cons-stream
                   s1car
                   (merge-weighted weight (stream-cdr s1) s2)))
                 ((> (weight s1car) (weight s2car))
                  (cons-stream
                   s2car
                   (merge-weighted weight s1 (stream-cdr s2)))))))))
(define (weighted-pairs weight s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (merge-weighted
    weight
    (stream-map (lambda (x) (list (stream-car t) x))
                (stream-cdr s))
    (weighted-pairs weight (stream-cdr s) (stream-cdr t)))))

実際に問題解いた
a

> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (car pair)
         (cadr pair)))
    integers integers) 10)

(1 1)
(1 2)
(1 3)
(2 2)
(1 4)
(2 3)
(1 5)
(2 4)
(3 3)
(1 6)

b

> (define s (stream-filter
             (lambda (x)
               (not (or (= (remainder x 2) 0)
                        (= (remainder x 3) 0)
                        (= (remainder x 5) 0)))) integers))
> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (* 2(car pair))
         (* 3 (cadr pair))
         (* 5 (car pair) (cadr pair)))) s s) 10)

(1 1)
(1 7)
(1 11)
(1 13)
(1 17)
(1 19)
(1 23)
(1 29)
(1 31)
(7 7)

by tube

練習問題3.71

(define (weight1 p1)
  (+ (cube (car p1)) (cube (cadr p1))))

(define (cube x) (* x x x))

(define (ramanujan)
  (define (pair-cube l) (+ (cube (car l)) (cube (cadr l))))
  (define (ramanujan-iter stream)
    (let ((s1 (pair-cube (stream-car stream)))
      (s2 (pair-cube (stream-car (stream-cdr stream)))))
    (if (= s1 s2)
      (stream-cons s1 (ramanujan-iter (stream-cdr stream)))
      (ramanujan-iter (stream-cdr stream)))))
  (ramanujan-iter (weighted-pairs weight1 integers integers)))

実行結果

> (define x (ramanujan))
> (display-stream-count x 15)
1729
4104
13832
20683
32832
39312
40033
46683
64232
65728
110656
110808
134379
149389
165464

by dolicas

練習問題3.72

(define (pseudo-ramanujan)
  (define (pseudo-iter stream)
    (let ((s1 (pair-square (stream-car stream)))
          (s2 (pair-square (stream-car (stream-cdr stream))))
          (s3 (pair-square (stream-car (stream-cdr (stream-cdr stream))))))
      (if (and (= s1 s2) (= s2 s3))
          (cons-stream s1 (pseudo-iter (stream-cdr stream)))
          (pseudo-iter (stream-cdr stream)))))
  (pseudo-iter (weighted-pairs pair-square integers integers)))

> (display-stream-count (pseudo-ramanujan) 10)

325
425
650
725
845
850
925
1025
1105
1105

by tube

SICPゼミ第28回

練習問題3.63

Reasoner の方法では毎回新しい sqrt-stream (lambda closure の中) を作り出してひとつめの項から計算し直しているので、実質メモ化を行っていないのと同じで、無駄な計算が多くなる。

by tube

SICPゼミ第27回

練習問題3.53

1,2,4,8,16....

練習問題3.54

(define (mul-streams s1 s2) (stream-map * s1 s2))

(define factorials
  (cons-stream 1 (mul-streams (stream-cdr integers) factorials)))