• :Re: duplicates

    From Robert L.@21:1/5 to Pascal Costanza on Thu Mar 24 05:04:47 2022
    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)))))


    Shorter

    ;; For Gauche Scheme.
    (use srfi-1) ;; alist-cons

    or

    ;; For Racket.
    (require srfi/1) ;; alist-cons alist-delete
    (require srfi/8) ;; receive
    (define assoc-ref dict-ref)


    (define (alist-inc k a)
    (alist-cons k (+ 1 (assoc-ref a k 0)) (alist-delete k a)))

    (receive (uniq dup)
    (partition
    (& = 1 (cdr u))
    (fold alist-inc '() '(c xo c f y f g g h z h h)))
    (values (map car uniq) (map car dup)))

    ===>
    (z y xo)
    (h g f c)


    Given:

    (define-syntax &-aux
    (syntax-rules (u v w & lambda quote)
    [(_ () shadow (param ...) original)
    (lambda (param ...) original)]
    [(_ (u more ...) (x y ...) () original)
    (&-aux original original (x) original)]
    [(_ (v more ...) (x y ...) (a) original)
    (&-aux original original (a x) original)]
    [(_ (w more ...) (x y ...) (a b) original)
    (&-aux () () (a b x) original)]
    [(_ ((lambda x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((& x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((quote x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ('x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((s ...) more ...) (y z ...) params original)
    (&-aux (s ... more ...) (s ... z ...) params original)]
    [(_ (x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]))
    ;; Lambda with anaphoric parameters u, v, and w.
    (define-syntax &
    (syntax-rules ()
    [(& x ...)
    (&-aux (x ...) (x ...) () (x ...))]))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)