exercise 3.68~72

生活リズムがこわれているので(昨日は9時睡眠、5時起床。正確には17時起床だけどね☆)、徹夜して翌日の夜まで起きる→寝る→生活リズムが戻るね!
・・・とかバカな考えを実行中。

後半に行くにつれ分け分からんコードになっているのは使用です。
まぁいいや、おもしろいから晒してしまえ。


ちなみにストリームの表示には

(define (display-stream-n-lines stream n)                                                
  (if (= n 0)                                                                            
      'done                                                                              
      (begin (display-line (stream-car stream))                                          
             (display-stream-n-lines (stream-cdr stream) (- n 1)))))                     
                                                                                         
(define (display-line x)                                                                 
  (display x)                                                                            
  (newline))

みたいな適当に作ったのを用いてます。

ex3.68

interleaveはspecial formじゃないので、引数のparirsが評価されていって無限ループに…

ex3.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)))))

(define pythagorean-triples-stream
  (stream-filter (lambda (x) (= (+ (square (car x)) (square (cadr x)))
                                (square (caddr x))))
                 (triples integers integers integers)))

実行

gosh> (display-stream-n-lines pythagorean-triples-stream 3)                              
(3 4 5)                                                                                  
(6 8 10)                                                                                 
(5 12 13)                                                                                
done

凄く…処理が重たいです。

ex3.70

merge書き換えればいいやっ。と思ってやったら凄く汚いことに
(以降は睡魔との戦い故読みやすさが減少。書いてる今も眠い。今度書き直そう・・・)

(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))))
                 (else
                  (cons-stream s1car
                               (cons-stream s2car
                                            (merge-weighted
                                             weight
                                             (stream-cdr 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 s) x))
                (stream-cdr t))
    (weighted-pairs weight (stream-cdr s) (stream-cdr t)))))

(define (sum-of-pair pair) (+ (car pair) (cadr pair)))
(define b (stream-filter (lambda (x) (not (or (divisible? x 2) (divisible? x 3) (divisible? x 5)))) integers))
(define s (weighted-pairs (lambda (x) (+ (* 2 (car x)) (* 3 (cadr x)) (* 5 (car x) (cadr x)))) b b))
gosh> (display-stream-n-lines s 10)                                                      
(1 1)                                                                                    
(1 7)                                                                                    
(1 11)                                                                                   
(1 13)                                                                                   
(1 17)                                                                                   
(1 19)                                                                                   
(1 23)                                                                                   
(1 29)                                                                                   
(1 31)                                                                                   
(7 7)                                                                                    
done  

関数名とか変数名のやる気の無さは気にしてはいけない。
ちなみにmergeは元の奴を適当に書き換えたらこんなひどいことに・・・
さすがにこればっかりは嫌だったので調べてみると、
applyつかったらもっと綺麗にできると判明。あと、最後のcondのelseの奴は余分というかもっと簡潔にできたな・・・orz

(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 ((< (apply weight s1car) (apply 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))))
                 (else
                  (cons-stream s1car
                               (cons-stream s2car
                                            (merge-weighted
                                             weight
                                             (stream-cdr s1)
                                             (stream-cdr s2))))))))))

とかやるとweightに(lambda (i j) (+ i j))とか渡せて綺麗。

ex3.71

気合がなくなってきたのでサクッと適当に書いた。今は反省している

(define (sum-of-cubes x y)
  (+ (* x x x) (* y y y)))
(define (test weight flag s)
  (let ((s0 (stream-car s))
        (s1 (stream-car (stream-cdr s))))
    (let ((w0 (apply weight s0))
          (w1 (apply weight s1)))
      (if flag
          (test weight (= w0 w1) (stream-cdr s))
          (if (= w0 w1)
              (cons-stream w0
                           (test weight  #t (stream-cdr s)))
              (test weight #f (stream-cdr s)))))))

(define ramanujan-streams
  (test sum-of-cubes #f (weighted-pairs sum-of-cubes integers integers)))

なんだっけか、testって関数は…
(そういえばlinuxのコマンドでtestってあるのを思い出した。すげーどうでもいいけど)

gosh> (display-stream-n-lines ramanujan-streams 6)                                       
1729                                                                                     
4104                                                                                     
13832                                                                                    
20683                                                                                    
32832                                                                                    
39312                                                                                    
done

でいいのかな?

ex3.72

さらに適当に短時間。せめて関数名は考えるべきだったか・・・
ここら辺までくると自分でも何やってたか怪しくなってきた。というか眠い

(define (sum-of-squares x y) (+ (square x) (square y)))

(define (test2 weight count pairs s)
  (let ((s0 (stream-car s))
        (s1 (stream-car (stream-cdr s))))
    (let ((w0 (apply weight s0))
          (w1 (apply weight s1)))
      (if (not (= count 1))
          (if (= w0 w1)
              (test2 weight (+ count 1) (cons s0 pairs)(stream-cdr s))
              (cons-stream (list w0 count (cons s0 pairs))
                           (test2 weight 1  '() (stream-cdr s))))
          (if (= w0 w1)
              (test2 weight 2 (list s0) (stream-cdr s))
              (test2 weight 1 '() (stream-cdr s)))))))

(define z (test2 sum-of-squares 1 '() (weighted-pairs sum-of-squares integers integers)))
(define ex3.72-answer
  (stream-map (lambda (x) (cons (car x) (caddr x)))
              (stream-filter (lambda (x) (= (cadr x) 3)) z)))

test2っておま・・・

gosh> (display-stream-n-lines ex3.72-answer 10)                                          
(325 (1 18) (6 17) (10 15))                                                              
(425 (5 20) (8 19) (13 16))                                                              
(650 (5 25) (11 23) (17 19))                                                             
(725 (7 26) (10 25) (14 23))                                                             
(845 (2 29) (13 26) (19 22))                                                             
(850 (3 29) (11 27) (15 25))                                                             
(925 (5 30) (14 27) (21 22))                                                             
(1025 (1 32) (8 31) (20 25))                                                             
(1250 (5 35) (17 31) (25 25))                                                            
(1300 (2 36) (12 34) (20 30))                                                            
done

でいいでしょう。たぶん。