Orange Espresso
Thanks to the Flickr user Doozzle and his great shot of espresso (pun intended).
Doozzle: Ok, this is a detail of the foam the espresso shot left on a transparent cup. Taken with a soft light slightly above and behind the cup.
- a blog on all things Scheme
Doozzle: Ok, this is a detail of the foam the espresso shot left on a transparent cup. Taken with a soft light slightly above and behind the cup.
(list-ec (:list x '(1 2 3 4 5))
(if (even? (long-computation x)))
(long-computation x))
(list-ec (:list x '(1 2 3 4 5))
(:let r (long-computation x))
(if (even? r))
r)
(list-ec (:parallel
(: x '(one two three))
(: y '(1 2 3)))
(list x y))
; => ((one 1) (two 2) (three 3))
(list-ec (:parallel
(: x '(one two three))
(: y '(1 2)))
(list x y))
; => ((one 1) (two 2))
(list-ec (:while (: i 1 100000)
(< i 5))
i) ;=> (1 2 3 4)
(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
(list-ec (:until (: i 1 100000)
(= i 5))
i) ;=> (1 2 3 4 5)
(list-ec (:do () #f ())
1) ; => ()
(list-ec (:do () #t ())
1) ; => loops till ram is exhausted
(list-ec (:while (:do ((x 0)) #t ((+ x 1)))
(< x 5))
x)
;=> (0 1 2 3 4)
(list-ec (:do ((x 0)) (< x 5) ((+ x 1)))
x) ;=> (0 1 2 3 4)
(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))
(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))
(:do (<lb>*) ; loop bindings
<ne1?> ; "while"-expression
(<ls>*)) ; loop-step-expression
(let loop (<lb>*)
(if <ne1?>
(let ()
payload
(loop <ls>*))))
(list-ec (:do ((xs (list 2 3 4))
(x 1))
(not (null? xs))
((cdr xs) ; -> xs
(car xs))) ; -> x
x)
; => (1 2 3)
is:
(list-ec (: x '(1 2 3 4)) x)
(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))
(: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
(list-ec (:do (let ())
((t '(1 2 3 4)))
(not (null? t))
(let ((x (car t))))
#t
((cdr t)))
x)
; => (1 2 3 4)
(: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>*) )))))
(#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))
(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)
(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))
Labels: eager comprehension
The inner (last) generator spins faster than the outer generator. Since the scope of variables bound by a generator begins after the generator expression, it is possible to refer to variables bound by previous generators.
(list-ec (: x 2)
(: y 3)
(list x y)) ; => ((0 0) (0 1) (0 2)
; (1 0) (1 1) (1 2))
At this point we are capable of generating loads of values, but sometimes we want to skip some of them.
(list-ec (: x 3)
(: y (+ x 1))
(list x y)) ; => ((0 0)
; (1 0) (1 1)
; (2 0) (2 1) (2 2))
x^2 + y^2 = z^2 .A valid strategy is to let x, y and z run from, say, 1 to 100, and skip the triples which doesn't fulfill the equation. To mimic this strategy we will use qualifiers.
[Besides the filtering qualifiers all generators, as well as
(if <test>)
(not <test>*)
(and <test>*
(or <test>*)
The common cases (if (not <test>)), (if (and <test>*)), and (if (or <test>*)) are abbreviated by (not <test>), (and <test>*), and (or <test>*).
(list-ec (: x 1 100)
(: y x 100)
(: z y 100)
(if (= (+ (* x x) (* y y))
(* z z)))
(list x y z)) ; => ((3 4 5)
; (5 12 13)
; (6 8 10)
; ...
; (60 63 87)
; (65 72 97))
(list-ec (: x 1 4)
(: y 1 4)
(not (= x y))
(list x y)) ; => ((1 2) (1 3)
; (2 1) (2 3)
; (3 1) (3 2))
Labels: eager comprehension
If the length of the result vector is known ahead of time, one can use vector-of-length-ec, which is more efficient than vector-ec.
(vector-ec (: i 5)
i) ; => #5(0 1 2 3 4)
(string-ec (: c '(#\c #\a #\r))
c) ;=> "car"
Instead of first generating a list of lists, or a list of strings and then applying append or string-append, it is more convenient to use append-ec and string-append-ec.
(vector-of-length-ec 3 (: x 3)
x) ; => #3(0 1 2)
The comprehensions sum-ec, product-ec, min-ec and max-ec work on numbers.
(append-ec (: x '((1 2) (3 4 5) (6)))
x) ; => (1 2 3 4 5 6)
(string-append-ec (: x '("foo" "bar" "qux"))
x) ; => "foobarqux"
For min-ec and max-ec the the generated sequence of values must be non-empty.
(sum-ec (: x '(1 2 3 4))
x) ;=> 10
(product-ec (: x '(1 2 3 4))
x) ; => 24
(min-ec (: x '(1 2 3 4))
x) ; => 1
(max-ec (: x '(1 2 3 4))
x) ; => 4
Note: any?-ec and every?-ec (just as their cousins or and and) are "early stopping". As soon as any?-ec encounters a #t it stops. every?-ec stops when a #f is seen.
(every?-ec (: x 1 10)
(even? x)) ; => #f
(any?-ec (: x 1 10)
(even? x)) ; => #t
Labels: eager comprehension
(list-ec (:range i 5)The form (:range <vars> <start> <stop>) is used when the
i) ; => (0 1 2 3 4)
(list-ec (:range i 3 7)The form (:range <vars> <start> <stop> <step>) allows other step sizes than +1.
i) ; => (3 4 5 6)
(list-ec (:range i 0 8 2)The generator stops when <stop> is reached or crossed. This rule also applies when the step size is negative:
i) ; => (0 2 4 6)
(list-ec (:range i 0 9 2)
i) ; => (0 2 4 6 8)
(list-ec (:range i 5 0 -1)Note that :range works for integers only, simple stepping leads to accumulation of rounding errors when using reals. To generate a sequence of reals, use :real-range instead. It calculates the value from the index.
i) ; => (5 4 3 2 1)
(list-ec (:real-range i 0 2 0.5)The special generator : which uses the types of its arguments to dispatch to various generators, uses :range and :real-range when given numerical arguments.
i) ; => (0.0 0.5 1.0 1.5)
(list-ec (: i 5 0 -1)The dispatch happens at run time, so : is slightly slower than using :range directly.
i) ; => (5 4 3 2 1)
(list-ec (: i 0 2 0.5)
i) ; => (0.0 0.5 1.0 1.5)
(list-ec (:list x '(1 2 3))It is possible to run through more than one list at a time:
(* x 2)) ; (2 4 6)
(list-ec (:list x '(1 2) '(3 4) '(5 6))The generators :vector and :string works in the same way, but on vectors and strings.
(* x 2)) ; => (2 4 6 8 10 12)
(list-ec (:vector x '#(1 2 3))The dispatching generators uses :list, :vector and :strings, when the type of its arguments are lists, vectors and strings respectively.
x) ; => (1 2 3)
(list-ec (:string x "abc" "def")
x) ; => (#\a #\b #\c #\d #\e #\f)
(list-ec (: x '(1 2 3))
(* x 2)) ; => (2 4 6)
Labels: eager comprehension
(require (lib "42.ss" "srfi"))
(list-ec (: i 5)
(* i 2))
; => (0 2 4 6 8)
Labels: eager comprehension