Topic: Count unique items of multidimensional list by member-list

[NICK_VNV]

Here is a useful function made by Lee Mac:
 

Code - Auto/Visual Lisp: [Select]

1. ;; Count Items  -  Lee Mac
2. ;; Returns a list of dotted pairs detailing the number of
3. ;; occurrences of each item in a supplied list.
4.  
5. (defun LM:CountItems ( l / c l r x )
6.     (while l
7.         (setq x (car l)
8.               c (length l)
9.               l (vl-remove x (cdr l))
10.               r (cons (cons x (- c (length l))) r)
11.         )
12.     )
13.     (reverse r)
14. )
15. ; Example
16. (LM:CountItems '("A" "B" "B" "B" "C" "C" "D" "E" "E" "E" "E"))
17. =>  (("A" . 1) ("B" . 3) ("C" . 2) ("D" . 1) ("E" . 4))
18.  

Please show how to modify this function to get the result:
 
 

Code - Auto/Visual Lisp: [Select]

1.  ; if we have a list
2.  (setq lst '(
3.                                 (("a" "1") ("b" "2") ("c" "3")("d" "6"))
4.                                 (("a" "2") ("b" "4") ("c" "5")("d" "4"))
5.                                 (("a" "2") ("b" "4") ("c" "5")("d" "2"))
6.                                 (("a" "3") ("b" "3") ("c" "6")("d" "3"))
7.                         )
8. )
9.  
10. ; new function
11. (LM:CountItems_by_member  lst  (list "a" "b" "c") )
12. => (
13.                 (("a" "1") ("b" "2") ("c" "3")("count" "1"))
14.                 (("a" "2") ("b" "4") ("c" "5")("count" "2"))
15.                 (("a" "3") ("b" "3") ("c" "6")("count" "1"))
16.           )
17.  

      

[Lee Mac]

Here is a quick hack:

Code - Auto/Visual Lisp: [Select]

1. (defun f ( l i / x c r )
2.     (setq l (mapcar '(lambda ( x ) (vl-remove-if-not '(lambda ( x ) (member (car x) i)) x)) l))
3.     (while l
4.         (setq x (car l)
5.               c (length l)
6.               l (vl-remove x (cdr l))
7.               r (cons (append x (list (list "count" (itoa (- c (length l)))))) r)
8.         )
9.     )
10.     (reverse r)
11. )

Code - Auto/Visual Lisp: [Select]

1. (setq lst
2.    '(
3.         (("a" "1") ("b" "2") ("c" "3")("d" "6"))
4.         (("a" "2") ("b" "4") ("c" "5")("d" "4"))
5.         (("a" "2") ("b" "4") ("c" "5")("d" "2"))
6.         (("a" "3") ("b" "3") ("c" "6")("d" "3"))
7.     )
8. )
9. _$ (f lst '("a" "b" "c"))
10. (
11.     (("a" "1") ("b" "2") ("c" "3") ("count" "1"))
12.     (("a" "2") ("b" "4") ("c" "5") ("count" "2"))
13.     (("a" "3") ("b" "3") ("c" "6") ("count" "1"))
14. )

[ribarm]

slow hack...

Code - Auto/Visual Lisp: [Select]

1. (setq lst  '(
2.               (("a" "1") ("b" "2") ("c" "3") ("d" "6"))
3.               (("a" "2") ("b" "4") ("c" "5") ("d" "4"))
4.               (("a" "2") ("b" "4") ("c" "5") ("d" "2"))
5.               (("a" "3") ("b" "3") ("c" "6") ("d" "3"))
6.             )
7. )
8.  
9. (setq mlst '("a" "b" "c"))
10.  
11. (defun c_i_b_m ( lst mlst / lsta xlst xlsta ilst lstt x c r )
12.  
13.   (defun unique ( l )
14.     (if l (cons (car l) (vl-remove (car l) (unique (cdr l)))))
15.   )
16.  
17.   (setq lsta (apply 'append lst))
18.   (foreach m lsta
19.     (if (not (member (car m) mlst))
20.       (setq xlst (cons (car m) xlst))
21.     )
22.   )
23.   (setq xlst (unique xlst))
24.   (foreach i lst
25.     (foreach x xlst
26.       (setq xlsta (mapcar '(lambda (z) (if (eq x (car z)) z)) i))
27.     )
28.     (setq xlsta (vl-remove nil xlsta))
29.     (setq ilst i)
30.     (foreach x xlsta
31.       (setq ilst (vl-remove x ilst))
32.     )
33.     (setq xlsta nil)
34.     (setq lstt (cons ilst lstt))
35.   )
36.   (setq lstt (reverse lstt))
37.   (while lstt
38.      (setq x (car lstt)
39.            c (length lstt)
40.            lstt (vl-remove x (cdr lstt))
41.            r (cons (append x (list (list "count" (itoa (- c (length lstt)))))) r)
42.      )
43.   )
44.   (reverse r)
45. )
46.  

[NICK_VNV]

Thank you guys for help and quick reply! 
I also tried to make a version of function without counting items (just removing duplicates), and seems it works:

Code - Auto/Visual Lisp: [Select]

1. (defun f2 ( l i / x c r )
2.     (setq l (mapcar '(lambda ( x ) (vl-remove-if-not '(lambda ( x ) (member (car x) i)) x)) l))
3.     (while l
4.         (setq x (car l)
5.               c (length l)
6.               l (vl-remove x (cdr l))
7.               r (cons x r)
8.         )
9.     )
10.     (reverse r)
11. )
12.  
13. ;;; example
14. (setq lst  '(
15.               (("a" "1") ("b" "2") ("c" "3") ("d" "6"))
16.               (("a" "2") ("b" "4") ("c" "5") ("d" "4"))
17.               (("a" "2") ("b" "4") ("c" "5") ("d" "2"))
18.               (("a" "3") ("b" "3") ("c" "6") ("d" "3"))
19.             )
20. )
21.  
22. _$ (f2 lst '("a" "b" "c"))
23. (
24.     (("a" "1") ("b" "2") ("c" "3"))
25.     (("a" "2") ("b" "4") ("c" "5"))
26.     (("a" "3") ("b" "3") ("c" "6"))
27. )
28.