Path: ...!news.nobody.at!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Kaz Kylheku <643-408-1753@kylheku.com>
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Thu, 15 Aug 2024 20:19:40 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 95
Message-ID: <20240815131441.142@kylheku.com>
References: <v7bkuk$2hcim$1@dont-email.me> <v7c38d$2jti1$1@dont-email.me>
 <v9jovo$q7cm$1@dont-email.me> <v9k670$ru4a$1@dont-email.me>
 <v9li3s$1285c$1@dont-email.me>
Injection-Date: Thu, 15 Aug 2024 22:19:40 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="b4c6df34be59dc862712455049efdae8";
	logging-data="1148457"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/eEj1rhB1xfQ3/vPLZmIBnPd1UV19S1I4="
User-Agent: slrn/pre1.0.4-9 (Linux)
Cancel-Lock: sha1:e4ujwDlnR1zyN4H27NyQG3jbndw=
Bytes: 3816

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:

1> (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))
2> (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