Deutsch   English   Français   Italiano  
<vahjo7$2djrm$1@dont-email.me>

View for Bookmarking (what is this?)
Look up another Usenet article

Path: ...!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: duplicates
Date: Mon, 26 Aug 2024 10:00:45 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 115
Message-ID: <vahjo7$2djrm$1@dont-email.me>
References: <vahdhv$2cmjb$2@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 26 Aug 2024 12:00:45 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="c62e5a4788eb434261aeb34e5a871e27";
	logging-data="2543478"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19Adjd0Ht58P8KwzsNYNrrr"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:LFkEWyUGJtsKMOM5ojXaiUyWX+E=
Bytes: 4457

B. Pym wrote:

> Pascal Costanza wrote:
> 
> > > There doesn't seem to be a way to return a list of duplicates of a
> > > sequence in ANSI CL -- though there is a remove-duplicates. Is there a
> > > reason for this? It would be handy if you could tell remove-duplicates
> > > not to include any duplicated elements so you could do a set-
> > > difference at the end to get a list of duplicates. Feel free to post
> > > code to prove me wrong. Thanks!
> > 
> > (loop
> >    with counts
> >    for element in list
> >    do (incf (getf counts element 0))
> >    finally (return
> >              (loop for (element count) on counts by #'cddr
> >                if (> count 1)
> >                collect element into duplicates
> >                else collect element into uniques
> >                finally (return (values uniques duplicates)))))
> > 
> > I am using a property list for counting elements, which means that eq is
> > implicitly used for detecting equivalent elements. If you want to use
> > other comparison functions, it is better to use an association list
> > (which makes the code a little bit wordier).
> > 
> > In general, LOOP is a pretty good poor man's list comprehension
> > facility. Just ignore that it performs iteration and use it to emulate a
> > more declarative style.
> 
> Gauche Scheme
> 
> Using a simple association list.
> 
> (let ((counts '()))
>   (dolist (el '(a b c d e f g  b d f))
>     (ainc! counts el))
>   (values
>     (map car (filterfor x counts (= (cdr x) 1)))
>     (map car (filterfor x counts (> (cdr x) 1)))))
> 
> (g e c a)
> (f d b)
> 
> Given:
> 
> (define-syntax ainc!
>   (syntax-rules ()
>     [(_ alist key val func default)
>      (let ((pair (assoc key alist)))
>        (if pair
>          (set-cdr! pair (func val (cdr pair)))
>          (set! alist (cons (cons key (func val default)) alist))))]
>     [(_ alist key val func)
>      (ainc! alist key val func 0)]
>     [(_ alist key val)
>      (ainc! alist key val +)]
>     [(_ alist key)
>      (ainc! alist key 1)]))
> 
> (define-syntax filterfor
>   (syntax-rules ()
>     [(_ var lst expr)  (filter (lambda (var) expr) lst)]))

Better:

(let ((counts '()))
  (dolist (el '(a b c d e f g  b d f))
    (ainc! counts el))
  (values
    (map car (filterfor (k . v) counts (= v 1)))
    (map car (filterfor (k . v) counts (> v 1)))))

(g e c a)
(f d b)

"filterfor" was copied from Tcl.

Given:

(define-syntax ainc!
  (syntax-rules ()
    [(_ alist key val func default)
     (let ((pair (assoc key alist)))
       (if pair
         (set-cdr! pair (func val (cdr pair)))
         (set! alist (cons (cons key (func val default)) alist))))]
    [(_ alist key val func)
     (ainc! alist key val func 0)]
    [(_ alist key val)
     (ainc! alist key val +)]
    [(_ alist key)
     (ainc! alist key 1)]))

(define-syntax fn*
  (syntax-rules ()
    [(_ (var ...) stuff ...)
     (lambda (xs)
       (let-values (((var ...) (apply values xs)))
         stuff ...))]
    [(_ (a b c ... . rest) stuff ...)
     (lambda (xs)
       (let-values (((a b c ... . rest) (apply values xs)))
         stuff ...))]
    [(_ (a . b) stuff ...)
     (lambda (xs)
       (let ((a (car xs))  (b (cdr xs)))
         stuff ...)) ]))

(define-syntax filterfor
  (syntax-rules ()
    [(_ (v ...) lst expr)  (filter (fn* (v ...) expr) lst)]
    [(_ (a . b) lst expr)  (filter (fn* (a . b) expr) lst)]
    [(_ var lst expr)  (filter (lambda (var) expr) lst)]))