1. Forum
  2. Usenet
  3. COMP.LANG.LISP

  • Re: tasters wanted

    From B. Pym@21:1/5 to B. Pym on Sat Aug 17 18:24:51 2024
    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    Ken Tilton wrote:

    Ooh! Ooh! Lemme try again!

    (defun collect-repeats-simple (sorted-list &key (test 'eql))
    (loop with acc and tail
    for a in sorted-list
    for b in (cdr sorted-list)

    if (funcall test a b)
    if acc do (setf tail (rplacd tail (list b)))
    else do (setf acc (list* a (setf tail (list b))))
    else when acc collect acc into result
    and do (setf acc nil)

    finally (return (nconc result
    (when acc (list acc))))))

    God I love rplaca/d!


    His definition is buggy.

    (collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
    ===>
    ((5 5 5) (8 8))

    newLISP

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a 0)
    (until (empty? (rest sorted))
    (setq a (pop sorted))
    (when (= a (sorted 0))
    (setq tmp (list a))
    (while (and sorted (= a (first sorted)))
    (push (pop sorted) tmp))
    (push tmp accum)))
    (reverse accum)))

    (collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))
    ((4 4) (5 5 5 5) (8 8 8))
    (collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))
    ((4 4) (5 5 5 5) (8 8 8))


    Shorter:

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a)
    (until (empty? sorted)
    (setq a (sorted 0))
    (setq tmp
    (collect
    (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))

    Shorter:


    (define (collect-repeats sorted)
    (local (accum tmp a)
    (while sorted
    (setq a (sorted 0))
    (setq tmp
    (collect (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (and (1 tmp) (push tmp accum)))
    (reverse accum)))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Jeff Barnett@21:1/5 to B. Pym on Sat Aug 17 23:19:28 2024
    On 8/17/2024 12:24 PM, B. Pym wrote:
    B. Pym wrote:
    <SNIP SNIP>

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a)
    (until (empty? sorted)
    (setq a (sorted 0))
    (setq tmp
    (collect
    (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))

    Shorter:


    (define (collect-repeats sorted)
    (local (accum tmp a)
    (while sorted
    (setq a (sorted 0))
    (setq tmp
    (collect (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (and (1 tmp) (push tmp accum)))
    (reverse accum)))

    Shorter!!!!!!! Shorter because you moved the and clause embedded in the
    collect clause into the same line as the collect operator. Good work.

    I take from your recent barrage of similarly helpful postings that you
    are once again between employers. It's probably good to keep in shape
    doing all these coding exercises.
    --
    Jeff Barnett

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to B. Pym on Thu Aug 15 02:26:01 2024
    B. Pym wrote:

    B. Pym wrote:

    Ken Tilton wrote:

    Ooh! Ooh! Lemme try again!

    (defun collect-repeats-simple (sorted-list &key (test 'eql))
    (loop with acc and tail
    for a in sorted-list
    for b in (cdr sorted-list)

    if (funcall test a b)
    if acc do (setf tail (rplacd tail (list b)))
    else do (setf acc (list* a (setf tail (list b))))
    else when acc collect acc into result
    and do (setf acc nil)

    finally (return (nconc result
    (when acc (list acc))))))

    God I love rplaca/d!


    His definition is buggy.

    (collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
    ===>
    ((5 5 5) (8 8))

    newLISP

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a 0)
    (until (empty? (rest sorted))
    (setq a (pop sorted))
    (when (= a (sorted 0))
    (setq tmp (list a))
    (while (and sorted (= a (first sorted)))
    (push (pop sorted) tmp))
    (push tmp accum)))
    (reverse accum)))

    (collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))
    ((4 4) (5 5 5 5) (8 8 8))
    (collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))
    ((4 4) (5 5 5 5) (8 8 8))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to B. Pym on Thu Aug 15 06:11:49 2024
    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    Ken Tilton wrote:

    Ooh! Ooh! Lemme try again!

    (defun collect-repeats-simple (sorted-list &key (test 'eql))
    (loop with acc and tail
    for a in sorted-list
    for b in (cdr sorted-list)

    if (funcall test a b)
    if acc do (setf tail (rplacd tail (list b)))
    else do (setf acc (list* a (setf tail (list b))))
    else when acc collect acc into result
    and do (setf acc nil)

    finally (return (nconc result
    (when acc (list acc))))))

    God I love rplaca/d!


    His definition is buggy.

    (collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
    ===>
    ((5 5 5) (8 8))

    newLISP

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a 0)
    (until (empty? (rest sorted))
    (setq a (pop sorted))
    (when (= a (sorted 0))
    (setq tmp (list a))
    (while (and sorted (= a (first sorted)))
    (push (pop sorted) tmp))
    (push tmp accum)))
    (reverse accum)))

    (collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))
    ((4 4) (5 5 5 5) (8 8 8))
    (collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))
    ((4 4) (5 5 5 5) (8 8 8))


    Shorter:

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a)
    (until (empty? sorted)
    (setq a (sorted 0))
    (setq tmp
    (collect
    (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to B. Pym on Thu Aug 15 18:41:04 2024
    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    Ken Tilton wrote:

    Ooh! Ooh! Lemme try again!

    (defun collect-repeats-simple (sorted-list &key (test 'eql))
    (loop with acc and tail
    for a in sorted-list
    for b in (cdr sorted-list)

    if (funcall test a b)
    if acc do (setf tail (rplacd tail (list b)))
    else do (setf acc (list* a (setf tail (list b))))
    else when acc collect acc into result
    and do (setf acc nil)

    finally (return (nconc result
    (when acc (list acc))))))

    God I love rplaca/d!


    His definition is buggy.

    (collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
    ===>
    ((5 5 5) (8 8))

    newLISP

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a 0)
    (until (empty? (rest sorted))
    (setq a (pop sorted))
    (when (= a (sorted 0))
    (setq tmp (list a))
    (while (and sorted (= a (first sorted)))
    (push (pop sorted) tmp))
    (push tmp accum)))
    (reverse accum)))

    (collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))
    ((4 4) (5 5 5 5) (8 8 8))
    (collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))
    ((4 4) (5 5 5 5) (8 8 8))


    Shorter:

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a)
    (until (empty? sorted)
    (setq a (sorted 0))
    (setq tmp
    (collect
    (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))

    Gauche Scheme

    (use srfi-1) ;; span

    (define (collect-repeats sorted)
    (let1 accum '()
    (while (pair? sorted)
    (receive (taken rejected)
    (span (cut equal? <> (car sorted)) sorted)
    (and (pair? (cdr taken)) (push! accum taken))
    (set! sorted rejected)))
    (reverse accum)))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Kaz Kylheku@21:1/5 to B. Pym on Thu Aug 15 20:19:40 2024
    On 2024-08-15, B. Pym <Nobody447095@here-nor-there.org> wrote:
    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    B. Pym wrote:

    Ken Tilton wrote:

    Ooh! Ooh! Lemme try again!

    (defun collect-repeats-simple (sorted-list &key (test 'eql))
    (loop with acc and tail
    for a in sorted-list
    for b in (cdr sorted-list)

    if (funcall test a b)
    if acc do (setf tail (rplacd tail (list b)))
    else do (setf acc (list* a (setf tail (list b))))
    else when acc collect acc into result
    and do (setf acc nil)

    finally (return (nconc result
    (when acc (list acc))))))

    God I love rplaca/d!


    His definition is buggy.

    (collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
    ===>
    ((5 5 5) (8 8))

    newLISP

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a 0)
    (until (empty? (rest sorted))
    (setq a (pop sorted))
    (when (= a (sorted 0))
    (setq tmp (list a))
    (while (and sorted (= a (first sorted)))
    (push (pop sorted) tmp))
    (push tmp accum)))
    (reverse accum)))

    (collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))
    ((4 4) (5 5 5 5) (8 8 8))
    (collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))
    ((4 4) (5 5 5 5) (8 8 8))


    Shorter:

    (define (collect-repeats sorted)
    (let (accum '() tmp '() a)
    (until (empty? sorted)
    (setq a (sorted 0))
    (setq tmp
    (collect
    (and (true? sorted) (= a (sorted 0)) (pop sorted))))
    (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))

    Gauche Scheme

    (use srfi-1) ;; span

    (define (collect-repeats sorted)
    (let1 accum '()
    (while (pair? sorted)
    (receive (taken rejected)
    (span (cut equal? <> (car sorted)) sorted)
    (and (pair? (cdr taken)) (push! accum taken))
    (set! sorted rejected)))
    (reverse accum)))

    I don't feel that all your squirmy wiggling above is improving on:

    (keep-if [chain len pred plusp]
    [partition-by identity '(2 4 4 0 5 5 5 5 8 8 8 6)])
    ((4 4) (5 5 5 5) (8 8 8))
    (keep-if [chain len pred plusp]
    [partition-by identity '(4 4 0 5 5 5 5 8 8 8)])
    ((4 4) (5 5 5 5) (8 8 8))

    that I already posted elsethread.

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