simple loop question

[Robert L.]

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))

(g.mfold-until (list + xcons) (@ > ! 50) '(0 ()) (gen-rand 10))

===>
'(53 (7 7 4 9 0 9 6 0 8 3))


Given:

(define (xcons a b) (cons b a))

(define (gen-rand n) (lambda () (random n)))

(define-syntax @
(syntax-rules (! !! !!!)
[(@ () (x ...) args) (lambda args (x ...))]
[(@ (! a ...) (x ...) args) (@ (a ...) (x ... (car args)) args)]
[(@ (!! a ...) (x ...) args) (@ (a ...) (x ... (cadr args)) args)]
[(@ (!!! a ...) (x ...) args)
(@ (a ...) (x ... (caddr args)) args)]
[(@ (a b ...) (x ...) args) (@ (b ...) (x ... a) args)]
[(@ x ...) (@ (x ...) () args)]))

;; Sources can be lists or generators.
;; Order of arguments to func is different from SRFI-1.
;; predicate is tested on the result of applying func to the object.
(define (g.fold-until func predicate seed source0 . sources)
(if (null? sources)
(if (procedure? source0)
(let loop ((seed seed))
(let ((x (source0)))
(if (eof-object? x)
seed
(let ((new-seed (func seed x)))
(if (predicate new-seed)
new-seed
(loop new-seed))))))
(let loop ((seed seed) (xs source0))
(if (null? xs)
seed
(let ((new-seed (func seed (car xs))))
(if (predicate new-seed)
new-seed
(loop new-seed (cdr xs)))))))
(let ((sources (cons source0 sources)))
(if (g.member-f procedure? sources)
(let ((sources
(map (lambda (x) (if (procedure? x) x (gen-list x))) sources)))
(let loop ((seed seed))
(let ((xs (map (lambda (g) (g)) sources)))
(if (g.member-f eof-object? xs)
seed
(let ((new-seed (apply func (cons seed xs))))
(if (predicate new-seed)
new-seed
(loop new-seed)))))))
(let loop ((seed seed) (lists sources))
(if (g.member-f null? lists)
seed
(let ((new-seed (apply func (cons seed (map car lists)))))
(if (predicate new-seed)
new-seed
(loop new-seed (map cdr lists))))))))))

(define (g.mfold-until funcs predicate seed . sources)
(apply g.fold-until
(lambda (accum . xs)
(map (lambda (fn old-val)
(apply fn old-val xs))
funcs
accum))
(lambda (xs) (apply predicate xs))
seed
sources))

--
The report card by the American Society of Civil Engineers showed the national
infrastructure a single grade above failure, a step from declining to the point
where everyday things simply stop working the way people expect them to.
http://archive.org/details/nolies

[Robert L.]

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))

(mfold-while (% < ! 51) #f `(,+ ,cons) '(0 ()) (gen-rand 10))
===>
'(53 (3 5 5 5 1 4 2 6 4 9 9))


Given:

(define-syntax @-aux
(syntax-rules (! !! !!! quote)
[(_ () (x ...) args) (x ...)]
[(_ (! a ...) (x ...) args)
(@-aux (a ...) (x ... (car args)) args)]
[(_ (!! a ...) (x ...) args)
(@-aux (a ...) (x ... (cadr args)) args)]
[(_ (!!! a ...) (x ...) args)
(@-aux (a ...) (x ... (caddr args)) args)]
[(_ ((quote a ...) b ...) (x ...) args)
(@-aux (b ...) (x ... (quote a ...)) args)]
[(_ ((a ...) b ...) (x ...) args)
(@-aux (b ...) (x ... (@-aux (a ...) () args)) args)]
[(_ (a b ...) (x ...) args) (@-aux (b ...) (x ... a) args)]))

(define-syntax %
(syntax-rules (! !! !!!)
[(% x ...) (lambda (lst) (@-aux (x ...) () lst))]))

(define (gen-rand n) (lambda () (random n)))

(define (g.member-if pred xs)
(member #f xs (lambda (_ x) (pred x))))

(define (mfold-while predicate funcs konses seeds source0 . sources)

(let ((sources
(map (lambda (x) (if (procedure? x) x (gen-list x)))

(cons source0 sources)))
(funcs (cond ((eq? funcs #f) identity)
((pair? funcs)
(map (lambda (f) (if (eq? f #f) f.id f)) funcs))))
(konses
(if (pair? konses) konses (make-list (length seeds) konses))))
(let loop ((seeds seeds))

(let ((xs (map (lambda (g) (g)) sources)))

(if (g.member-if eof-object? xs)
seeds
(let* ((vals
(if (pair? funcs)
(map (lambda (f) (apply f xs)) funcs)
(make-list (length seeds) (apply funcs xs))))
(seeds
(map
(lambda (k v s) (if (eof-object? v) s (k v s)))
konses
vals
seeds)))
(if (predicate seeds)
(loop seeds)
seeds)))))))


--
[Amazon banned a multitude of history books, including one that received 300
5-star reviews.] http://archive.org/details/nolies

[Robert L.]

On 5/24/2018, Robert L. 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))

(let. (s sum. c coll.) (till (> (s (c (random 10))) 50)) (c))
===>
'(8 2 6 6 4 5 0 2 8 6 3 3)

Shorter:

(till. (s sum. c coll.) (> (s (c (random 10))) 50) (c))


Given:

(define-syntax let.-aux
(syntax-rules ()
[(_ () ((var val) ...) stuff ...)
(let ((var (if (procedure? val) (val) val)) ...)
stuff ...)]
[(_ (var val x ...) (z ...) stuff ...)
(let.-aux (x ...) (z ... (var val)) stuff ...)]))

(define-syntax let.
(syntax-rules ()
[(_ (x ...) stuff ...)
(let.-aux (x ...) () stuff ...)]))

(define-syntax till
(syntax-rules ()
[(_ expr stuff ...)
(let go ()
(unless expr stuff ... (go)))]))

(define-syntax till.
(syntax-rules ()
[(_ bindings expr result)
(let. bindings
(till expr)
result)]))

(define (sum.)
(let ((sum 0))
(define closure
(case-lambda
(() sum)
((x) (set! sum (+ sum x)) sum)
((x . xs) (set! sum (+ sum x))
(apply closure xs))))
closure))

(define (coll.)
(let ((accum '()))
(define closure
(case-lambda
(() (reverse accum))
((x) (set! accum (cons x accum)) x)
((x . xs) (set! accum (cons x accum))
(apply closure xs))))
closure))

[Kaz Kylheku]

On 2018-05-25, Robert L. <No_spamming@noWhere_7073.org> wrote:
> On 5/24/2018, Robert L. 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))
>
> (let. (s sum. c coll.) (till (> (s (c (random 10))) 50)) (c))
> ===>
> '(8 2 6 6 4 5 0 2 8 6 3 3)
>
> Shorter:
>
> (till. (s sum. c coll.) (> (s (c (random 10))) 50) (c))
>
>
> Given:

Shorter:

a

Given:

(define-symbol-macro a (loop for x = (random 10) collect x
sum x into y until (> y 50)))