(sicp44)m3.50~3.59

dead-lockのところ

どうしても興味が持てないので飛ばしました＞＜

stream

• 初めはutil.streamを使用しました。
• sicpのコードの通りに書いても無限ループになってしまいました
  • ここを参考に追加しました。
  • http://sicp.naochan.com/memo.pl?p=stream.scm

(define (prime? n)
  (cond ((<= n 0)
         (error n " is minuss"))
        ((<= n 3) #t)
        ((zero? (remainder n 2)) #f)
        (else
         (let ((sn (sqrt n)))
           (let loop ((n 3))
             (if (> n sn)
                 #t
                 (loop (+ n 2))))))))

;;0は素数なのかな？
;; (map (lambda (x) (cons x (prime? x))) (iota 20 1))

;; ;;面倒
;; (define (sum-primes a b)
;;   (let loop ((count a) (accum 0))
;;     (cond ((> count b) accum)
;;           ((prime? count)
;;            (iter (+ count 1) (+ count accum)))
;;           (else (iter (+ count 1) accum)))))
;; ;;遅い
;; (car (cdr (filter (prime?
;;                    (enumerate-interval 10000 100000)))))

;; (use util.stream)
;;streamが使える
;;(define the-empty-stream stream-null)
	;;挙動がsicpのものとは異なるらしい。

(define (memo-proc proc)
  (let ((already-run? #f) (result #f))
    (lambda ()
      (if (not already-run?)
          (begin
            (set! result (proc))
            (set! already-run? #t)
            result)
          result))))

(define-macro (delay x) `(memo-proc (lambda () ,x)))  ; memoizeあり ※stream-nomemo.scmではOFF
;(define-macro (delay x) `(lambda () ,x))             ; memoizeなし ※stream-nomemo.scmではON
(define (force x) (x))
(define-macro (stream-cons a b) `(cons ,a (delay ,b)))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define stream-null '())
(define stream-null? null?)


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

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

(define (stream-enumerate-interval beg end)
  (if (> beg end)
      stream-null
      (stream-cons beg
             (stream-enumerate-interval (+ beg 1) end))))

;; (define (stream-foreach proc . s)
;;   (if (stream-null? (car s))
;;       'done
;;       (begin (for-each proc (map stream-car s))
;;              (apply stream-foreach (cons proc (map stream-cdr s))))))

(define (stream-foreach proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-foreach proc (stream-cdr s)))))

                    
(define (display-stream s)
  (stream-foreach display-line s))

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

;; (display-stream (stream-enumerate-interval 1 5)
;;                 (stream-enumerate-interval 10 15))

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

(stream-car
 (stream-cdr
  (stream-filter even?
                    (stream-enumerate-interval 10000 10000000))))



;;m3.50

(define (stream-map proc . argstreams)
  (if (stream-null? (stream-car argstreams))
      stream-null
      (stream-cons (apply proc (map stream-car argstreams))
                   ;;(apply stream-map (cons proc (map .....)))だと見にくい
                   (apply (cut stream-map proc <...>)
                          (map stream-cdr argstreams)))))

;;でも、cutにすると処理回数が2倍に増えてしまっているかも？
(define (stream->list s)
  (if (stream-null? s) 
      '()
      (cons (stream-car s) 
            (stream->list (stream-cdr s)))))

(stream->list (stream-map
               (lambda (x) (* x x))
               (stream-enumerate-interval 1 5)))
;; 10:user> => (1 4 9 16)
(stream->list (stream-map * (stream-enumerate-interval 1 5)
                            (stream-enumerate-interval 5 10)))
;; 11:user> => (5 12 21 32)


;;m3.51
(define sei stream-enumerate-interval)
(define (show x) (display-line x) x)
(define x (stream-map show (sei 0 10)))
(stream-ref x 5)
(stream-ref x 7)
;; 8:user> 
;; 1
;; 2
;; 3
;; 4
;; 5=> 5
;; 9:user> 
;; 6
;; 7=> 7

;;m3.52
(define sum 0)

(define (accum x)
  (set! sum (+ x sum)) sum)

(define seq (stream-map accum (sei 1 20)))
(define y (stream-filter even? seq))
;;sum=>6
;; 1, 3, 6(even) -> sum = 6
(define z (stream-filter (lambda (x) (= (remainder x 5) 0)) seq))
;; 6まで飛ばす。
;;sum=>10
;; 6, 10(10mod(5)==0) -> sum = 10
(stream->list z) ;;全部たどられる。
;; 35:user> => (10 15 45 55 105 120 190 210)
;;sum=>210

;;memo-procの最適化をしなかった場合は、yを定義した時点でsum=6
;;その後、zを定義する時にも、(1,2,3のところで)accumが呼ばれて違った値になる。



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

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

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

(define no-sevens
  (stream-filter (lambda (x) (not (divisubile? x 7)))
                 integers))
(stream-ref no-sevens 100)
;; 43:user> => 117

;;fibonachi
(define (fibgen a b)
  (stream-cons a (fibgen b (+ a b))))

(define fibs  (fibgen 0 1))
(stream-ref fibs 10)            
;; 48:user> => 55

;;Sieve of Eratosthenes
(define (sieve s)
  (stream-cons
   (stream-car s)
   (sieve (stream-filter (lambda (x)
                           (not (divisubile? x (stream-car s))))
                         (stream-cdr s)))))

(define primes (sieve (integers-starting-from 2)))
(map (cut stream-ref primes <>) (list 1 10 100))
;; 59:user> => (3 31 547)

(define ones (stream-cons 1 ones))
(define (add-streams s1 s2)  (stream-map + s1 s2))
(define integers (stream-cons 1 (add-streams ones integers)))

;; (map (cut stream-ref integers <>) (iota 10))
;; 65:user> => (1 2 3 4 5 6 7 8 9 10)
(define (f s)
  (map (cut stream-ref s <>) (iota 10)))


(define fibs
  (stream-cons 0
               (stream-cons 1 (add-streams (stream-cdr fibs)
                                           fibs))))
(f fibs)
;; 18:user> => (0 1 1 2 3 5 8 13 21 34)

(define (scale-stream s d)  (stream-map (cut * d <>) s))

(define double (stream-cons 1
                            (scale-stream double 2)))
(f double)
;; 19:user> => (1 2 4 8 16 32 64 128 256 512)

(define primes
  (stream-cons 2
               (stream-filter prime? (integers-starting-from 3))))
(f primes)
;; 21:user> => (2 3 5 7 9 11 13 15 17 19)

;;m3.53
(define s (stream-cons 1 (add-streams s s)))
;;2の冪乗。
(f s)
;; 22:user> => (1 2 4 8 16 32 64 128 256 512)

;; m3.54
(define (mul-streams s1 s2)  (stream-map * s1 s2))
(define factorials
  (stream-cons 1 (mul-streams integers factorials)))
(f factorials)
;; 23:user> => (1 1 2 6 24 120 720 5040 40320 362880)

;; m3.55
;; S->s0, s0+s1, s0+s1+s2
(define (partial-sums s)
  (stream-cons (stream-car s)
               (add-streams (partial-sums s) (stream-cdr s))))
(f (partial-sums integers))
;; 25:user> => (1 3 6 10 15 21 28 36 45 55)

;; m3.56
(define (merge s1 s2)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((< s1car s2car)
                  (stream-cons s1car (merge (stream-cdr s1) s2)))
                 ((> s1car s2car)
                  (stream-cons s2car (merge s1 (stream-cdr s2))))
                 (else
                  (stream-cons s1car
                               (merge (stream-cdr s1)
                                      (stream-cdr s2)))))))))

(define S (stream-cons 1 (merge (merge (scale-stream S 2)
                                       (scale-stream S 3))
                                (scale-stream S 5))))
(f S)
;; 24:user> => (1 2 3 4 5 6 8 9 10 12)


;; m3.57
;;名前呼びだと毎回最初から呼ばれてしまう。
;; (stream-ref fibs (+ n 1))の計算回数を(f n+1)とかくと
;; (fi n+1) = (fi n) + (fi n-1) + 1

;; m3.58
(define (expand num den radix)
   (let ((nr (* num radix)))
     (stream-cons
     (quotient nr den)
     (expand (remainder nr den) den radix))))

(f (expand 1 7 10))
;; 27:user> => (1 4 2 8 5 7 1 4 2 8)
(f (expand 3 8 10))
;; 28:user> => (3 7 5 0 0 0 0 0 0 0)

;; m3.59
;; a.
(define (integrate-series s)
  (stream-map / s integers))

;; b.
(define exp-series
  (stream-cons 1 (integrate-series exp-series)))
;; 37:user> => (1 1 1/2 1/6 1/24 1/120 1/720 1/5040 1/40320 1/362880)
(define cosine-series
  (stream-cons 1 (stream-map (lambda (x) (* -1 x)) (integrate-series sine-series))))
(define sine-series
  (stream-cons 0 (stream-map * (integrate-series cosine-series))))
(f cosine-series)
;; 40:user> => (1 0 -1/2 0 1/24 0 -1/720 0 1/40320 0)
(f sine-series)
;; 41:user> => (0 1 0 -1/6 0 1/120 0 -1/5040 0 1/362880)