Flattening lazy list of lazy lists in Scheme via higher-order accumulation procedure

Question

I'm trying to find an implementation which flattens a lazy list of lazy lists using interleave and lz-lst-accumulate which are procedures that I wrote. This is the code so far:

(define lz-lst-accumulate
  (lambda (op initial lz)
    (if (empty? lz)
      initial
      (op (head lz)
        (lambda() (lz-lst-accumulate op initial (tail lz)))))))

(define interleave
  (lambda (lz1 lz2)
    (if (empty? lz1)
      (lz2)
      (cons (head lz1)
        (interleave (lz2) (lambda() (tail lz1)))))))

(define all-div-from-flattened
     (lambda (lower)
       (lz-lst-accumulate interleave '() (all-div-from lower))))

(define take
  (lambda (lz-lst n)
    (if (= n 0)
      (list)
      (cons (car lz-lst)
        (take (tail lz-lst) (sub1 n))))))

(define head
  (lambda (lz)
    (car lz)))

(define tail
  (lambda (lz-lst)
    ((cdr lz-lst))))

(define lz-lst-map
  (lambda (f lz)
    (if (empty? lz)
      lz
      (cons (f (head lz))
        (lambda () (lz-lst-map f (tail lz)))))))

; Signature: all-div-from (low)
; Type: [Number -> Lazy-list]
; Purpose: return a lazy-list of lazy-lists. The nested lazy-lists 
;          correspond to the integers greater than lower in an 
;          increasing order. Each nested lazy-list is the list of 
;          all integers divisible by i for some i>=lower.
; Pre-conditions: low is an integer
; Tests: > (define lz3 (all-div-from 7))
;        > (take lz3 3)
;        '((7 . #<procedure>) (8 . #<procedure>) (9 . #<procedure>))
;        > (take (head lz3) 3)
;        '(7 14 21)
;        > (take (head (tail lz3)) 3)
;        '(8 16 24)

(define all-div-from
    (lambda(lower)
      (cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
            (lambda() (all-div-from (add1 lower))))))


; Signature: div-from (low int)
; Type: [[Number*Number]-> Lazy-list]
; Purpose: return the lazy-list of all integers that 
;          are larger than low and divisible by int
; Pre-conditions: int > low
; Tests: > (define lz1 (div-from 5 12))
;        > (take lz1 3)
;        '(12 24 36)
;        > (define lz2 (div-from 7 10))
;        > (take lz2 4)
;        '(10 20 30 40)
(define div-from
  (lambda (lower int)
    (lz-lst-filter (lambda(x) (> x (- lower 1))) 
      (lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))

(define integers-from
  (lambda (n) (cons n
    (lambda () (integers-from (+ 1 n))))))

(define lz-lst-filter
  (lambda (p lz)
    (cond ((empty? lz) lz)
          ((p (head lz)) 
             (cons (head lz) 
               (lambda () (lz-lst-filter p (tail lz)))))
          (else (lz-lst-filter p (tail lz))))))

The procedure all-div-from receives a lower bound low and returns a lazy-list of lazy-lists. Each lazy list in it is made by div-from which receives a lower bound low and an integer int > low, and returns the lazy-list of all integers that are larger than low and divisible by int.

An example of input and the correct output:

 > (take (all-div-from-flattened 7) 10)
        '(7 8 14 9 21 16 28 10 35 24)

But when I try this line in the interpreter:

> (take (all-div-from-flattened 3) 3)

it gets into an infinite loop.

My implementation must use lz-lst-accumulate, interleave and all-div-from-flattend procedures.

Any suggestions on how to make it work?

Answer 1

Your interleave does not produce a lazy list; it produces an ordinary list: it uses cons with two arguments, with the second argument not wrapped in a lambda. So the cons forces the 2nd argument through, causing the run-away evaluation:

(define interleave
  (lambda (lz1 dlz2)    ; "delayed" lz2
    (if (empty? lz1)
      (dlz2)
      (cons (head lz1)
            ; here:
            (interleave (dlz2) (lambda () (tail lz1)))))))

(define lz-lst-accumulate
  (lambda (op initial lz)
    (if (empty? lz)
      initial
      (op (head lz)
          (lambda () (lz-lst-accumulate op initial (tail lz)))))))

(all-div-from lower) produces correct output, ( (lower . <proc1>) . <proc2> ), but the call to (lz-lst-accumulate interleave '() (all-div-from lower)) reduces as

(interleave [lower . <proc1>]
            (lambda () (lz-lst-accumulate interleave '() (<proc2>))))

and that reduces as

(cons lower 
      (interleave (lz-lst-accumulate interleave '() (<proc2>))
                  (lambda () (<proc1>))))

while it has to reduce as

(cons lower 
      (lambda () (interleave ....)))

to produce a lazy list.

The obvious (now) solution is to add that missing lambda:

(define interleave
  (lambda (lz1 lz2)
    (if (empty? lz1)
      (lz2)
      (cons (head lz1)
            (lambda () (interleave (lz2) (lambda() (tail lz1))))))))

Now it runs correctly:

(take (all-div-from-flattened 7) 10)
;Value 12: (7 8 14 9 21 16 28 10 35 24)

---

You could much simplify your code by introducing

(define integers-from-by
  (lambda (n d) (cons n
    (lambda () (integers-from (+ n d) d)))))

then,

;(define div-from
;  (lambda (lower int)
;    (lz-lst-filter (lambda(x) (> x (- lower 1))) 
;      (lz-lst-map (lambda(x) (* x int)) (integers-from 1)))))

(define mults-from-of    ; n in [int, 2*int ..], n >= lower
  (lambda (lower int)
    (let ((x (* (quotient (+ lower (- int 1)) int) int)))
      (integers-from-by x int))))

You could also have

(define mults-above-of   ; n in [int, 2*int ..], n > lower
  (lambda (lower int)
    (let ((x (* (+ (quotient lower int) 1) int)))
      (integers-from-by x int))))

Next,

; (define all-div-from
;    (lambda(lower)
;      (cons (lz-lst-map (lambda(x) (* x lower)) (div-from 1 1))
;            (lambda() (all-div-from (add1 lower))))))

(define all-mults-from
  (lambda (lower)
    (lz-lst-map (lambda (n) (mults-from-of n n))
                            ; or just (integers-from-by n n)
                (integers-from-by lower 1))))

If you change your interleave to combine the streams in order, and switch to mults-above-of in the all-mults-from definition, then (lz-lst-accumulate interleave-ordered '() (all-mults-from-above 2)) will define the lazy list of all composite numbers, in order, by means of counting up as in the sieve of Eratosthenes.

From this, it's just one more step to getting yourself your own lazy unbounded incremental sieve of Eratosthenes _{(search for "SiCp" on that page)}.

Another remark: take should be tweaked to not force an extra element of a stream. More here.