Topic: Help filtering a list

[It's Alive!]

I need to turn this.

Code: [Select]

(
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (2 "Sink18x24" "18x24 Sink" 185.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (3 "Sink24x24" "24x24 Sink" 205.5)
 (1 "Sink12x12" "12x12 Sink" 175.5)
)

into this

Code: [Select]

(
 ;(QTY (list)
 (10 (1 "Sink12x12" "12x12 Sink" 175.5))
 (10 (2 "Sink18x24" "18x24 Sink" 185.5))
 (10 (3 "Sink24x24" "24x24 Sink" 205.5)
)

where the first item in each sub list is the ID
is there something similar already written I can work with?
Thanks 

[It's Alive!]

got it

Code: [Select]

(defun fun (ls / cnt e1 e2 itm len lsout)
  (setq lsout '())
  (setq ls (vl-sort ls
        (function (lambda (e1 e2)
              (< (car e1) (car e2))))))       
   ;CAB @ TheSwamp                           
  (while (setq itm (car ls))
    (setq len (length ls))
    (setq ls (vl-remove itm ls)
          cnt (- len (length ls))
          lsout (cons (cons cnt (list itm)) lsout)
    )
  )
)

thanks CAB  http://www.theswamp.org/index.php?topic=13259.msg160756#msg160756

[Lee Mac]

Perhaps slightly quicker:

Code: [Select]

(defun LM:ListOccurrences ( lst / out x )
  ;; © Lee Mac 2010
  (while
    (progn
      (setq out
        (cons
          (list
            (- (length lst)
              (length
                (setq lst
                  (vl-remove (setq x (car lst)) lst)
                )
              )
            )
            x
          )
          out
        )
      )
      lst
    )
  )

  (vl-sort out '(lambda ( a b ) (< (caadr a) (caadr b))))
)


Code: [Select]

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

    (LM:LISTOCCURRENCES LST).....1389 / 1.44 <fastest>
    (FUN LST)....................1996 / 1.00 <slowest>


[It's Alive!]

Nice, Thank you..
It's for a sqlitelsp sample, I really need to get back and spend time with lisp 

Code: [Select]

(DEFUN C:CREATETABLE (/ db)
  (SETQ DB "C:\\MySQLite.db")
  (DSQL_OPEN DB)
  (DSQL_DML DB "CREATE TABLE Products (ID INT unique, Name TEXT, Desc TEXT, Cost FLOAT);")
  ;
  (DSQL_DML DB "begin transaction;")
  (DSQL_DML DB "REPLACE INTO Products VALUES (1, 'Sink12x12', '12x12 Sink' , %g );" 175.50)
  (DSQL_DML DB "REPLACE INTO Products VALUES (2, 'Sink18x24', '18x24 Sink' , %g );" 185.50)
  (DSQL_DML DB "REPLACE INTO Products VALUES (3, 'Sink24x24', '24x24 Sink' , %g );" 205.50)
  (DSQL_DML DB "commit transaction;")
  (DSQL_CLOSE DB)
)


(defun LM:ListOccurrences2 ( lst / out item x )
  ;; © Lee Mac 2010 @ theswamp.org
  (while
    (progn
      (setq item
        (list
          (- (length lst)
            (length
              (setq lst
                (vl-remove (setq x (car lst)) lst)
              )
            )
          )
          x
        )
      )
      (if out
        (if (< (car a) (car b))
          (setq out (cons item out))
          (setq out (append out (list item)))
        )
        (setq out (cons item out))
      )
      lst
    )
  )
  out
)


;;;
(defun c:doit (/ activedocument c db iacadapplication ls modelspace res s)
  (vl-load-com)
  (setq IAcadApplication (vlax-get-acad-object)
        ActiveDocument (vla-get-ActiveDocument IAcadApplication)
        ModelSpace (vla-get-ModelSpace ActiveDocument)
        ls '()
        DB "C:\\MySQLite.db"
        s (ssget (list (cons 0 "INSERT")))
        c 0
  )
  (if s
    (progn
      (DSQL_OPEN DB)
      (While (< c (sslength s))
        (setq e (vlax-ename->vla-object (cdr (car (entget (ssname s c)))))
              res (DSQL_QUERY DB "SELECT * FROM Products where Name=('%s');" (vlax-get e 'name))
        )
        (if res
          (setq ls (append(list (cadr res)) ls))
        )
        (setq c (1+ c))
      )
      (DSQL_CLOSE DB)
    )
    (alert (strcat "Could Not find any products"))
  )
  (LM:ListOccurrences2  ls)
)



[Kerry]

just a side issue

could you use the sql COUNT( ...

[Lee Mac]

Sorry Dan, not sure what I was thinking with that last one - it won't work in all situations (and it had a typo) - how embarassing.

[It's Alive!]

...it had a typo...

geeze, like I've never had one of those 

Thanks a ton for the update : )

[Lee Mac]

...it had a typo...

geeze, like I've never had one of those 

Thanks a ton for the update : )

No worries