XPost: comp.lang.scheme

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that
list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Let's see if it's shorter in Gauche Scheme.

(loop (y) (:coll (++. y (random 10))) (:till (> y 50)))

Yes, it is.

Given:

(use srfi-27) ;; random-integer
(define random random-integer)

;; Returns the added number, not the sum.
(define-syntax ++.
(syntax-rules ()
[(++. place val)
(let ((x val)) (set! place (+ x place)) x)]
[(++. place) (++. place 1)]))

I don't want to include the rather lengthy source for
"loop" here, so defining it is left as an exercise for
the reader.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

XPost: comp.lang.scheme

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that
list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

(let1 y 0 (collect-till x (random 10) (> (inc! y x) 50)))
===>
(7 9 4 0 6 4 1 3 2 7 0 7 0 1)


Given:

(use srfi-27) ;; random-integer

(define random random-integer)

(define-syntax collect-till
(syntax-rules ()
[(collect-till v expr0 expr1)
(let ((res '()))
(let go ((v expr0))
(set! res (cons v res))
(if expr1 (reverse res) (go expr0))))]))

(collect-till x (random 10) (even? x))
===>
(7 1 6)

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

XPost: comp.lang.scheme

B. Pym wrote:

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

(let1 y 0 (collect-till x (random 10) (> (inc! y x) 50)))
===>
(7 9 4 0 6 4 1 3 2 7 0 7 0 1)

Given:

(use srfi-27) ;; random-integer

(define random random-integer)

(define-syntax collect-till
(syntax-rules ()
[(collect-till v expr0 expr1)
(let ((res '()))
(let go ((v expr0))
(set! res (cons v res))
(if expr1 (reverse res) (go expr0))))]))

(collect-till x (random 10) (even? x))
===>
(7 1 6)

Revision:

(collect-till (x (y 0)) (random 10) x (> (inc! y x) 50))

Given:

(define-syntax collect-till
(syntax-rules ()
[(collect-till (v (w x) ...) v-val collect test)
(let ((res '()) (w x) ...)
(let go ((v v-val))
(set! res (cons collect res))
(if test (reverse res) (go v-val))))]
[(collect-till v v-val collect test)
(collect-till (v) v-val collect test)]))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that
list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

(use srfi-27 :only (random-integer))
(define random random-integer)

Gauche lacks do*. We'll define a version that
has an extra feature that works well for this
problem.

(do* ((x 0 (random 10))
((y z) (0 ()) (+ cons)))
((> y 50) z))

Here's the line that uses the extra feature:

((y z) (0 ()) (+ cons)))

The two variables y and z are intialized to the
values 0 and '(), respectively.
For the next pass through the loop, each
variable is updated by a "kons" and the
variable in the line above this special line.
So this is equivalent to:

(y 0 (+ x y))
(z () (cons x z))

Using this feature, the do* solution is shorter than
the LOOP solution.

(loop for x = (random 10) collect x sum x into y until (> y 50))
(do* ((x 0 (random 10)) ((y z) (0 ()) (+ cons))) ((> y 50) z))

Removing unnecessary spaces:

(loop for x =(random 10)collect x sum x into y until(> y 50))
(do*((x 0(random 10))((y z)(0())(+ cons)))((> y 50)z))

Note that the order of the numbers in the list returned by do*
is reversed with respect to the order in which they were produced.

(define-syntax do*-aux
(syntax-rules ()
[(do*-aux (specs ...
(v0 stuff ...)
((v ...) (init ...) (kons ...)))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ... (v0 stuff ...))
till
body
((v init) ... lets ...)
((set! v (kons v0 v)) ... sets ...)) ]
[(do*-aux (specs ... (v init update))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ...)
till
body
((v init) lets ...)
((set! v update) sets ...)) ]
[(do*-aux (specs ... (v init)) till body (lets ...) sets)
(do*-aux (specs ...) till body ((v init) lets ...) sets) ]
[(do*-aux () () more ...)
(do*-aux () (#f) more ...) ]
[(do*-aux () (till result ...) (body ...) (lets ...) (sets ...))
(let* (lets ...)
(let go ()
(if till
(begin result ...)
(begin
body ...
sets ...
(go))))) ] ))

(define-syntax do*
(syntax-rules ()
[ (do* specs till body ...)
(do*-aux specs till (body ...) () ()) ] ))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 2025-06-24, B. Pym <Nobody447095@here-nor-there.org> wrote:

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that
list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

(use srfi-27 :only (random-integer))
(define random random-integer)

Gauche lacks do*. We'll define a version that
has an extra feature that works well for this
problem.

(do* ((x 0 (random 10))
((y z) (0 ()) (+ cons)))
((> y 50) z))

Here's the line that uses the extra feature:

((y z) (0 ()) (+ cons)))

The two variables y and z are intialized to the
values 0 and '(), respectively.
For the next pass through the loop, each
variable is updated by a "kons" and the
variable in the line above this special line.
So this is equivalent to:

(y 0 (+ x y))
(z () (cons x z))

Using this feature, the do* solution is shorter than
the LOOP solution.

You don't seem to understand that if you use this do* only once for your one-liner, it's not shorter? Everything you wrote yourself not coming
from the language contributes to the size of your solution.

Your definition is 41 nonblank lines of code, so your one liner is now actually a 42 liner.

The macro has to be used 41 times to amortize that down to one line of definition overhead per use, so that all 41 one-liners that use it are effectively two-liners, carrying 100% overhead.

Say, if you think it's okay to write a 41 line definition that somehow doesn't count toward the size of your one-liner, why wouldn't you just make that definition a function, which then lets your one liner be something like this?

(r 10 50)

You could even hard code the parameters into the definition so
it's just (r); who says that the definition must be flexibly parametrized?

A Scheme wth symbol macros (standard CL feature) could get it down
to one symbol then.

(loop for x = (random 10) collect x sum x into y until (> y 50))
(do* ((x 0 (random 10)) ((y z) (0 ()) (+ cons))) ((> y 50) z))

The difference is negligible.

You don't seem to get that "collect x sum x into y until (> y 50)" is
easy for non-experts to understand. Maybe you have autism or something,
so you have no idea how neurotypicals process information.

You have three variables in your solution; x, y and z. Aren't you always criticizing the use of comprehension constructs that use variables, instead of point-free map/reduce type stuff?

Removing unnecessary spaces:

Removing spaces in a big decrement in the readability of the do*
code, yet places it at only a 7 character advantage.

(loop for x =(random 10)collect x sum x into y until(> y 50))
(do*((x 0(random 10))((y z)(0())(+ cons)))((> y 50)z))

Note that the order of the numbers in the list returned by do*
is reversed with respect to the order in which they were produced.

That could matter! Sometimes pseudo-random behavior is called upon to be reproducible, and so you can't just replace code that lists random
numbers with code that does that in reverse order. You may have to
adjust test cases and possibly other things.

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

B. Pym wrote:

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

(use srfi-27 :only (random-integer))
(define random random-integer)

Gauche lacks do*. We'll define a version that
has an extra feature that works well for this
problem.

(do* ((x 0 (random 10))
((y z) (0 ()) (+ cons)))
((> y 50) z))

Here's the line that uses the extra feature:

((y z) (0 ()) (+ cons)))

The two variables y and z are intialized to the
values 0 and '(), respectively.
For the next pass through the loop, each
variable is updated by a "kons" and the
variable in the line above this special line.
So this is equivalent to:

(y 0 (+ x y))
(z () (cons x z))

Using this feature, the do* solution is shorter than
the LOOP solution.

(loop for x = (random 10) collect x sum x into y until (> y 50))
(do* ((x 0 (random 10)) ((y z) (0 ()) (+ cons))) ((> y 50) z))

Removing unnecessary spaces:

(loop for x =(random 10)collect x sum x into y until(> y 50))
(do*((x 0(random 10))((y z)(0())(+ cons)))((> y 50)z))

Note that the order of the numbers in the list returned by do*
is reversed with respect to the order in which they were produced.

(define-syntax do*-aux
(syntax-rules ()
[(do*-aux (specs ...
(v0 stuff ...)
((v ...) (init ...) (kons ...)))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ... (v0 stuff ...))
till
body
((v init) ... lets ...)
((set! v (kons v0 v)) ... sets ...)) ]
[(do*-aux (specs ... (v init update))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ...)
till
body
((v init) lets ...)
((set! v update) sets ...)) ]
[(do*-aux (specs ... (v init)) till body (lets ...) sets)
(do*-aux (specs ...) till body ((v init) lets ...) sets) ]
[(do*-aux () () more ...)
(do*-aux () (#f) more ...) ]
[(do*-aux () (till result ...) (body ...) (lets ...) (sets ...))
(let* (lets ...)
(let go ()
(if till
(begin result ...)
(begin
body ...
sets ...
(go))))) ] ))

(define-syntax do*
(syntax-rules ()
[ (do* specs till body ...)
(do*-aux specs till (body ...) () ()) ] ))

Shorter yet.


(do* ((x 0 (random 10))
((y z) 0 () (+ cons)))
((> y 50) z))

(do* ((x 0 (random 10)) ((y z) 0 () (+ cons))) ((> y 50) z))



(define-syntax do*-aux
(syntax-rules ()

[(do*-aux (specs ...
(v0 stuff ...)
((v ...) init ... (kons ...)))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ... (v0 stuff ...))
till
body
((v init) ... lets ...)
((set! v (kons v0 v)) ... sets ...)) ]

[(do*-aux (specs ... (v init update))
till
body
(lets ...)
(sets ...))
(do*-aux (specs ...)
till
body
((v init) lets ...)
((set! v update) sets ...)) ]
[(do*-aux (specs ... (v init)) till body (lets ...) sets)
(do*-aux (specs ...) till body ((v init) lets ...) sets) ]
[(do*-aux () () more ...)
(do*-aux () (#f) more ...) ]
[(do*-aux () (till result ...) (body ...) (lets ...) (sets ...))
(let* (lets ...)
(let go ()
(if till
(begin result ...)
(begin
body ...
sets ...
(go))))) ] ))


(define-syntax do*
(syntax-rules ()
[ (do* specs till body ...)
(do*-aux specs till (body ...) () ()) ] ))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

B. Pym wrote:

Lars Brinkhoff wrote:

use LOOP to collect random integers into a list until the sum of that list exceeds a constant (say 50).

(loop for x = (random 10) collect x sum x into y until (> y 50))

Gauche Scheme

If we are allowed to set up a couple of collectors, the
solution is tiny. Comparing it to the LOOP version:


(until (> (s (c (random 10))) 50)) (c)
(loop for x = (random 10) collect x sum x into y until (> y 50))


Here's the code:

(use srfi-27) ;; random-integer
(define random random-integer)

(let ((c (mlistbag)) (s (mbag 0 +)))
(until (> (s (c (random 10))) 50))
(c))

===>
(8 1 9 8 1 9 9 2 6)


Given:

(define (mbag init func :optional (pass-through #f))
(let ((val init) (func func) (pass-through pass-through))
(lambda args
(if (null? args)
val
(begin
(set! val
;; A "kons" may have been supplied.
((if (null? (cdr args)) func (cadr args))
(car args) val))
(if pass-through
(car args)
val))))))
(define (mlistbag :optional (pass-through #t))
(let ((bag (mbag '() cons pass-through)))
(lambda args
(if (null? args)
(reverse (bag))
(apply bag args)))))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)