Implement till 3.72
parent
4c4d9fe8ba
commit
b4c94edb44
|
@ -187,6 +187,112 @@
|
|||
|
||||
(assert (stream-ref pythagorean-triples 1) '(6 8 10))
|
||||
|
||||
(display "\nex-3.70\n")
|
||||
(display "\nex-3.70 - pairs-weighted\n")
|
||||
|
||||
(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)))
|
||||
((> (apply weight s1car) (apply 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 (pairs-weighted weight s t)
|
||||
(cons-stream
|
||||
(list (stream-car s) (stream-car t))
|
||||
(merge-weighted
|
||||
weight
|
||||
(merge-weighted
|
||||
weight
|
||||
(stream-map (lambda (x) (list (stream-car s) x))
|
||||
(stream-cdr t))
|
||||
(stream-map (lambda (x) (list x (stream-car t)))
|
||||
(stream-cdr s)))
|
||||
(pairs-weighted weight (stream-cdr s) (stream-cdr t)))))
|
||||
|
||||
(define int-pairs-a
|
||||
(stream-filter
|
||||
(lambda (pair) (apply <= pair))
|
||||
(pairs-weighted + integers integers)))
|
||||
|
||||
(assert (take 3 int-pairs-a)
|
||||
'((1 1) (1 2) (1 3)))
|
||||
|
||||
(define integers-b
|
||||
(stream-filter
|
||||
(lambda (n) (not (or (= (remainder n 2) 0)
|
||||
(= (remainder n 3) 0)
|
||||
(= (remainder n 5) 0))))
|
||||
integers))
|
||||
|
||||
(define int-pairs-b
|
||||
(stream-filter
|
||||
(lambda (pair) (apply <= pair))
|
||||
(pairs-weighted
|
||||
(lambda (a b) (+ (* 2 a) (* 3 b) (* 5 a b)))
|
||||
integers-b integers-b)))
|
||||
|
||||
(assert (take 3 int-pairs-b)
|
||||
'((1 1) (1 7) (1 11)))
|
||||
|
||||
(display "\nex-3.71 - ramanujan-numbers\n")
|
||||
|
||||
(define (ramanujan-value a b)
|
||||
(+ (cube a) (cube b)))
|
||||
|
||||
(define ramanujan-canditates
|
||||
(stream-map
|
||||
(lambda (pair) (apply ramanujan-value pair))
|
||||
(stream-filter (lambda (pair) (apply <= pair))
|
||||
(pairs-weighted ramanujan-value integers integers))))
|
||||
|
||||
(define (ramanujan-numbers canditates)
|
||||
(let ((a (stream-car canditates))
|
||||
(b (stream-car (stream-cdr canditates))))
|
||||
(if (= a b)
|
||||
(cons-stream a (ramanujan-numbers (stream-cdr canditates)))
|
||||
(ramanujan-numbers (stream-cdr canditates)))))
|
||||
|
||||
(assert (take 6 (ramanujan-numbers ramanujan-canditates))
|
||||
'(1729 4104 13832 20683 32832 39312))
|
||||
|
||||
(display "\nex-3.72 - triple square-sum numbers\n")
|
||||
|
||||
(define (square-sum-weigth a b)
|
||||
(+ (square a) (square b)))
|
||||
|
||||
(define (consume-equal-square-sums xs)
|
||||
(let ((weight-first (apply square-sum-weigth (stream-car xs)))
|
||||
(weight-second (apply square-sum-weigth (stream-car (stream-cdr xs))))
|
||||
(pair-first (stream-car xs))
|
||||
(pair-second (stream-car (stream-cdr xs))))
|
||||
(if (= weight-first weight-second)
|
||||
(cons (list weight-first pair-first) (consume-equal-square-sums (stream-cdr xs)))
|
||||
(list (list weight-first pair-first)))))
|
||||
|
||||
(define (triple-square-sums)
|
||||
(define (find xs)
|
||||
(let ((sequence (consume-equal-square-sums xs)))
|
||||
(if (not (= (length sequence) 3))
|
||||
(find (stream-cdr xs))
|
||||
(cons-stream
|
||||
sequence
|
||||
(find (drop (length sequence) xs))))))
|
||||
(find
|
||||
(stream-filter
|
||||
(lambda (pair) (apply <= pair))
|
||||
(pairs-weighted square-sum-weigth integers integers))))
|
||||
|
||||
(assert (car (car (car (take 1 (triple-square-sums)))))
|
||||
325)
|
||||
|
||||
; (display "\nex-3.71\n")
|
Loading…
Reference in New Issue