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

[Keith™]

Ok.. how about this then...it is a little slower but it works ....

Code: [Select]


(defun cnt ( lst / count item maxnum )
  (setq maxnum 0)
  (mapcar '(lambda (x)
        (setq count (-(length lst)(length (vl-remove x lst))))
        (cond
 ((and (> count maxnum)(not(member x item)))(setq maxnum count item (list x)))
 ((and (= count maxnum)(not(member x item)))(setq maxnum count item (append (list x) item)))
))
        lst)
  (list maxnum (reverse item))
)


[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

Sounds like someone wants to race!!

anyone have a function that can generate a large list to test these functions against?

[SMadsen]

Ok.. how about this then...

Very neat  

[Keith™]

man I love this stuff....

Maybe we should have a VBA challenge...

[SMadsen]

Sounds like someone wants to race!!

Mr. Madsen thinks he'll forefeit. With MEMBER in recursion ... hmmm

[JohnK]

[quote="Mark Thomas]...
anyone have a function that can generate a large list to test these functions against?[/quote] I think i have one, let me look.

[SMadsen]

Preliminary results are in! Run on 1000 item list of random integers. Same list for all tests.

In order of results:

David's IREP
(runit 'irep llst)
(3 4) Repeats 116 Times
Result: -
Time: 47 millisecs

MP's TALLYMAX
(runit 'tallymax llst)
Result: ((4 . 116) (3 . 116))
Time: 47 millisecs

Keith's CNT
(runit 'cnt llst)
Result: (116 (4 3))
Time: 1547 millisecs

SMadsen's TALLYHO
(runit 'tallyho llst)
Result: ((116 . 3) (116 . 4))
Time: 3579 millisecs

Mark's ITEM-COUNT
(runit 'item-count llst)
Result: (4 . 116)
Time: 10250 millisecs


RUNIT code:

Code: [Select]

(defun runIt (func arg / time result)
  (gc)
  (setq time (getvar "MILLISECS"))
  (setq result (apply func (list arg)))
  (setq time (- (getvar "MILLISECS") time))
  (gc)
  (mapcar 'princ (list "\nResult: " result "\nTime: " time " millisecs"))
  (princ)
)

[SMadsen]

Code for building 1000 item list of random integers

Code: [Select]

(defun randnum (/ modulus multiplier increment random)
  (if (not seed)(setq seed (getvar "DATE")))
  (setq modulus    65536 multiplier 25173 increment 13849
        seed       (rem (+ (* multiplier seed) increment) modulus)
        random     (/ seed modulus))
)

(defun largelist (/ ret)
  (repeat 1000 (setq ret (cons (fix (* 10 (randnum))) ret))))

[Mark]

Preliminary results are in! Run on 1000 item list of random integers. Same list for all tests.
Mark's ITEM-COUNT
(runit 'item-count llst)
Result: (4 . 116)
Time: 10250 millisecs

OUCH!! man that hurts. back to the drawing board

[JohnK]

Glad you had one Stig. Cause i couldnt find one.

[SMadsen]

I always carry a large list function around in my wallet. Don't you, Se7en??

Mark, I could have sworn mine was slower but .. well .. now I'm happy again *neener*

[CAB]

Ok here is my attempt at something different.

Perhaps the vl-remove is not reliable enough to use but it's the
only thing I could come up with that has not been done.

Code: [Select]

(defun item_cnt (lst / item itm cnt)
  (setq item   '(0 nil))
  (while lst
    (setq itm (car lst)
          cnt (- (length lst)(length (setq lst (vl-remove itm lst)))))
    (cond
      ((> cnt (car item)) (setq item (list cnt itm)))
      ((= cnt (car item)) (setq item (list cnt itm (cadr item))))
    )
  )
  item
)

[Keith™]

Well, I am at least glad I was in the middle of the pack and not at the bottom ...
Incedently I changed a few things in the code and tested it here, I came up with a much better run time of 203ms and 205ms on a random list of 1000 elements.

Code: [Select]


(defun cnt ( lst / count item maxnum )
  (setq maxnum 0)
  (foreach x lst
    (setq count (-(length lst)(length (vl-remove x lst))))
    (cond
      ((< count maxnum) nil)
      ((> count maxnum)(setq maxnum count item (list x)))
      ((not(member x item))(setq item (append (list x) item)))
    )
  )
  (list maxnum (reverse item))
)


[CAB]

Ooops, didn't look at you code Keith. Guess I didn't even get in the game
this go round.

[Keith™]

Ok third try .. since we are only testing numbers at this point try this one ...

CAB ... that is amazingly similar

Code: [Select]


(defun cnt ( lst / count item maxnum )
  (setq maxnum 0)
  (if (numberp (car lst))
    (setq shtlst (vl-sort lst '<))
    (setq shtlst lst)
  )
  (foreach x shtlst
    (setq count (-(length lst)(length (vl-remove x lst))))
    (cond
      ((< count maxnum) nil)
      ((> count maxnum)(setq maxnum count item (list x)))
      ((not(member x item))(setq item (append (list x) item)))
    )
  )
  (list maxnum (reverse item))
)