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

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