a

3.53.scm

(load "./stream.scm")


(define (average x y) (/ (+ x y) 2))

(define (sqrt-improve guess x)
  (average guess (/ x guess)))

(define (sqrt-stream x)
  (define guesses
    (cons-stream 1.0
                 (stream-map (lambda (guess)
                               (sqrt-improve guess x))
                             guesses)))
  guesses)

;(display-stream (sqrt-stream 2))


(define (pi-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (pi-summands (+ n 2)))))

(define pi-stream
  (scale-stream (partial-sums (pi-summands 1)) 4))

;(display-stream pi-stream)


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

(define (euler-transform s)
  (let ((s0 (stream-ref s 0))
        (s1 (stream-ref s 1))
        (s2 (stream-ref s 2)))
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

;; okasii
;(display-stream (euler-transform pi-stream))


(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))

;; motto okasii
;(display-stream (accelerated-sequence euler-transform pi-stream))


(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(define integers (integers-starting-from 1))

(define (interleave s1 s2)
  (if (stream-null? s1)
    s2
    (cons-stream (stream-car s1)
                 (interleave s2 (stream-cdr s1)))))

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

;(display-stream (pairs integers integers))

q3.63

q3.63.scm

; 局所変数を用いないとメモ化されない。
; memo-procを使わないなら効率はおよそかわらない。

(define (sqrt-stream x)
  (cons-stream 1.0
               (stream-map (lambda (quess)
                             (sqrt-improve guess x))
                           (sqrt-stream x))))

q3.64.scm

(load "./3.53.scm")

(define (abs x)
  (if (>= x 0) 
    x 
    (* -1 x)))

(define (stream-limit s error-limit)
  (let ((s0 (stream-ref s 0))
        (s1 (stream-ref s 1)))
    (if (< (abs (- s0 s1)) error-limit)
      s1
      (stream-limit (stream-cdr s) error-limit))))

(define (sqrt x tolerance)
  (stream-limit (sqrt-stream x) tolerance))

(print (sqrt 2 0.000000001))

q3.65.scm

(load "./3.53.scm")

(define (ln2-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (ln2-summands (+ n 1)))))

(define ln2-stream
  (partial-sums (ln2-summands 1)))

(display-stream ln2-stream)

q3.66.scm

;(x,y)
;(1,1) = 1
;(1,a) = 2*(a-1)
;(a,a) = 2^a - 1
;(a,b) = (2^(x-1))*(1+2(y-x))-1

(define (pow x y)
  (if (= y 0)
    1
    (* x (pow x (- y 1)))))

(define (pairs-value x y)
  (cond
    ((and (= x 1) (= y 1)) 1)
    ((= x 1) (* 2 (- y 1)))
    ((= x y) (- (pow 2 x) 1))
    (else (- (* (pow 2 (- x 1)) (+ 1 (* 2 (- y x)))) 1))))

(print (pairs-value 3 3))

(load "./3.53.scm")

(define (integers-starting-from-raise n)
  (if (> n 100)
    (raise "stop")
    (cons-stream n (integers-starting-from-raise (+ n 1)))))

(define integers-r (integers-starting-from-raise 1))


;(display-stream (pairs integers-r integers-r))

q3.67.scm

(load "./3.53.scm")

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

(display-stream (pairs-a integers integers))

q3.68.scm

(load "./3.53.scm")

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

(display-stream (pairs-3 integers integers))

stream.scm

(define (divisible? x y) (= (remainder x y) 0))

(define the-empty-stream '())

(define (stream-null? stream)
  (eq? the-empty-stream stream))

(define (memo-proc proc)
  (let ((already-run? false)
        (result false))
    (lambda ()
      (if (not already-run?)
          (begin (set! result (proc))
                 (set! already-run? true)
                 result)
          result))))
  
(define-syntax delay
  (syntax-rules ()
    ((_ x) (lambda () x))))

(define (force proc)
  (proc))

(define-syntax cons-stream
  (syntax-rules ()
    ((cons-stream head tail)
     (cons head (delay tail)))))

(define (stream-car stream)
  (car stream))

(define (stream-cdr stream)
  (force (cdr stream)))

(define (stream-ref stream n)
  (if (= n 0)
      (stream-car stream)
      (stream-ref (stream-cdr stream) (- n 1))))

;(define (stream-map proc stream)
;  (if (stream-null? stream)
;      '()
;      (cons-stream (proc (stream-car stream))
;                   (stream-map proc (stream-cdr stream)))))

;; ex3.50 p225
(define (stream-map proc . arguments)
  (if (null? (car arguments))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car arguments))
       (apply stream-map
              (cons proc (map stream-cdr arguments))))))

(define (stream-for-each proc stream)
  (if (stream-null? stream)
      'done
      (begin (proc (stream-car stream))
             (stream-for-each proc (stream-cdr stream)))))

(define (stream-take stream n)
  (if (= n 0)
      '()
      (cons-stream (stream-car stream)
                   (stream-take (stream-cdr stream) (- n 1)))))

(define (display-line x)
  (newline)
  (display x))

(define (display-stream stream)
  (stream-for-each display-line stream))

(define (stream-enumerate-interval low high)
  (if (> low high)
      the-empty-stream
      (cons-stream
       low
       (stream-enumerate-interval (+ low 1) high))))

(define (stream-filter pred stream)
  (cond ((stream-null? stream) the-empty-stream)
        ((pred (stream-car stream))
         (cons-stream (stream-car stream)
                      (stream-filter pred
                                     (stream-cdr stream))))
        (else (stream-filter pred (stream-cdr stream)))))

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(define integers (integers-starting-from 1))

(define (sieve stream)
  (cons-stream
   (stream-car stream)
   (sieve (stream-filter
           (lambda (x)
             (not (divisible? x (stream-car stream))))
           (stream-cdr stream)))))

(define primes (sieve (integers-starting-from 2)))

(define (add-streams s1 s2)
  (stream-map + s1 s2))

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

(define (scale-stream stream factor)
  (stream-map (lambda (x) (* factor x)) stream))

;;; p230 ex3.54
(define factorials (cons-stream 1 (mul-streams factorials (integers-starting-from 2))))

;;; p230 ex3.55
(define (partial-sums stream)
  (let ((sum 0))
    (stream-map (lambda (x)
                  (set! sum (+ sum x))
                  sum)
                stream)))