#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-pair-stream stream n)
  (if (= n 0)
      (display 'OK)
      (begin (display (car (stream-car stream)))
             (display ",")
             (display (cadr (stream-car stream)))
             (display ",")
             (display (weight (stream-car stream)))
             (newline)
             (display-pair-stream (stream-cdr stream) (- n 1)))))

(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 (display-stream-x stream n)
  (if (= n 0)
      (display 'OK)
      (let ((x (stream-car stream)))
        (begin (display-x x)
               (display-stream-x (stream-cdr stream) (- n 1))))))

(define (display-x x)
  (define (display-one one)
    (let ((a (car one))
          (b (cadr one)))
      (display "(")
      (display a)
      (display ",")
      (display b)
      (display ")")
      (newline)))
  (let ((a (car x))
        (b (cadr x))
        (c (caddr x)))
    (display (weight a))
    (display ":")
    (display a)
    (display b)
    (display c)
    (newline)))

(define (weight s)
  (let ((x (car s))
        (y (cadr s)))
    (+ (* x x) (* y y))))

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

(define (find-stream stream)
  (let ((a (stream-car stream))
        (b (stream-car (stream-cdr stream)))
        (c (stream-car (stream-cdr (stream-cdr stream)))))
    (if (= (weight a) (weight b) (weight c))
        (cons-stream (list a b c)
                     (find-stream (stream-cdr (stream-cdr (stream-cdr stream)))))
        (find-stream (stream-cdr stream)))))
(define r (find-stream s))
(display-stream-x r 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)
1105:(4 33)(9 32)(12 31)
1250:(5 35)(17 31)(25 25)
ok