序对的无穷流

(define (interleave s1 s2)
  (if (empty-stream? 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)))))
(define the-pairs (pairs integers integers))
;3.66
(define (pairs-2 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
                 (stream-map (lambda (x) (list x (stream-car t))) (stream-cdr s))
                 (pairs-2 (stream-cdr s) (stream-cdr t))))))
(define the-pairs-2 (pairs-2 integers integers))
(display-n the-pairs-2 20)
;3.69
(define (triples s t u)
  (cons-stream (list (stream-car s) (stream-car t) (stream-car u))
               (interleave
                (triples (stream-cdr s) (stream-cdr t) (stream-cdr u))
                (interleave
                (stream-map (lambda (k) (list (stream-car s) (stream-car t) k)) (stream-cdr u))
                 (stream-map (lambda (jk) (cons (stream-car s) jk)) (pairs (stream-cdr t) (stream-cdr u)))))))
(define the-triples (triples integers integers integers))
(define pythagoras (stream-filter (lambda (ijk)
                                    (= (+ (square (car ijk)) (square (cadr ijk)))
                                       (square (caddr ijk))))
                                  the-triples))
(display-n the-triples 10)
(display-n pythagoras 4)
;;下面是来自schemewiki的版本,两者效率差不多,这样盲搜基本只能等到猴年马月,但是下面这个版本明显简洁很多
(define (triples-2 s t u)
  (cons-stream (list (stream-car s) (stream-car t) (stream-car u))
               (interleave
                (stream-map (lambda (jk) (cons (stream-car s) jk))
                            (stream-cdr (pairs t u)))
                (triples-2 (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
(define the-triples-2 (triples-2 integers integers integers))
(define pythagoras-2 (stream-filter (lambda (ijk)
                                    (= (+ (square (car ijk)) (square (cadr ijk)))
                                       (square (caddr ijk))))
                                  the-triples-2))
(display-n the-triples-2 10)
(display-n pythagoras-2 4)
;3.70
(define (merge-weighted s1 s2 weight)
  (cond ((empty-stream? s1) s2)
        ((empty-stream? s2) s1)
        (else (let ((s1car (stream-car s1)) (s2car (stream-car s2)))
                (cond ((< (weight s1car) (weight s2car)) (cons-stream s1car (merge-weighted (stream-cdr s1) s2 weight))) (else (cons-stream s2car (merge-weighted s1 (stream-cdr s2) weight))))))))
(define (weighted-pairs s1 s2 weight)
  (let ((s1car (stream-car s1))
        (s2car (stream-car s2)))
    (cons-stream (list s1car s2car)
                 (merge-weighted
                  (stream-map (lambda (j) (list s1car j)) (stream-cdr s2))
                  (weighted-pairs (stream-cdr s1) (stream-cdr s2) weight)
                  weight))))
;;a
(define the-pairs-3 (weighted-pairs integers integers
                                    (lambda (ij)
                                      (+ (car ij) (cadr ij)))))
(display-n the-pairs-3 10)
;;b
(define the-pairs-4 (weighted-pairs integers integers
                                    (lambda (ij)
                                      (let ((i (car ij)) (j (cadr ij)))
                                        (+ (* 2 i) (* 3 j) (* 5 i j))))))
(display-n the-pairs-4 10)
(display-n (stream-map (lambda (ij)
                                      (let ((i (car ij)) (j (cadr ij)))
                                        (+ (* 2 i) (* 3 j) (* 5 i j)))) the-pairs-4) 10)
;3.71
(define (ramanujan)
  (define (cube x) (* x x x))
  (define the-weight (lambda (ij)
                       (let ((i (car ij)) (j (cadr ij)))
                         (+ (cube i) (cube j)))))
  (define the-pairs (weighted-pairs integers integers the-weight))
  (define (iter pairs)
    (if (= (the-weight (stream-car pairs))
           (the-weight (stream-car (stream-cdr pairs))))
        (cons-stream (the-weight (stream-car pairs))
                     (iter (stream-cdr pairs)))
        (iter (stream-cdr pairs))))
  (iter the-pairs))
(define the-ramanujan (ramanujan))
(display-n the-ramanujan 5)
;3.72
(define (square-sum-of-3-pairs)
  (define the-weight (lambda (ij)
                       (let ((i (car ij)) (j (cadr ij)))
                         (+ (square i) (square j)))))
  (define the-pairs (weighted-pairs integers integers the-weight))
  (define (iter pairs)
    (let ((scar (stream-car pairs))
          (scadr (stream-car (stream-cdr pairs)))
          (scaddr (stream-car (stream-cdr (stream-cdr pairs)))))
     (if (= (the-weight scar) (the-weight scadr) (the-weight scaddr))
         (cons-stream (cons (the-weight scar) (list scar scadr scaddr)) (iter (stream-cdr pairs)))
         (iter (stream-cdr pairs)))))
  (iter the-pairs))
(define the-square-sum-of-3-pairs (square-sum-of-3-pairs))
(display-n the-square-sum-of-3-pairs 25)