Counting the occurrences of unique atoms

DFLY
edited January 2023 in LISP Codes
Hello
Is there a better way to count the occurrences of unique atoms in a list ?
Here is my code:
(defun c:fff() ;fff is just easy to press on a keyboard. (setq aa '(1 1 1 2 2 2 2 3 3 3 3 3)) ; The test set of atoms (setq bb '()) ;A secondary list to hold aa again for iterating throuh (setq cc '()) ;This will be the dotted pair of atom and its count (setq dd '()) ;The final list of all atoms and their counts (setq ee '()) ;Just one of each unique atom and its count (setq bb (append aa bb)) ;load aa int bb (foreach xx aa (setq ctr 0) ; A counter used to count the quantity of eacy uniuqe atom occurance (foreach yy bb ;compare each item in aa to all of the items from aa copied to bb ;and move the counter up each time one occurs (if (= xx yy) (setq ctr (1+ ctr)) ) ) (setq cc (cons xx ctr)) ;create dotted pare of each atom and its number of occurances (setq dd (cons cc dd)) ;pass the dotted pairs to a list ) (foreach xx aa (if (not (assoc xx ee)) ;only add the pairs form dd to ee if thay are not already in ee (setq ee (cons (assoc xx dd) ee)) ) ) (print "ee") (print ee) (princ) )

I don't know many of the vl codes, so perhaps it is possible to do this with just one function ?

Comments

  • DFLY said:

    Hello
    Is there a better way to count the occurrences of unique atoms in a list ?
    Here is my code:
    (defun c:fff() ;fff is just easy to press on a keyboard. (setq aa '(1 1 1 2 2 2 2 3 3 3 3 3)) ; The test set of atoms (setq bb '()) ;A secondary list to hold aa again for iterating throuh (setq cc '()) ;This will be the dotted pair of atom and its count (setq dd '()) ;The final list of all atoms and their counts (setq ee '()) ;Just one of each unique atom and its count (setq bb (append aa bb)) ;load aa int bb (foreach xx aa (setq ctr 0) ; A counter used to count the quantity of eacy uniuqe atom occurance (foreach yy bb ;compare each item in aa to all of the items from aa copied to bb ;and move the counter up each time one occurs (if (= xx yy) (setq ctr (1+ ctr)) ) ) (setq cc (cons xx ctr)) ;create dotted pare of each atom and its number of occurances (setq dd (cons cc dd)) ;pass the dotted pairs to a list ) (foreach xx aa (if (not (assoc xx ee)) ;only add the pairs form dd to ee if thay are not already in ee (setq ee (cons (assoc xx dd) ee)) ) ) (print "ee") (print ee) (princ) )

    I don't know many of the vl codes, so perhaps it is possible to do this with just one function ?

    Sorry about the weird format. The code format did that. Here it is again

    (defun c:fff() ;fff is just easy to press on a keyboard.
    (setq aa '(1 1 1 2 2 2 2 3 3 3 3 3)) ; The test set of atoms
    (setq bb '()) ;A secondary list to hold aa again for iterating throuh
    (setq cc '()) ;This will be the dotted pair of atom and its count
    (setq dd '()) ;The final list of all atoms and their counts
    (setq ee '()) ;Just one of each unique atom and its count
    (setq bb (append aa bb)) ;load aa int bb

    (foreach xx aa
    (setq ctr 0) ; A counter used to count the quantity of eacy uniuqe atom occurance
    (foreach yy bb ;compare each item in aa to all of the items from aa copied to bb
    ;and move the counter up each time one occurs
    (if (= xx yy)

    (setq ctr (1+ ctr))


    )
    )
    (setq cc (cons xx ctr)) ;create dotted pare of each atom and its number of occurances
    (setq dd (cons cc dd)) ;pass the dotted pairs to a list
    )

    (foreach xx aa
    (if (not (assoc xx ee)) ;only add the pairs form dd to ee if thay are not already in ee
    (setq ee (cons (assoc xx dd) ee))

    )
    )
    (print "ee") (print ee) (princ)
    )
  • ; (count_atoms '(1 1 1 2 2 2 2 3 3 3 3 3))
    (defun count_atoms (lst / fnd res)
      (foreach itm lst
        (if (setq fnd (assoc itm res))
          (setq res (subst (cons itm (1+ (cdr fnd))) fnd res))
          (setq res (cons (cons itm 1) res))
        )
      )
      (reverse res)
    )
  • ; (count_atoms '(1 1 1 2 2 2 2 3 3 3 3 3))
    (defun count_atoms (lst / fnd res)
      (foreach itm lst
        (if (setq fnd (assoc itm res))
          (setq res (subst (cons itm (1+ (cdr fnd))) fnd res))
          (setq res (cons (cons itm 1) res))
        )
      )
      (reverse res)
    )
    Wow! Thanks. So much to digest from such a small script. I didn't know I could cons an atom with nil.
  • Nil is special. It is both an atom and an empty list:
    (atom nil) => T
    (listp nil) => T
    (= nil '()) => T
Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. Click one of the buttons on the top bar to get involved!