Topic: Find The Atom With The Most Occurrences In A List

[David Bethel]

Right now I kludge thru a list and make comparison list. There has to be a better way:

Code - Auto/Visual Lisp: [Select]

1.  (setq zl '(4 3 2 1 4 3 2 4 3 4)
2.        cl nil)
3.  
4.   (foreach z zl
5.     (setq cl (if (not (assoc z cl))
6.                  (cons (cons z 1) cl)
7.                  (subst (cons z (1+ (cdr (assoc z cl))))
8.                         (assoc z cl) cl))))
9.  
10.   (setq c 0)
11.   (foreach z cl
12.     (if (> (cdr z) c)
13.         (setq dz (car z))))
14.  
15.  

dz is used as the default value in a (getdist) call

Any ideas?  thanks!  -David

[Lee Mac]

A quick draft:

Code - Auto/Visual Lisp: [Select]

1. (defun LM:most-occurrences-1 ( l / c m n r x )
2.     (while l
3.         (setq x (car l)
4.               c (length l)
5.               l (vl-remove x (cdr l))
6.               n (- c (length l))
7.         )
8.         (if (< m n)
9.             (setq m n
10.                   r x
11.             )
12.         )
13.     )
14.     r
15. )

Code - Auto/Visual Lisp: [Select]

