Topic: (challenge) count items in a list and return

[Mark]

Todays challenge is to return the item that appears the most times in a list along with the count. Example:
list = (12 3 43 554 3 89 987 45 3 33 4 3 12 299 33)
the item that appears the most times is '3' and it appears 4 times. Your function should return '3' and '4'.

The list _must_ contain all the same type. i.e. all integers, reals, strings etc..

[MP]

And if more than one item sports the same tally return ... ?

[MP]

Here's my "Haven't coded in weeks, haven't has my coffee yet" attempt ...

Code: [Select]

(defun tallymax ( lst / key pair index )

    (foreach key lst
        (setq index
            (if (setq pair (assoc key index))
                (subst
                    (cons key (1+ (cdr pair)))
                    pair
                    index
                )
                (cons
                    (cons key 1)
                    index
                )
            )
        )
    )
   
    (setq key (apply 'max (mapcar 'cdr index)))
   
    (vl-remove-if-not
        (function (lambda (pair) (eq key (cdr pair))))
        (reverse index)
    )    
   
)

(TallyMax '(12 3 43 554 3 89 987 45 3 33 4 3 12 299 33))

returns ((3 . 4))

(TallyMax '(1 2 1 2 1 2 3))

returns ((1 . 3)(2 . 3))

Showertime ...

[SMadsen]

First take. Only assumes one item to appear the most times, though

Code: [Select]

(setq lst '(12 3 43 554 3 89 987 45 3 33 4 3 12 299 33))

(defun cnt (item lst num)
  (cond ((null lst) (cons item num))
        ((not (member item lst))(cons item num))
        ((cnt item (cdr (member item lst)) (1+ num)))
  )
)

(defun tallyho (lst / nlst)
  (setq nlst (mapcar (function (lambda (n) (cnt n lst 0))) lst))
  (car (vl-sort nlst (function (lambda (a b)(>= (cdr a)(cdr b))))))
)

[Mark]

And if more than one item sports the same tally return ... ?

good question.......... I'll have to think about it.

[Mark]

Here's mine first attempt

Code: [Select]


(defun item-count (lst / cntr item tal tmp nlst)
  (setq cntr 0
        tmp 1
        )

  ;; begin loop
  (repeat (length lst)
          (setq item (nth cntr lst)
                tal 0  
                )

          (mapcar
            '(lambda (x)
               (if (or
                     (= x item)
                     (eq x item)
                     (equal x item 0.000001); for point lists
                     )
                 (setq tal (1+ tal))
                 )
               )
            lst
            )

          (if (> tal tmp)
            (progn
              (setq tmp tal
                    nlst (cons item tmp)
                    )
              )
            )

          (setq cntr (1+ cntr))
          ); end of loop
  nlst
  )


* edited to include point lists *

[David Bethel]

Code: [Select]


(setq l1 '(12 43 3 554 3 89 3 987 45 33 3 4 12 299 33))

(defun irep (l / fl ol mxi)

(foreach i l
  (setq fl
    (if (not (assoc i fl))
        (cons (cons i 1) fl)
        (subst (cons i (1+ (cdr (assoc i fl)))) (assoc i fl) fl))))

(foreach p fl
  (setq ol
    (if (not (assoc (cdr p) ol))
        (cons (list (cdr p) (car p)) ol)
        (subst (append (assoc (cdr p) ol) (list (car p)))
               (assoc (cdr p) ol) ol))))

;;;Maximum Number Of Repeats
(setq mxi (apply 'max (mapcar 'car ol)))

;;;List of Numbers Used Maximum Times
(prin1 (cdr (assoc mxi ol)))

(princ (strcat " Repeats " (itoa mxi) " Times"))

(princ))



-David

[SMadsen]

Second take. Returns all instances of identical counts

Code: [Select]

(defun cnt (item lst num)
  (cond ((null lst) (cons num item))
        ((not (member item lst))(cons num item))
        ((cnt item (cdr (member item lst)) (1+ num)))
  )
)

(defun tallyho (lst / nlst rlst m)
  (setq nlst (mapcar (function (lambda (n) (cnt n lst 0))) lst)
        m    (assoc (apply 'max (mapcar 'car nlst)) nlst))
  (mapcar (function (lambda (n)(and (= (car n) (car m))(/= (cdr n)(cdr m))
                                    (not (member n rlst))
                                    (setq rlst (cons n rlst))))) nlst)
  (cons m rlst)
)

(setq lst '(12 3 4 43 554 3 4 89 987 45 3 33 4 3 12 4 299 33))
(tallyho lst)
((4 . 3) (4 . 4))

(setq lst '(12 3 4 89 3 4 89 987 45 3 89 33 4 3 12 4 89 33))
(tallyho lst)
((4 . 3) (4 . 89) (4 . 4))

[Mark]

Funny, the thought of using 'member' never entered my mind.

Mr. Madsen, Mr. Puckett that is some beautiful code.

[JohnK]

w00t! cool another challenge. *Cross your fingers and howe i get to use AutoCAD today! ...I need another job!*

[SMadsen]

Mr. Madsen, Mr. Puckett that is some beautiful code.

Thanks, but Mr. Madsen's is a bit clumpsy, though. Here's take three (how many attempts do we get each?)

Code: [Select]

(defun cnt (item lst num)
  (cond ((null lst) (cons num item))
        ((not (member item lst))(cons num item))
        ((cnt item (cdr (member item lst)) (1+ num)))
  )
)

(defun tallyho (lst / nlst rlst m n)
  (setq nlst (mapcar (function (lambda (n) (cnt n lst 0))) lst)
        m    (car (assoc (apply 'max (mapcar 'car nlst)) nlst)))
  (while nlst
    (setq nlst (cdr (member (setq n (assoc m nlst)) nlst)))
    (and n (not (member n rlst)) (setq rlst (cons n rlst)))
  )
  rlst
)

[David Bethel]

Mark,

(member) is very good choice for small lists.  It gets real bogged down with large ones.  Same thing with (append).  Use (cons) & (reverse) for multiple modifies.  -David

[JohnK]

...Cross your fingers and hope i get to use AutoCAD today!...

Nope!? I get to use Microstation ver 7!?!? (The crapiest version. Its like using acad ver 14)  *Now wheres that darn Resum`e?!*

[Keith™]

Ok here is my first feeble attempt ...

Code: [Select]


(defun cnt ( lst / count item maxnum )
  (setq maxnum 0)
  (mapcar '(lambda (x)
    (setq count (-(length lst)(length (vl-remove x lst))))
    (if (>= count maxnum)(setq maxnum count item (append (list x) item))))
    (vl-sort lst '<))
  (list maxnum (reverse item))
)


(setq lst '(12 3 43 554 3 89 987 45 3 33 4 3 12 299 33))
(cnt lst)
(4 (3))

(setq lst '(12 3 4 89 3 4 89 987 45 3 89 33 4 3 12 4 89 33))
(cnt lst)
(4 (3 4 89))

I have a few more ideas that I may look at later

[SMadsen]

Keith, I thought about that approach at first it doesn't handle lists with strings or lists or symbols.
Try these lists with it

(setq lstlst '((1 2)(2 3)(1 2)(1 2)))
(setq strlst '("a" "b" "bc" "bx" "bx"))
(setq symlst '(a b c a b bx))