#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)
1729
4104
13832
20683
32832
39312
40033
46683
64232
65728
ok