1. _$ (LM:most-occurrences-1 '(4 3 2 1 4 3 2 4 3 4))
2. 4

[Lee Mac]

Or, with a minor optimisation:

Code - Auto/Visual Lisp: [Select]

1. (defun LM:most-occurrences-2 ( l / c m n r x )
2.     (while (< m (setq c (length l)))
3.         (setq x (car l)
4.               l (vl-remove x (cdr l))
5.               n (- c (length l))
6.         )
7.         (if (< m n)
8.             (setq m n
9.                   r x
10.             )
11.         )
12.     )
13.     r
14. )

[David Bethel]

Lee, Thanks as usual !

I would think vl-remove would bog down on large lists.  It's not  big deal on today's hardware.  Both seem to work fine! 

-David

[Lee Mac]

Or, a variation on your original method:

Code - Auto/Visual Lisp: [Select]

1. (defun LM:most-occurrences-3 ( l / a i m n r )
2.     (foreach x l
3.         (if (setq i (assoc x a))
4.             (setq a (subst (cons x (setq n (1+ (cdr i)))) i a))
5.             (setq a (cons  (cons x (setq n 1)) a))
6.         )
7.         (if (< m n)
8.             (setq m n
9.                   r x
10.             )
11.         )
12.     )
13.     r
14. )

[Lee Mac]

Lee, Thanks as usual !

I would think vl-remove would bog down on large lists.  It's not  big deal on today's hardware.  Both seem to work fine! 

-David

You're most welcome David!

[Lee Mac]

A quick benchmark:

Code - Auto/Visual Lisp: [Select]

1. _$ (setq l '(4 3 2 1 4 3 2 4 3 4))
2. (4 3 2 1 4 3 2 4 3 4)
3. _$ (repeat 5 (setq l (append l l)))
4. (4 3 2 ... 4 3 4)
5. _$ (length l)
6. 320
7. _$ (LM:most-occurrences-1 l)
8. 4
9. _$ (LM:most-occurrences-2 l)
10. 4
11. _$ (LM:most-occurrences-3 l)
12. 4
13. _$ (benchmark '((LM:most-occurrences-1 l) (LM:most-occurrences-2 l) (LM:most-occurrences-3 l)))
14. Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):
15.  
16.     (LM:MOST-OCCURRENCES-2 L)......1029 / 20.86 <fastest>
17.     (LM:MOST-OCCURRENCES-1 L)......1108 / 19.37
18.     (LM:MOST-OCCURRENCES-3 L).....21466 / 1.00 <slowest>

[David Bethel]

Wow!  That is a lot of difference !

[Marc'Antonio Alessi]

This for dupes values:

Code: [Select]

(defun ALE_MostOccurrences (In_Lst / OutLst TmpItm TmpLen MaxLen)
  (while In_Lst
    (setq
      TmpItm (car In_Lst)
      OutLst
        (cons
          (cons
            (setq TmpLen
              (-
                (length In_Lst)
                (length (setq In_Lst (vl-remove TmpItm (cdr In_Lst))))
              )
            )
            TmpItm
          )
          OutLst
        )
    )
    (if (> TmpLen MaxLen) (setq MaxLen TmpLen))
  )
  (list Maxlen OutLst)
)

; Orginal "Massoc" by M. Puckett
(defun ALE_MAssoc (DxfKey ImpLst / TmpLst OutLst)
  (while (setq TmpLst (assoc DxfKey ImpLst))
    (setq OutLst (cons (cdr TmpLst) OutLst)
          ImpLst (cdr (member TmpLst ImpLst))
    )
  )
  (reverse OutLst)
)
Comando: (setq Info (ALE_MostOccurrences '(4 3 2 1 4 3 2 4 3 4 5 5 5 5)))
(4 ((4 . 5) (1 . 1) (2 . 2) (3 . 3) (4 . 4)))

Comando: (ALE_MAssoc (car Info) (cadr Info))
(5 4)

[Lee Mac]

Another for multiple most-common items:

Code - Auto/Visual Lisp: [Select]

1. (defun LM:most-occurrences-4 ( l / c m n r x )
2.     (while (<= m (setq c (length l)))
3.         (setq x (car l)
4.               l (vl-remove x (cdr l))
5.               n (- c (length l))
6.         )
7.         (if (< m n)
8.             (setq m n r (list x))
9.             (if (= m n)
10.                 (setq r (cons x r))
11.             )
12.         )
13.     )
14.     r
15. )

Code - Auto/Visual Lisp: [Select]

1. _$ (LM:most-occurrences-4 '(4 3 2 1 4 3 2 4 3 4 5 5 5 5))
2. (5 4)

[irneb]

I would think vl-remove would bog down on large lists.  It's not  big deal on today's hardware.  Both seem to work fine! 

It is actually quite strange. Methinks the vl-remove function's are much more optimal than you might think. E.g.

Code - Auto/Visual Lisp: [Select]

1. (defun List-Count-Atoms1 (lst val /)
2.   (apply '+
3.          (mapcar (function (lambda (item)
4.                              (if (eq item val)
5.                                1
6.                                0)))
7.                  lst)))
8.  
9. (defun List-Count-Atoms2 (lst val / n)
10.   (setq n 0)
11.   (foreach item lst
12.     (if (eq item val)
13.       (setq n (1+ n))))
14.   n)
15.  
16. (defun List-Count-Atoms3 (lst val /)
17.   (- (length lst) (length (vl-remove val lst))))

Then using the same benchmarking data as Lee did:

Code: [Select]

_$ (setq l '(4 3 2 1 4 3 2 4 3 4))
(4 3 2 1 4 3 2 4 3 4)
_$ (length (repeat 5 (setq l (append l l))))
320
_$ (QuickBench '((List-Count-Atoms1 l 4) (List-Count-Atoms2 l 4) (List-Count-Atoms3 l 4)))
Benchmarking ... done for 32768 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(LIST-COUNT-ATOMS3 L 4)                      32768      1419      1419      7.83
(LIST-COUNT-ATOMS1 L 4)                       8192      1810      7240      1.53
(LIST-COUNT-ATOMS2 L 4)                       4096      1388     11104      1.00
--------------------------------------------------------------------------------Even compiling the LSP only slightly improves the mapcar version. It does improve the foreach quite a lot, but still not enough to surpass the vl-remove:

Code: [Select]

_$ (QuickBench '((List-Count-Atoms1 l 4) (List-Count-Atoms2 l 4) (List-Count-Atoms3 l 4)))
Benchmarking ... done for 32768 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(LIST-COUNT-ATOMS3 L 4)                      32768      1372      1372      3.96
(LIST-COUNT-ATOMS2 L 4)                      16384      1764      3528      1.54
(LIST-COUNT-ATOMS1 L 4)                       8192      1358      5432      1.00
--------------------------------------------------------------------------------

[Marc'Antonio Alessi]

Only raw result:

Code: [Select]

(defun ALE_MostOccurrences_3 (L / O I P M)
  (while L
    (setq
      I (car L)
      P (- (length L) (length (setq L (vl-remove I (cdr L)))))
    )
    (cond ( (> P M) (setq M P   O (list I)) ) ( (= P M) (setq O (cons I O)) ))
  )
  O
)
Comando: (ALE_MostOccurrences_3 '(4 3 2 1 4 3 2 4 3 4 5 5 5 5))
(5 4)

[Lee Mac]

Another entry for 'count atom':

Code - Auto/Visual Lisp: [Select]

1. (defun countatom ( itm lst / tmp )
2.     (if (setq tmp (member itm lst))
3.         (1+ (countatom itm (cdr tmp)))
4.         0
5.     )
6. )

[irneb]

Another entry for 'count atom':

Not much slower - even with the recursive loop:

Code: [Select]

Benchmarking .... done for 32768 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(LIST-COUNT-ATOMS3 L 4)                      32768      1390      1390      7.90
(LIST-COUNT-ATOMS1 L 4)                       8192      1779      7116      1.54
(COUNTATOM 4 L)                               4096      1044      8352      1.32
(LIST-COUNT-ATOMS2 L 4)                       4096      1373     10984      1.00
--------------------------------------------------------------------------------And compiled it actually seems to gain more than the mapcar does

Code: [Select]

Benchmarking .... done for 32768 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(LIST-COUNT-ATOMS3 L 4)                      32768      1388      1388      4.14
(LIST-COUNT-ATOMS2 L 4)                      16384      1747      3494      1.64
(LIST-COUNT-ATOMS1 L 4)                       8192      1327      5308      1.08
(COUNTATOM 4 L)                               8192      1435      5740      1.00
--------------------------------------------------------------------------------

[David Bethel]

Very interesting concepts  Thank you all

Maybe:

Code - Auto/Visual Lisp: [Select]

1. (defun DB:most (l / c)
2.   (foreach z l
3.     (setq c (if (not (assoc z c))
4.                 (cons (list z 1) c)
5.                 (subst (list z (1+ (cadr (assoc z c))))
6.                        (assoc z c) c))))
7.   (cadr (assoc (apply 'max (mapcar 'cadr c))
8.                (mapcar 'reverse c))))
9.  
10.  

As basic as I am...... 
-David