What is the real answer to SICP 3.57

(cddddr fibs) (cddr (add-streams (cdr fibs) fibs)) (cddr (stream-map + (cdr fibs) fibs))) (cddr ((+ 1 0) . {stream-map + (cddr fibs) (cdr fibs)})) (cdr (stream-map + (cddr fibs) (cdr fibs))) (cdr (stream-map + ((+ 1 0) . {stream-map + (cddr fibs (cdr fibs)}) (cdr fibs)) (cdr (+ 1 1) . {stream-map + (stream-map + (cddr fibs) (cdr fibs)) (cddr fibs)}) (stream-map + (stream-map + (cddr fibs) (cdr fibs)) (cddr fibs)) (stream-map + (stream-map + ((+ 1 0) . {stream-map + (cddr fibs) (cdr fibs)}) (cdr fibs)) (cddr fibs) (stream-map + (stream-map + ((+ 1 0) . {stream-map + (cddr fibs) (cdr fibs)}) (1 . {stream-map + (cdr fibs) fibs)})) (cddr fibs)) (stream-map + ((+ 1 1) . {stream-map + (stream-map + (cddr fibs) (cdr fibs)) (stream-map + (cdr fibs) fibs)}) ((+ 1 0) . {stream-map + (cddr fibs) (cdr fibs)}) (+ 2 1) . {stream-map + (stream-map + (stream-map + (cddr fibs) (cdr fibs)) (stream-map + (cdr fibs) fibs))) (stream-map + (cddr fibs) (cdr fibs))}

#lang racket (define-syntax-rule (delay f) (lambda () f)) (define (force f) (f)) (define stream-null? null?) (define the-empty-stream '()) (define-syntax-rule (cons-stream a b) (cons a (delay b))) (define stream-car car) (define (stream-cdr stream) (force (cdr stream))) (define (add-streams s1 s2) (define (add x y) (begin (display "Adding ") (display x) (display " + ") (display y) (newline) (+ x y))) (stream-map add s1 s2)) (define (stream-map proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (cons-stream (apply proc (map stream-car argstreams)) (apply stream-map (cons proc (map stream-cdr argstreams)))))) (define (stream-ref s n) (if (= n 0) (stream-car s) (stream-ref (stream-cdr s) (- n 1)))) (define fibs (cons-stream 0 (cons-stream 1 (add-streams (stream-cdr fibs) fibs)))) (stream-ref fibs 4)

[2021-05-05 Note: this differs dramatically from an earlier, 2019 version of this answer. The actual result is the same!]

Using some kind of conventional maths notation rather than expressing everything in Scheme as I find that easier for thinking about, the stream of Fibonacci numbers, f, looks like this:

f = (0, 1, f(0) + f(1), f(1) + f(2), ..., f(n-1) + f(n-2), ...)

In this expression I've expanded out the add-streams function in the obvious way.

So now, if there is no memoization, it's just a matter of counting to compute the number of additions involved in computing f(n). Well the number of additions is the number of additions in the stream itself + the number of additions in the two component streams we're adding.

the number of additions in the stream itself is 0 if n <= 1 otherwise n - 1, which you can see from just looking at the stream above and counting the '+' symbols;
the number of additions in the component streams is 0 if n <= 1 (no component streams) else the sum of number of additions to compute f(n-1) and f(n-2).

Or:

a = (0, 0, 1 + a(0) + a(1), 2 + a(1) + a(2), ..., n-1 + a(n-1) + a(n-2), ...)

And this is exponential in n of course. It's easy to instrument the code to count the number of additions and to write this a function to check they agree, which they do.

I find it much harder to reason about the case where f is memoized (which really means when force is memoizing) because there is state hiding in all the dark corners. But the trick is, I think, to remember that streams get accessed linearly: to compute f(n) I must already have computed f(n-1). And once that's done, then computing it again is a lookup: there are no additions involved. So this time a is

the number of additions in the stream itself, which is 0 if n <= 1 otherwise n - 1 as before;
plus the number of additions in the component streams, which is zero since they've already been computed.

Or:

a = (0, 0, 1, 2, ..., n-1, ...)

which is linear in n, obviously.

Below is some Racket code which implements enough of streams to be dangerous, with memoization control over delay (called retard) and force (called advance), as well as call-counting support: with this you can easily empirically check the above results. fc computes the nth fib and counts calls to +, a and b are the non-memoized and memoized versions of a above.

#lang racket

;;;; advance and retard are force & delay
;;; memoization can be controlled
;;;

(define advance-memoizes? (make-parameter #t))

(define not-memoized (cons #f #f))

(define-syntax-rule (retard form)
  (let ([memo not-memoized])
    (thunk
     (if (advance-memoizes?)
         (begin
           (when (eq? memo not-memoized)
             (set! memo form))
           memo)
         form))))

(define (advance retarded)
  (retarded))

;;;; mλ is a restricted memoizing λ
;;; Again memoization can be controlled
;;;

(define mλ-memoizes? (make-parameter #t))

(define-syntax-rule (mλ (arg) form)
  (let ([memos (make-hash)])
    (λ (arg)
      (if (mλ-memoizes?)
          (hash-ref! memos arg (thunk form))
          form))))


;;;; Streams
;;; functions are prefixed with s

(define-values (snull snull?)
  (values '() null?))

(define-syntax-rule (scons this that)
  (cons this (retard that)))

(define scar car)

(define (scdr stream)
  (advance (cdr stream)))

(define (sref s n)
  (if (= n 0)
      (scar s)
      (sref (scdr s) (- n 1))))

(define (smap p . streams)
  (let smap* ([ss streams])
    (if (memf snull? ss)
        snull
        (scons
         (apply p (map scar ss))
         (smap* (map scdr ss))))))
                
;;;; Counting function calls
;;;

(define (call/counted f . gs)
  ;; call f with 2 arguments for each function in gs:
  ;; - a function which is equivalent to the element of g
  ;; - and a function which will return the call count of that function.
  ;; Recursive calls to the gs are not counted
  (let cc-loop ([gt gs]
                [fs '()])
    (match gt
      ['() (apply f (reverse fs))]
      [(cons g gtt)
       (let ([gc 0])
         (cc-loop gtt (list*
                       (thunk gc)
                       (λ args
                         (set! gc (+ gc 1))
                         (apply g args))
                       fs)))])))

;;;; Counting fibs
;;;

(define (fc n #:memoize? (memoize? #t))
  ;; Return nth fib and number of calls to +
  (parameterize ([advance-memoizes? memoize?])
    (call/counted
     (λ (+/counted +-count)
       (define fibs
         (scons 0
                (scons 1
                       (smap +/counted (scdr fibs)
                             fibs))))
       (values (sref fibs n)
               (+-count)))
     +)))
            
(define a
  ;; unmemoized count (but this needs to be memoized!)
  (mλ (m)
    (cond
      [(or (= m 0) (= m 1)) 0]
      [(> m 1)
       (+ (- m 1)
          (a (- m 1))
          (a (- m 2)))]
      [else
       (error 'a "negative creep")])))

(define (b m)
  ;; memoized count
  (floor (- m 1)))

Recommended topics

Hot tags