> * (Mirko.Vukovic @ gmail.com) Wrote on Wed, 23 Jan 2008 08:41:15 -0800 (PST):
> | Second, I was not clear in my original post, but Ken caught it: I am
> | parsing an ordered list.
> [...]
> | (defun collect-duplicates (list)
> | (loop
> | for a in list
> | for b in (cdr list)
> | when (equal a b)
> | collect b))
> |
> | It eliminates the (setf ...), and I must admit, the setf just did not
> | look right in the loop. But I could not think of another way of doing
> | it.
>
> Note that you can use LOOP destructuring like this:
> (loop for (a b) on list when (equal a b) collect b)
>
> To fix the duplicate elements in the returned list, you can use
> an extra loop variable like this.
>
> (defun collect-duplicates (list)
> "LIST is an ordered list without null elements."
> (loop for prev = NIL then a
> for (a b) on list
> when (equal a b) unless (equal prev a) collect a))

(use srfi-1) ;; span for Gauche Scheme
or
(require srfi/1) ;; span for Racket
(require srfi/26) ;; cut for Racket

(define (dups xs)
(if (null? xs)
'()
(let-values (((a b) (span (cut equal? <> (car xs)) xs)))
(if (pair? (cdr a))
(cons (car a) (dups b))
(dups b)))))

(dups '(a a a b c c c d d d d d))
===>
(a c d)

On 2/15/2022, Robert L. wrote:

> > * (Mirko.Vukovic @ gmail.com) Wrote on Wed, 23 Jan 2008 08:41:15 -0800 (PST):
> > > Second, I was not clear in my original post, but Ken caught it: I am
> > > parsing an ordered list.
> > [...]
> > > (defun collect-duplicates (list)
> > > (loop
> > > for a in list
> > > for b in (cdr list)
> > > when (equal a b)
> > > collect b))
> > >
> > > It eliminates the (setf ...), and I must admit, the setf just did not
> > > look right in the loop. But I could not think of another way of doing
> > > it.
> >
> > Note that you can use LOOP destructuring like this:
> > (loop for (a b) on list when (equal a b) collect b)
> >
> > To fix the duplicate elements in the returned list, you can use
> > an extra loop variable like this.
> >
> > (defun collect-duplicates (list)
> > "LIST is an ordered list without null elements."
> > (loop for prev = NIL then a
> > for (a b) on list
> > when (equal a b) unless (equal prev a) collect a))
>
> (use srfi-1) ;; span for Gauche Scheme
> or
> (require srfi/1) ;; span for Racket
> (require srfi/26) ;; cut for Racket
>
> (define (dups xs)
> (if (null? xs)
> '()
> (let-values (((a b) (span (cut equal? <> (car xs)) xs)))
> (if (pair? (cdr a))
> (cons (car a) (dups b))
> (dups b)))))
>
> (dups '(a a a b c c c d d d d d))
> ===>
> (a c d)

Gauche Scheme or Racket

(require srfi/1) ;; delete-duplicates for Racket

(define (dups xs)
(delete-duplicates
(filter-map (lambda (a b) (and (equal? a b) b)) xs (cdr xs))))