Topic: Count Items in a list

[Q1241274614]

Can you help me to have a look how fast the statistical number of the same string
thank！
("JB1X22X40X100X20X8"
"JB1X26X50X120X40X10"
"JB1X22X40X100X20X8"
"JB1X30X60X150X40X16"
"JB2X23X50X100X20X8"
"JB2X23X40X100X20X8"
"JB2X30X60X150X40X16"
"JB1X26X50X120X40X10"
"JB2X26X50X120X40X10"
"JB2X30X60X150X40X16"
"JB1X30X60X150X40X16"
"JB2X23X50X100X20X8"
"JB1X26X50X120X40X10"
"JB2X30X60X150X40X16"
"JB2X26X50X120X40X10"
"JB1X30X60X150X40X16"
"JB2X23X40X100X20X8"
"JB2X26X50X120X40X10"
"JB1X30X60X150X40X16"
"JB2X30X60X150X40X16"
"JB3X40X60X155X40X16"
 )

("JB1X22X40X100X20X8" 2)
("JB1X26X50X120X40X10" 3 )
("JB1X30X60X150X40X16" 4)
("JB2X23X40X100X20X8" 2)
("JB2X23X50X100X20X8" 2)
("JB2X26X50X120X40X10" 3)
("JB2X30X60X150X40X16" 4)
("JB3X40X60X155X40X16" 1)

[CAB]

Maybe this:

Code: [Select]

(defun count (lst / i cnt nlst)
  (while (setq i (car lst))
    (setq lst (cdr lst)
          cnt (length lst))
    (setq lst (vl-remove i lst)
          nlst (cons (list i (1+ (- cnt (length lst)))) nlst))
  )
  nlst
)

[Q1241274614]

thank

