TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: David Bethel on August 25, 2013, 08:37:35 AM

Title: Find The Atom With The Most Occurrences In A List
Post by: David Bethel on August 25, 2013, 08:37:35 AM
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
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 09:01:52 AM
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
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 09:09:07 AM
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. )
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: David Bethel on August 25, 2013, 09:18:39 AM
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
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 09:19:41 AM
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. )
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 09:21:04 AM
Quote from: David Bethel on August 25, 2013, 09:18:39 AM
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!
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 09:24:43 AM
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>
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: David Bethel on August 25, 2013, 10:42:10 AM
Wow!  That is a lot of difference !
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Marc'Antonio Alessi on August 25, 2013, 05:07:34 PM
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)
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 25, 2013, 06:05:59 PM
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)
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: irneb on August 26, 2013, 02:37:11 AM
Quote from: David Bethel on August 25, 2013, 09:18:39 AM
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
--------------------------------------------------------------------------------
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Marc'Antonio Alessi on August 26, 2013, 04:23:25 AM
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)
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: Lee Mac on August 26, 2013, 06:26:11 AM
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. )
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: irneb on August 26, 2013, 06:48:20 AM
Quote from: Lee Mac on August 26, 2013, 06:26:11 AM
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
--------------------------------------------------------------------------------
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: David Bethel on August 26, 2013, 10:35:02 AM
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......  :embarrassed:
-David
Title: Re: Find The Atom With The Most Occurrences In A List
Post by: ur_naz on August 31, 2013, 09:39:42 AM
This is my simple version. Just for test
Code - Auto/Visual Lisp: [Select]
  1. (defun foo (lst)
  2.   (if lst
  3.     (cons (vl-remove-if-not '(lambda (x) (= x (car lst))) lst)
  4.           (foo (vl-remove (car lst) lst))
  5.     )
  6.   )
  7. )
  8.  
  9. (defun test (lst / mln)
  10.   (setq lst (foo lst)
  11.         mln (apply 'max (mapcar 'length lst))
  12.   )
  13.   (mapcar 'car
  14.           (vl-remove-if '(lambda (x) (> mln (length x))) lst)
  15.   )
  16. )
_$ (test '(4 3 2 1 4 3 2 4 3 4 5 5 5 5))
(4 5)