SICP Practice

Practice 3.71

#lang planet neil/sicp

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

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

(define (stream-map proc . args)
  (if (stream-null? (car args))
      the-empty-stream
      (cons-stream (apply proc (map stream-car args))
                   (apply stream-map (cons proc
                                           (map stream-cdr args))))))

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

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1
                              (add-stream ones integers)))

(define (display-stream stream n)
  (if (= n 0)
      (display 'OK)
      (begin (display (stream-car stream))
             (newline)
             (display-stream (stream-cdr stream) (- n 1)))))

(define (merge-weighted s t weight)
  (let ((scar (stream-car s))
        (tcar (stream-car t)))
    (cond ((> (weight scar) (weight tcar))
           (cons-stream tcar
                        (merge-weighted s (stream-cdr t) weight)))
          ((< (weight scar) (weight tcar))
           (cons-stream scar
                        (merge-weighted (stream-cdr s) t weight)))
          (else
           (cons-stream scar
                        (cons-stream tcar
                                     (merge-weighted (stream-cdr s) (stream-cdr t) 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 (weight s)
  (let ((x (car s))
        (y (cadr s)))
  (+ (cube x) (cube y))))

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

(define s (weighted-pairs integers integers weight))

(define (find-stream stream)
    (let ((a (stream-car stream))
          (b (stream-car (stream-cdr stream))))
      (if (= (weight a) (weight b))
          (cons-stream (weight a)
                       (find-stream (stream-cdr (stream-cdr stream))))
          (find-stream (stream-cdr stream)))))

(define ramanujan-stream
  (find-stream s))

(display-stream ramanujan-stream 10)

result

1729
4104
13832
20683
32832
39312
40033
46683
64232
65728
ok