[Marc'Antonio Alessi]

IMHO I think for this new question is better to start a new thread...
Very similar CAB version:

Code: [Select]

(defun count2 (In_Lst / OutLst TmpLst)
 (while In_Lst
  (setq
    TmpLst (car In_Lst)
    OutLst
    (cons
      (cons
        TmpLst
        (-
          (length In_Lst)
          (length (setq In_Lst (vl-remove TmpLst In_Lst)))
        )
      )
      OutLst
    )
  )
 )
)

; Michael Puckett - Foreach "old style"
(defun TallyList ( lst / result pair )
   (reverse
      (foreach x lst
         (setq result
            (if (setq pair (assoc x result))
               (subst (cons x (1+ (cdr pair))) pair result)
               (cons (cons x 1) result)
            )
         )
      )
   )
)


[Lee Mac]

Another:

Code: [Select]

(defun _count ( l / c x )
    (if (setq x (car l))
        (progn
            (setq c (length l)
                  l (vl-remove x (cdr l))
            )
            (cons (cons x (- c (length l))) (_count l))
        )
    )
)

[pBe]

Talk about "old style" 

Code: [Select]

(defun countOLDer (lst / counted)
  (setq lst (acad_strlsort lst))
     (while (setq a (car lst))
                (setq n 1)
                (while (eq a (car (setq lst (cdr lst))))
                                (setq n ( + n 1))
                          )
             (setq counted (cons (list a n) counted)))
  )


[Lee Mac]

Code: [Select]

(defun countOLDer (lst / counted)
< ... >

Nice variation pBe 

[Marc'Antonio Alessi]

Another:

Code: [Select]

(defun _count ( l / c x ) ...

Recursion is often shorter and beautiful but sometimes can be slower and can bomb on very very very log list:

(setq aList '("JB1X22X40X100X20X8"
"JB1X26X50X120X40X10""JB1X22X40X100X20X8""JB1X30X60X150X40X16""JB2X23X50X100X20X8"
"JB2X23X40X100X20X8""JB2X30X60X150X40X16""JB1X26X50X120X40X10""JB2X26X50X120X40X10"
"JB2X30X60X150X40X16""JB1X30X60X150X40X16""JB2X23X50X100X20X8""JB1X26X50X120X40X10"
"JB2X30X60X150X40X16""JB2X26X50X120X40X10""JB1X30X60X150X40X16""JB2X23X40X100X20X8"
"JB2X26X50X120X40X10""JB1X30X60X150X40X16""JB2X30X60X150X40X16""JB3X40X60X155X40X16"
) )
(progn
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (setq alist (append alist alist alist alist))
  (princ)
)
;(length alist) 5505024

[Lee Mac]

Another:

Code: [Select]

(defun _count ( l / c x ) ...

Recursion is often shorter and beautiful but sometimes can be slower and can bomb on very very very log list:

Of course 

[Q1241274614]

(list
(list "JB1X22X40X100X20X8"   a1)
(list"JB1X26X50X120X40X10"   a2)
(list"JB1X22X40X100X20X8"    a3)
(list"JB1X30X60X150X40X16"   a4)
(list"JB2X23X50X100X20X8"    a5)
(list"JB2X23X40X100X20X8"    a6)
(list"JB2X30X60X150X40X16"   a7)
(list"JB1X26X50X120X40X10"   a8)
(list"JB2X26X50X120X40X10"   a9)
(list"JB2X30X60X150X40X16"   a10)
(list"JB1X30X60X150X40X16"   a11)
(list"JB2X23X50X100X20X8"    a12)
(list"JB1X26X50X120X40X10"   a13)
(list"JB2X30X60X150X40X16"   a14)
(list"JB2X26X50X120X40X10"   a15)
(list"JB1X30X60X150X40X16"   a16)
(list"JB2X23X40X100X20X8"    a17)
(list"JB2X26X50X120X40X10"   a18)
(list"JB1X30X60X150X40X16"   a19)
(list"JB2X30X60X150X40X16"  a20)
(list"JB3X40X60X155X40X16"  a21)
 )

("JB1X22X40X100X20X8" 2   (a1 a3))
("JB1X26X50X120X40X10" 3  (a13 a2 a9))
("JB1X30X60X150X40X16" 4  (a?  a?  a?  a?) )
("JB2X23X40X100X20X8" 2   (a?  a?))
("JB2X23X50X100X20X8" 2   (a?  a?))
("JB2X26X50X120X40X10" 3  (a?  a?  a?))
("JB2X30X60X150X40X16" 4  (a?  a?  a?  a?))
("JB3X40X60X155X40X16" 1  (a21 ))


Statistical number at the same time the corresponding pixel is classified

[pBe]

Code: [Select]

(defun countOLDer (lst / counted)
< ... >

Nice variation pBe 

Thank you Lee, its a dinosaur but somebody's  got to do it; 

Heres one for the OPS new list:

Code: [Select]

(defun countvar  (lst / a b c d n)
      (while (setq a (Car lst))
            (setq n 0)
            (while (setq b (assoc (Car a) lst))
                  (setq n   (1+ n )
                        c   (cons (cadr b) c)
                        lst (vl-remove b lst)))
            (setq d (cons (list (Car a) n c) d)
                  c nil))
      d
      )

BTW: are those variables?
(list "JB1X22X40X100X20X8"   a1);<--- that

Also i change the format to:
(setq lst '(( "JB1X22X40X100X20X8"   a1)("JB1X26X50X120X40X10"   a2)("JB1X22X40X100X20X8"    a3).......)

[Lee Mac]

One more to boil the brain 

Code - Auto/Visual Lisp: [Select]

1. (defun f ( l / g h )
2.     (defun g ( k l )
3.         (cond
4.             ((= k (caar l)) (cons (list k (1+ (cadar l))) (cdr l)))
5.             (l (cons (car l) (g k (cdr l))))
6.             ((list (list k 1)))
7.         )
8.     )
9.     (defun h ( l r )
10.         (if l (h (cdr l) (g (car l) r)) r)
11.     )
12.     (h l nil)
13. )

Code - Auto/Visual Lisp: [Select]

1. _$ (f '("a" "b" "c" "d" "b" "a"))
2. (("a" 2) ("b" 2) ("c" 1) ("d" 1))

[Marc'Antonio Alessi]

One more to boil the brain 

Very deep but slower 

Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Elapsed milliseconds / relative speed for 16384 iteration(s):

    (_COUNT ALIST).....1856 / 3.61 <fastest>
    (F ALIST)..........6708 / 1 <slowest>

(length alist)=21

(_count '("a" "b" "c" "d" "b" "a"))
= > (("a" . 2) ("b" . 2) ("c" . 1) ("d" . 1)) >> ("a" > . < 2)  :pissed:

[Lee Mac]

Very deep but slower 

If I were aiming for raw performance, I would not be using recursion... 

[Keith™]

Ok, here is mine ... buyer beware

Code: [Select]

(defun _count (l / nl)
  (foreach item l
    (if (not(member item nl))
      (setq
nl (append
     nl
     (list item
   (- (length l) (length (setq l (vl-remove item l))))
     )
   )
      )
    )
  )
  nl
)


[Marc'Antonio Alessi]

Very deep but slower 

If I were aiming for raw performance, I would not be using recursion... 

It is a very new approach  :kewl:
 

[Lee Mac]

It is a very new approach  :kewl:
 

I guess you're new here 

[Keith™]

It is a very new approach  :kewl:
 

I guess you're new here 

What was the first clue?
Perhaps the post count?

regardless, recursion does work and is elegant and useful in some cases ... but you knew that already

[Marc'Antonio Alessi]

It is a very new approach  :kewl:
 

I guess you're new here 

new but very old... 

[Marc'Antonio Alessi]

regardless, recursion does work and is elegant and useful in some cases ... but you knew that already

Yes about recursion.

My 2 cents: append IS very slow:
(append
  nl
  (list item
      (- (length l) (length (setq l (vl-remove item l))))
  )
)
My apologies for my english. 

[JohnK]

I think you can shave a little more off your function Lee (forgive me if I'm wrong; I have a hard time with lisp now).
Quick once through look.

Code - Auto/Visual Lisp: [Select]

1. (defun _count ( l / c x )
2.   (cond
3.     ((setq x (car l)
4.            l (vl-remove x (cdr l)))
5.      (cons (cons x (- (length l) (length l))) (_count l))
6.      )
7.     )
8.   )

[Lee Mac]

I think you can shave a little more off your function Lee (forgive me if I'm wrong; I have a hard time with lisp now).
Quick once through look.

Code - Auto/Visual Lisp: [Select]

1. (defun _count ( l / c x )
2.   (cond
3.     ((setq x (car l)
4.            l (vl-remove x (cdr l)))
5.      (cons (cons x (- (length l) (length l))) (_count l))
6.      )
7.     )
8.   )

Not quite, since (- (length l) (length l)) will always return zero, and you will also miss the last item of the list; but thank you for your interest Se7en, I appreciate your suggestion.

[Lee Mac]

The [much faster] iterative version might be:

Code - Auto/Visual Lisp: [Select]

1. (defun _count ( l / c l r x )
2.     (while l
3.         (setq x (car l)
4.               c (length l)
5.               l (vl-remove x (cdr l))
6.               r (cons (cons x (- c (length l))) r)
7.         )
8.     )
9.     (reverse r)
10. )

[JohnK]

Not quite ...

*nod* Well, it was worth a shot (I'm surprised I got that far ;] ).

[David Bethel]

Maybe:

Code - Auto/Visual Lisp: [Select]

1. (defun item_cnt (data / cl q)
2.   (foreach a data
3.     (setq cl (if (setq q (cadr (assoc a cl)))
4.                  (subst (list a (1+ q)) (assoc a cl) cl)
5.                  (cons (list a 1) cl))))
6.  cl)
7.  

-David

[Q1241274614]

;;;result
;;;(
;;;(JB2X23X40X100X20X8 (a6 a17))
;;;(JB2X23X50X100X20X8 (a12 a5))
;;;(JB2X26X50X120X40X10 (a9 a15 a18))
;;;(JB1X30X60X150X40X16 (a19 a16 a11 a4))
;;;(JB2X30X60X150X40X16 (a7 a10 a14 a20))
;;;(JB1X26X50X120X40X10 (a13 a8 a2))
;;;(JB3X40X60X155X40X16 (a21))
;;;(JB1X22X40X100X20X8 (a3 a1))
;;


(defun c:test( / )
(setq aa
(list
(list "JB1X22X40X100X20X8"   "a1")
(list"JB1X26X50X120X40X10"   "a2")
(list"JB1X22X40X100X20X8"    "a3")
(list"JB1X30X60X150X40X16"   "a4")
(list"JB2X23X50X100X20X8"    "a5")
(list"JB2X23X40X100X20X8"    "a6")
(list"JB2X30X60X150X40X16"   "a7")
(list"JB1X26X50X120X40X10"   "a8")
(list"JB2X26X50X120X40X10"   "a9")
(list"JB2X30X60X150X40X16"   "a10")
(list"JB1X30X60X150X40X16"   "a11")
(list"JB2X23X50X100X20X8"    "a12")
(list"JB1X26X50X120X40X10"   "a13")
(list"JB2X30X60X150X40X16"   "a14")
(list"JB2X26X50X120X40X10"   "a15")
(list"JB1X30X60X150X40X16"   "a16")
(list"JB2X23X40X100X20X8"    "a17")
(list"JB2X26X50X120X40X10"   "a18")
(list"JB1X30X60X150X40X16"   "a19")
(list"JB2X30X60X150X40X16"  "a20")
(list"JB3X40X60X155X40X16"  "a21")
 )   
 )
(setq b (item_sort aa))
(princ b)
(princ)
  )
(defun item_sort ( l / c l r x e  aa ll)
              (while l  (setq  x (caar l)
                e (cons (cadar l) e)
                l (cdr l)   
          )   
         (foreach y l
               (if  (= (car y) x)
               (setq e (cons (cadr y) e))
               (setq ll (cons y ll))       
                )
           )
          (setq aa (cons (list x e) aa) l ll  e nil  ll nil)
      )
  aa
  )

Maybe I didn't express clearly.I hope this result.Can optimize a (item_sort)？

[pBe]

Really now Q1241274614, you change your requirement from this:

(list "JB1X22X40X100X20X8" a1);<--- note second element not a string, hence my Q about being a variable
(list"JB1X22X40X100X20X8"a3)
Result
("JB1X22X40X100X20X8" 2 (a1 a3));<--- note the second element as quantity of found match

Now to this:
(list "JB1X22X40X100X20X8" "a1");<--- both elements as string
(list "JB1X22X40X100X20X8" "a13")
Result
("JB1X22X40X100X20X8" ("a3" "a1"));<-- quantity, gone, not there, not included.

Please make up you mind Q1241274614 

Code: [Select]

(defun countvar  (l / a b c d )
      (while (setq a (Car l))
            (while (setq b (assoc (Car a) l))
                  (setq c   (cons (cadr b) c)
                        l (vl-remove b l)))
            (setq d (cons (list (Car a)  c) d)
                  c nil))
      d
      )


[Marc'Antonio Alessi]

The [much faster] iterative version might be:

Code - Auto/Visual Lisp: [Select]

1. (defun _count ( l / c l r x ) ...
2.  

Yes it is very similar but is faster on long list:

Code: [Select]

Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (COUNT2 ALIST)......1966 / 1.03 <fastest>
    (_COUNT3 ALIST).....2028 / 1 <slowest>

Elapsed milliseconds / relative speed for 1 iteration(s):

    (_COUNT3 ALIST).....2996 / 1.26 <fastest>
    (COUNT2 ALIST)......3776 / 1 <slowest>


[MP]

Necro-thread resurrection ...

Had to write a "find all positions of x in list" type function today and realized it could be used to "count items in a list".

Not saying it's the fastest (haven't benched it) but it's a different spin which is always good for algorithm fodder ...

Code: [Select]

(defun _Positions ( x lst / p )
    ;;  find all the n positions of x in lst
    ;;  (_Positions 1 '(0 0 1 0 0 1)) >> (2 5)
    (if (setq p (vl-position x lst))
        (   (lambda ( lst result )
                (while (setq p (vl-position x lst))
                    (setq
                        result (cons (+ 1 p (car result)) result)
                        lst    (cdr (member x lst))
                    )
                )
                (reverse result)
            )
            (cdr (member x lst))
            (list p)
        )
    )   
)
And:

Code: [Select]

(defun _Tally ( x lst )
    ;;  count all the occurances of x in lst
    ;;  (_Tally 1 '(0 0 1 0 0 1)) >> 2
    (length (_Positions x lst))
)
For what it's worth, cheers.

[Marc'Antonio Alessi]

New test:

Code: [Select]

(progn
  (setq aList nil Countr 0)
  (repeat 10000 (setq aList (cons (setq Countr (1+ Countr)) aList)));100000
  (repeat 4 (setq Alist (append Alist Alist))) ;5
  (princ "\nLength   : ") (princ (length aList))
  (princ "    Positions: ") (princ (length (ALE_PositionS 1   Alist))) (princ "\n ") (princ)
)
(Benchmark '(
(MP_Positions 1   Alist)
(SK_index 1   Alist)
(MP_Positions 1   Alist)
(SK_index 1   Alist)
)   

Code: [Select]

Length   : 160000    Positions: 16
Elapsed milliseconds / relative speed for 512 iteration(s):
    (SK_INDEX 1 ALIST).........1531 / 1.01 <fastest>
    (MP_POSITIONS 1 ALIST).....1546 / 1
    (SK_INDEX 1 ALIST).........1547 / 1
    (MP_POSITIONS 1 ALIST).....1547 / 1 <slowest>

Length   : 160000    Positions: 16
Elapsed milliseconds / relative speed for 512 iteration(s):
    (MP_POSITIONS 1 ALIST).....1547 / 1 <fastest>
    (SK_INDEX 1 ALIST).........1547 / 1
    (MP_POSITIONS 1 ALIST).....1547 / 1
    (SK_INDEX 1 ALIST).........1547 / 1 <slowest>


Code: [Select]

; Stefan
(defun SK_index (n l / i j r)
  (setq j -1)
  (while  (setq i (vl-position n l))
    (setq r (cons (setq j (+ 1 i j)) r))
    (setq l (cdr (member n l)))
  )
  (reverse r)
)

[MP]

Of all the weird ways to say "that flavor has already been written" that was the most recent I've read.

I don't recall seeing Stefan's submission before -- great minds think alike?

[Marc'Antonio Alessi]

Of all the weird ways to say "that flavor has already been written" that was the most recent I've read.

I don't recall seeing Stefan's submission before -- great minds think alike?

https://www.theswamp.org/index.php?topic=50539.msg556727#msg556727
 

[MP]

Cool beans, thanks Marc.

[Grrr1337]

Nice thread, thanks for bumping it up. Now I've remembered that gotta figure out such counter for an association lists.

Code: [Select]

(list
'("A" "B" 10)
'("A" "C" 20)
'("B" "C" 10)
'("A" "B" 10)
'("A" "C" 20)
'("A" "B" 10)
)
-->
(list
'(("A" "B" 10) . 3)
'(("A" "C" 20) . 2)
'(("B" "C" 10) . 1)
)


[MP]

It's been done. I'd search for you but I'm sick as a dawg right now.

[Grrr1337]

It's been done. I'd search for you but I'm sick as a dawg right now.

Thanks for comfirming, I feel relatively new for theswamp so I have no idea whats below the surface, expect big fishes.

[MP]

Given a couple quick and dirty functions (not hardly optimized) ...

Code: [Select]

(defun _Positions ( x lst / p )
    ;;  find all the positions of x in lst
    ;;  (_Positions 1 '(0 0 1 0 0 1)) >> (2 5)
    (if (setq p (vl-position x lst))
        (   (lambda ( lst result )
                (while (setq p (vl-position x lst))
                    (setq
                        result (cons (+ 1 p (car result)) result)
                        lst    (cdr (member x lst))
                    )
                )
                (reverse result)
            )
            (cdr (member x lst))
            (list p)
        )
    )   
)

Code: [Select]

(defun _Tally ( x lst )
    ;;  count all the occurances of x in lst
    ;;  (_Tally 1 '(0 0 1 0 0 1)) >> 2
    (length (_Positions x lst))
)

Code: [Select]

(defun _Distil ( lst / result )
    (while lst
        (setq
            result (cons (car lst) result)
            lst    (vl-remove (car result) (cdr lst))
        )
    )
    (reverse result)       
)

Code: [Select]

(defun _TallyHo ( lst )
    (mapcar
        (function (lambda (x) (cons x (_Tally x lst))))
        (_Distil lst)
    )
)
Then ...

(_TallyHo
   '(
       ("A" "B" 10)
       ("A" "C" 20)
       ("B" "C" 10)
       ("A" "B" 10)
       ("A" "C" 20)
       ("A" "B" 10)
    )
)

>>

(
   (("A" "B" 10) . 3)
   (("A" "C" 20) . 2)
   (("B" "C" 10) . 1)
)

Cheers (now where'd I'd leave that big bowl ...).

[Marc'Antonio Alessi]

Cool beans, thanks Marc.

If we can go on demential:

Code: [Select]

Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Length   : 160000    Positions: 16
Elapsed milliseconds / relative speed for 512 iteration(s):
    (ALE_POSITIONSD 1 ALIST).....1828 / 2.56 <fastest>
    (ALE_POSITIONSD 1 ALIST).....1844 / 2.53
    (MP_POSITIONS 1 ALIST).......4625 / 1.01
    (MP_POSITIONS 1 ALIST).......4672 / 1 <slowest>


Code: [Select]

; 20161206
(defun ALE_PositionSd (i l / n r c) ; ALE_PositionS(demential)
  (setq n -1)
  (while (setq c (vl-position i l))
    (setq l (cdr (ALE_List_NthCdr c l))  r (cons (setq n (+ 1 c n)) r))
  )
  (reverse r)
)ALE_List_NthCdr  see: https://www.theswamp.org/index.php?topic=46419.msg514475#msg514475

[Grrr1337]

Given a couple quick and dirty functions (not hardly optimized) ...
<...>
Cheers (now where'd I'd leave that big bowl ...).

This is a good start, thanks alot MP! 

[MP]

You're very welcome, thanks for the thanks, cheers.