Eager Comprehensions for Black Belts - 4. Advanced Generators

4. Advanced Generators

Local variables

Consider this scenario, where we want to produce a list of the even results of a long computation:

 (list-ec (:list x '(1 2 3 4 5))
          (if (even? (long-computation x)))
          (long-computation x))

The above solution will call long-computation twice with the same value. Introducing a local variable with the :let-generator (:let <vars> <expression>) solves this.

 (list-ec (:list x '(1 2 3 4 5))
          (:let r (long-computation x))
          (if (even? r))
          r)

Parallel loops

The generator (:parallel <generator>*) runs several generators in parallel. It advances its subgenerators in one step.

  (list-ec (:parallel
              (: x '(one two three))
              (: y '(1   2   3)))
           (list x y))             
   ; => ((one 1) (two 2) (three 3))

The (:parallel ...) generator stops, when any of its sub-generators stop.

   (list-ec (:parallel
              (: x '(one two three))
              (: y '(1   2)))
            (list x y))              
   ; => ((one 1) (two 2))

The generator (:while <generator> <expression>) runs the generator <generator> while <expression> return non-#f. This can be used to stop a generator before it is done.

 (list-ec (:while (: i 1 100000)
                  (< i 5))
          i)                      ;=> (1 2 3 4)

Since :while stops the inner generator, it is better to use :while than to use a qualifier to skip all values after a certain point. Compare these timings:

 (time (sum-ec (:while (: i 1 10000000)
                       (< i 100000))
               i))
 ; cpu time: 47 real time: 47 gc time: 0

 #;
 (time (sum-ec (: i 1 10000000)
               (if (< i 100000))
               i))
 ; cpu time: 3672 real time: 3687 gc time: 0

The :while-generator tests the expression before advancing the generator. The :until-generator tests after.

 (list-ec (:until (: i 1 100000)
                  (= i 5))
          i)                     ;=> (1 2 3 4 5)

The simple :do loop

The generator :do is a "do-while"-generator (it runs while the test is true - in contrast the normal Scheme do operator is a "do-until", it runs until the test becomes true).

The simple form is (:do (<lb>*) <ne1?> (<ls>*)). Here <lb>* is zero or more loop bindings, <ne1?>; is the "while" expression and determines whether the loop stops. Finally <ls>* are "loop-steppers", expressions whose evaluation results are bound to the loop variables.

A simple example (:do () #f ()) has no loop variables, and stops immediately, since the "while"-expression is #f.

 (list-ec (:do () #f ())
          1)               ; => ()

In contrast (:do () #t ()) will give an infinite loop.

 (list-ec (:do () #t ())
          1)             ; => loops till ram is exhausted

A loop that counts upwards forever: (:do ((x 0)) #t ((+ x 1))). To test it we put it inside a :while.

 (list-ec (:while (:do ((x 0)) #t ((+ x 1)))
                  (< x 5))
          x)                                 
  ;=> (0 1 2 3 4)

It is however better to use that :do is a "do-while".

(list-ec (:do ((x 0)) (< x 5) ((+ x 1)))
      x)                                  ;=> (0 1 2 3 4)

Updating two variables by repeatedly subtracting the smaller from the larger leads to Euclid's algorithm for calculating the greatest common divisor. The :do-generator makes it easy to store the intermediate steps in the calculation.

 (define (update a b) (if (< a b) a (- a b)))
 (list-ec (:do ((x 8333)
                (y 10897))
               (not (= x y))
               ((update x y)
                (update y x)))
          (list x y))

 ; => ((8333 10897) (8333 2564) (5769 2564) (3205 2564)
 ;     (641 2564) (641 1923) (641 1282))

so the greatest common divisor of 8333 and 10897 is 641.

Just as in a normal do-loop all the step-expressions are evaluated before they are bound to the loop- variables.

 (list-ec (:do ((x 0) (y 1))
               (< x 10)
               (y          ; -> x
                (+ x y)))  ; -> y
            (list x y))

 ; => ((0 1) (1 1) (1 2) (2 3) (3 5) (5 8) (8 13))

If x had been updated before (+ x y) were evaluated the result would have been
((0 1) (1 2) (2 4) (4 8) (8 16)).

The syntax of the simple :do-generator is

 (:do (<lb>*)    ; loop bindings
      <ne1?>     ; "while"-expression
      (<ls>*))   ; loop-step-expression

Lets take a look under the hood. [We'll need that later]

The generator expands to this loop:

(let loop (<lb>*)
  (if <ne1?>
     (let ()
          payload
          (loop <ls>*))))

where payload depends on the enclosing comprehension.

E.g. if the outer comprehension is (list-ec (:do ...) x) then the payload is (set! result (cons x result)).


The :do-generator is the one to turn to, if none of the builtin generators suit your needs. However the simple form turns out to be too simple for some cases.

Consider this attempt to write :list in terms of :do :

 (list-ec (:do ((xs (list 2 3 4))
                (x 1))
               (not (null? xs))
               ((cdr xs)          ; -> xs
                (car xs)))        ; -> x
          x)
 ; => (1 2 3)

The problem here is that 4 is missing from the result list.

The advanced :do loop

This section is for black belts. The advanced :do generator is meant to be used only by people interested in defining their own custom generators - and even then, in most cases a custom generator can be built without the advanced :do generator.

The advanced :do generator is more flexible than the simple, but requires a little time getting used to. It is worth learning though, as we will se a little later.

In fact all the pre-defined generators are defined in terms of the advanced :do-generator. Let us examine how the :list-generator works.

The (cleaned up version of) the expansion of

  (list-ec (: x '(1 2 3 4)) x)

is:

(reverse
  (let ((result '()))
    (let loop ((t '(1 2 3 4)))
      (if (not (null? t))
        (let ((x (car t)))
          (set! result (cons x result))
          (loop (cdr t)))))
    result))

We notice that list-ec sets up a result list, into which elements are consed using (set! result (cons x result)). When the list is returned it is reversed.

The loop itself has

• a set of loop-bindings ((t '(1 2 3 4)))
• a "while"-expression (not (null? t))
• a set of inner bindings ((x (car t)))
• a payload from the comprehension (set! result (cons x result))
• a set of loop-step-expressions (cdr t)

The advanced :do-generator makes it possible to write loops which has a similar structure.

The syntax of the advanced :do is:

 (:do (let (<ob>*) <oc>*) (<lb>*) <ne1?> (let (<ib>*) <ic>*) <ne2?> (<ls>*))

                                     <ob>*  outer bindings
                                     <oc>*  outer commands
(let loop ((t '(1 2 3 4)))              <lb>*  loop bindings
(if (not (null? t))                   <ne1?>
   (let ((x (car t)))                <ib>*  inner bindings
                                     <ic>*  innner commands
     (set! result (cons x result))   payload from comprehension
     (if #t                          <ne2?>
         (loop (cdr t))))))          <ls>*  loop steps

That is (list-ec (:list x '(1 2 3 4)) x) is equivalent to

 (list-ec (:do (let ())
               ((t '(1 2 3 4)))
               (not (null? t))
               (let ((x (car t))))
               #t
               ((cdr t)))
          x)
 ; => (1 2 3 4)

Consider now the expansion of the general

(:do (let (<ob>*) <oc>*) (<lb>*) <ne1?> (let (<ib>*) <ic>*) <ne2?> (<ls>*))

(let (<ob>*)
<oc>*
(let loop (<lb>*)
 (if <ne1?>
     (let (<ib>*)
       <ic>*
       payload
       (if <ne2?>
           (loop <ls>*) )))))

The outer bindings is used to set up helper variables, before the loop.

The outer commands for once-only side effects before the loop starts.

The loop bindings <lb>* are used for variables updated in the loop.

The before "while"-expression <ne1?> is tested before the payload.

The inner bindings <ib*> is used to set up temporary variables
for use in the loop body.

The inner commands <ic>* is used for side effects which is to be
executed in the loop.

The payload is work to do be done for the comprehension.

The after "while"-expression <ne1?> is tested after the payload.

The loop step expressions determine the next value of the loop
variables.

Lost your breath? Sebastian Egner puts it like this: "The design of :DO is a compromise between how complicated structures can be expressed, while retaining the ability to merge the loops in parallel". The following example will hopefully clear things up. It will later be reused to illustrate how to make a custom generator.

Combinations

The problem of generating all k combinations of the n numbers
0,1,...,n-1 provides a nice example of the advanced :do-generator.
The list of 3,5-combinations are

 (#3(0 1 2) #3(0 1 3) #3(0 1 4) #3(0 2 3) #3(0 2 4) #3(0 3 4)
  #3(1 2 3) #3(1 2 4) #3(1 3 4)
  #3(2 3 4))

The first combination is #(0 1 2) and the last combination is #3(2 3 4).
Given helper funcions first-combination, last-combination?, and
next-combination we can use the advanced :do-generator as follows.

(list-ec (:do (let ((k 3) (n 5)))
           ((c (first-combination k n)))
           c ; first-combination returns #f if k<=0 or k>n
           (let ())
           (not (last-combination? k n c))
           ((next-combination k n c)))
      c)

Here are the helper functions.

(define (vr v i)                  (vector-ref v i))
(define (vs! v i x)               (vector-set! v i x))
(define (incrementable? v i k n)  (< (vr v i) (+ n (- k) i)))

(define (last-combination? k n v) (= (vr v 0) (- n k)))

(define (first-combination k n)
(if (<= 1 k n)
   (vector-ec (: i 0 k) i)
   #f))

(require (lib "43.ss" "srfi")) ; for vector-copy
(define (next-combination k n v)
(last-ec #f ; default, when there is no next combination
        (:let v (vector-copy v))
        ; find the last incrementable index
        (:let i (last-ec #f (:until (: i (- k 1) -1 -1)
                                    (incrementable? v i k n))
                         i))
        (if i)
        ; increment index i and fix indices to the right of i
        (:parallel (: j i k)
                   (: vj (+ (vr v i) 1) n))
        (begin (vs! v j vj))
        ; if all indices is fixed we have a new combination
        (if (= j (- k 1)))
        ; return the new combination
        v))