I have a few situations where I route one set of input values through multiple different filters and actions. A naïve version might look like
(flow (-< (~> (pass cond?) action)
(~> (pass cond?) action) …))
In the binary case, the sieve form is enough, and could be more efficient using a list-based partition but isn't:
(require qi)
(~> (-1 2 1 1 -2 2)
(sieve positive? + *)) ;=> (values 6 2)
For more than one condition, though, a generalized partition is needed:
(define-qi-syntax-parser partition
[(_) #'ground]
[(_ [cond? body]) #'(~> (pass cond?) body)]
[(_ [cond? body] [cond?s bodys] ...)
#'(sieve cond? body (partition [cond?s bodys] ...))])
(~> (-1 0 2 1 1 -2 0 0 2)
(partition [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])) ;=> (values 6 3 "zero" 2)
(~> (-1 2 1 1 -2 2)
(partition [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])) ;=> (values 6 0 "zero" 2)
This form differs from (>< (switch …)) because, while the conditions still apply to individual values, the result flows apply to all the values that meet the condition.
This version of the macro seems inefficient, however, in that multiple passes are made over the same input (roughly one for each condition). I am conceiving a more efficient single-pass version, but it isn't ready yet.
2 Likes
Here's a version of a single-pass partition, complete with tests against the inefficient version to make sure they agree.
@countvajhula I was unable to use a ...+ pattern in define-qi-syntax-parser—do you know why that might be? The usual protection of (... ...) doesn't work here either, I believe. A small example:
(define-qi-syntax-parser q
[(_ x ...+) #'(~> x ...)])
;; [Racket] ~/…/single-pass-partition.rkt:8:22: syntax: too many ellipses in template
;; at: ...
;; in: (syntax (~> x ...))
single-pass-partition code:
#lang racket
(provide (for-space qi partition))
(require qi)
(define-qi-syntax-parser partition-inefficient
[(_) #'ground]
[(_ [cond? body]) #'(~> (pass cond?) body)]
[(_ [cond? body] [cond?s bodys] ...)
#'(sieve cond? body (partition-inefficient [cond?s bodys] ...))])
(define (partition-values c+bs . args)
(define acc0
(for/hasheq ([c+b (in-list c+bs)])
(values (car c+b) empty)))
(define by-cs
(for/fold ([acc acc0]
#:result (for/hash ([(c args) (in-hash acc)])
(values c (reverse args))))
([arg (in-list args)])
(define matching-c
(for*/first ([c+b (in-list c+bs)]
[c (in-value (car c+b))]
#:when (c arg))
c))
(if matching-c
(hash-update acc matching-c (flow (cons arg _)))
acc)))
(define results
(for*/list ([c+b (in-list c+bs)]
[c (in-value (car c+b))]
[b (in-value (cdr c+b))]
[args (in-value (hash-ref by-cs c))])
(call-with-values (thunk (apply b args)) list)))
(apply values (apply append results)))
(define-qi-syntax-parser partition
[(_ [cond? body] ...)
#:with c+bs #'(list (cons cond? (flow body)) ...)
#'(~>> (partition-values c+bs))])
(module+ test
(require rackunit)
;; ground
(check-true (~> () (partition-inefficient) (not live?)))
(check-true (~>> () (partition-values (list)) (not live?)))
(check-true (~> () (partition) (not live?)))
;; pass
(check-equal? (~> (-1 2 1 1 -2 2)
(partition-inefficient [positive? +]))
6)
(check-equal? (partition-values (list (cons positive? +))
-1 2 1 1 -2 2)
6)
(check-equal? (~> (-1 2 1 1 -2 2)
(partition [positive? +]))
6)
;; generalized
(check-equal? (~> (-1 0 2 1 1 -2 0 0 2)
(partition-inefficient [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])
collect)
(list 6 3 "zero" 2))
(check-equal?
(call-with-values
(thunk (partition-values
(list (cons positive? +)
(cons zero? (flow (-< count (gen "zero"))))
(cons negative? *))
-1 0 2 1 1 -2 0 0 2))
list)
(list 6 3 "zero" 2))
(check-equal? (~> (-1 0 2 1 1 -2 0 0 2)
(partition [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])
collect)
(list 6 3 "zero" 2))
;; some bodys have no input
(check-equal? (~> (-1 2 1 1 -2 2)
(partition-inefficient [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])
collect)
(list 6 0 "zero" 2))
(check-equal?
(call-with-values
(thunk (partition-values
(list (cons positive? +)
(cons zero? (flow (-< count (gen "zero"))))
(cons negative? *))
-1 2 1 1 -2 2))
list)
(list 6 0 "zero" 2))
(check-equal? (~> (-1 2 1 1 -2 2)
(partition [positive? +]
[zero? (-< count (gen "zero"))]
[negative? *])
collect)
(list 6 0 "zero" 2)))
1 Like
Oh man, this is very cool 
! I would happily accept a PR to add this to Qi if you're interested in taking a crack at it. It could potentially even augment the sieve form since I think it doesn't syntactically conflict with any existing use of it.
Also good call re: using list's partition to optimize the binary case -- could your optimized version also be used in the binary case?
Also if you DO decide to write a PR, I think it would be fun to write a profiler for the form to see the before and after performance. Just for fun 
1 Like
Perhaps I'll take a crack at all of the above I may have time this weekend, but I did this partly to procrastinate another project I'm working on, so no promises!
1 Like
Forgot to respond to this -- I think you might be missing (require (for-syntax syntax/parse racket/base))
1 Like
Yep, (for-syntax syntax/parse) did the trick. Thanks!
I was surprised since the expansion uses syntax/parse under the hood—I wrongly assumed I would just have access to its features. It would be more ergonomic if Qi exported the right stuff so this just worked, but I also understand not wanting to re-provide all of syntax/parse… perhaps the macro pieces deserve to live under qi/macro? Not sure. For the time being, what is provided is enough for simple macros and the for-syntax bit isn't particularly difficult, just easy to forget.
1 Like
Glad that worked! re: providing syntax/parse, yeah I agree it can be surprising, but I'm also not sure if the alternatives are particularly compelling. I've created an issue as a place to collect further discussion though, in case you or anyone else has a strong opinion (or any opinion) here, and in the meantime I've added more docs to make the current behavior more clear.