Re: duplicates

Liste des GroupesRevenir à cl scheme 
Sujet : Re: duplicates
De : Nobody447095 (at) *nospam* here-nor-there.org (B. Pym)
Groupes : comp.lang.lisp comp.lang.scheme
Date : 27. Aug 2024, 00:38:42
Autres entêtes
Organisation : A noiseless patient Spider
Message-ID : <vaj04v$2kshr$1@dont-email.me>
References : 1 2
User-Agent : XanaNews/1.18.1.6
B. Pym wrote:

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

Better:

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

(g e c a)
(f d b)


Given:

(define-syntax fn*
  (syntax-rules ()
    [(_ (a) stuff ...) (lambda (a) stuff ...) ]
    [(_ (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 ()
    [(_ param lst expr1 expr2)
      (append-map
        (lambda (element)
          ((fn* param
             (if expr1
               (let ((expr2 expr2))
                 (if expr2 (list expr2) (list element)))
               '()))
          element))
        lst)]
    [(_ param lst expr) (filterfor param lst expr #f)]))

Date Sujet#  Auteur
27 Aug 24 o Re: duplicates1B. Pym

Haut de la page

Les messages affichés proviennent d'usenet.

NewsPortal