社区 › AutoLISP/Visual LISP 编程技术 › 高速分组

dcl1214 发表于 2024-10-30 18:06:49

高速分组

本帖最后由 dcl1214 于 2024-10-30 20:06 编辑

经常遇到需要根据一个字段（或者多个）的值对数据进行分组，一般都是用vl-remove-if-not 当数据达到了10万左右后，速度很慢，经过我研究，发现这个方法速度极快，哪位有更快的方法，拿来一起切磋一下

(defun $zi-duan-zhi-fen-zu$ (d zd lst / a old old-cdr v v-ks)
;($zi-duan-zhi-fen-zu$ (list(list(cons "名称" "瓷砖")(cons "颜色" "白")(cons "厚度" "5"))(list(cons "名称" "瓷砖")(cons "颜色" "米白")(cons "厚度" "5"))) "颜色" nil)
(cond((and zd (= (type zd) 'str))
   (while(setq a (car d))
   (setq v (cdr (assoc zd a)))
   (setq old (assoc v v-ks))
   (setq old-cdr (cdr old))
   (setq old-cdr (cons a old-cdr))
   (setq v-ks (vl-remove old v-ks))
   (setq
       v-ks (cons (cons v old-cdr) v-ks)
   )
   (setq d (cdr d))
   )
)
((and zd (= (type zd) 'list))
   (while(setq a (car d))
   (setq v (mapcar (function (lambda (b)
               (if (setq s (cdr (assoc b a)))
         (cons b s)
         (cons b "")
               )
             )
         )
         zd
       )
   )
   (setq old (assoc v v-ks))
   (setq old-cdr (cdr old))
   (setq old-cdr (cons a old-cdr))
   (setq v-ks (vl-remove old v-ks))
   (setq
       v-ks (cons (cons v old-cdr) v-ks)
   )
   (setq d (cdr d))
   )
)
)
v-ks
)

llsheng_73 发表于 2024-11-2 14:58:55

本帖最后由 llsheng_73 于 2024-11-3 13:56 编辑

tryhi 发表于 2024-10-31 22:50
;;返回从n-m之间的一个整数随机数
(defun try_Ran-fix(n m)(fix(+ n (rem (getvar "CPUTICKS")(- m n -1 ...
test-read里边应该是有问题的，用十来个数据测试后发现结果是错的
xy(cons (cdr(assoc zd a)) xy)这里有问题，字段值的顺序会乱，造成变量名和关键字顺序不一致，最终结果错误。
这个地方只能通过append往后增加新关键字才能保持顺序一致
通过动态重复定义变量，最后对所产生的变量逐一取值，避免重复对大表进行替换、连接等更新操作，确实对速度提升极为明显，唯一缺点是中途是产生较多全局变量，虽然结束前被重置为了nil，但始终感觉不太好，由于个在强迫症的原因，采用同样的思想，但临时结果不放到变量里边，而是放到表里边，通过内部函数nth<-来进行表的替换，经测试，速度还行，但有效避免了大量临时全局变量
楼主的测试数据子表各项有明确的字段名称，其优点在于数据可以很灵活，不依赖于字段顺序，缺点是增大数据量和处理步骤，下边的处理程序对数据不要求字段名，对于大表可以明显减少数据量，但缺点是对数据字段顺序要求很严格
(defun test-nth<-(lst m / a b c i n r);lst为待处理的关联表，m为关键字段在子表中位置，即以第几项为分组依据，整数；
(setq i -1 r(make-list(length lst)'(nil)))
(foreach a lst
    (if(setq b(nth m a)c(assoc b r))
      (setq n(vl-position c r))
      (setq i(1+ i)n i))
    (nth<- n(vl-list* b a(cdr c))r))
(vl-remove'(nil)r))
内部函数的激活采用高飞鸟的程序进行处理
((lambda(/ o s b);;;高飞鸟方法激活内部函数
      (or(=(type tranf)'USUBR)
   (progn(vl-load-com)
   (and(findfile(setq o(strcat(getenv "UserProfile")"\\Intern.fas")))
         (vl-file-delete o))
   (vlax-safearray-fill(setq s(vlax-create-object "ADODB.Stream")b(vlax-make-safearray 17 (cons 0 56)))
       (list 70 65 83 52 45 70 73 76 69 13 49 13 49 32 36 1 36 51 51 32 48 32 36 86 58 76 80 80 0 105 110
       116 101 114 110 0 108 112 112 45 115 121 109 102 117 110 45 62 97 108 0 0 57 3 0 22 36))
   (vlax-put-property s 'type 1)
   (vlax-invoke s(function open))
   (vlax-invoke-method s(function Write)b)
   (vlax-invoke-method s(function saveToFile)o 2)
   (vlax-invoke-method s(function close))
   (vl-every(function set)'(:lpp intern lpp-symfun->al)(mapcar'eval(load o)))
   (vl-file-delete o)
   (defun tranf(s)(lpp-symfun->al(intern s :lpp)))
   (tranf(function al-add-subr-name))
   (mapcar(function al-add-subr-name)'(al-add-subr-name lpp-symfun->al intern))))
      (vl-every(function tranf)'("init:autolisp-package""make-list""nth<-"))))

tryhi 发表于 2024-10-31 22:50:53

本帖最后由 tryhi 于 2024-10-31 22:54 编辑

(defun test-read (d zd)
(setq r nil xy nil)
(setq i -1)
(while (setq a(car d))
    (setq d(cdr d))
    (setq name (vl-position(cdr(assoc zd a))xy))
    (if (null name)
      (setq i (1+ i)
      name i
      xy(cons (cdr(assoc zd a)) xy)
      )
    )
    (setq sy (read (strcat"xy"(itoa name))))
    (set sy(consa(eval sy)))
   
)
(setq j -1)
(repeat (1+ i)
    (setq j (1+ j))
    (setq r(cons(eval (read (strcat"xy"(itoa j)))) r))
    (set (read (strcat"xy"(itoa j))) nil)
)
r
)
;;返回从n-m之间的一个整数随机数
(defun try_Ran-fix(n m)(fix(+ n (rem (getvar "CPUTICKS")(- m n -1)))))
(defun try-time-be () ;计时器开始
      ;(setq $try-timebe(getvar "TDUSRTIMER"));该变量不适用于高版本
      (setq $try-timebe(getvar "millisecs"))
)
(defun try-time-end (time p / tt) ;计时器结束
      (or time (setq time $try-timebe))
      ;(setq tt(* 86400000(- (getvar "TDUSRTIMER") time)))
      (setq tt(- (getvar "millisecs") time))
      (if p (print(strcat"经历时间为："(rtos tt 2 0)"毫秒")))
)

(setq d '());创建100万个元素
(repeat 1000000
      (setq r (itoa(try_Ran-fix 1 1000)));;1000种颜色
      (setq d(cons (list '("名称" "瓷砖")(cons "颜色" r)'("厚度" "5"))d))
)
(princ"\n测试开始\n")
(setq time(try-time-be))
($zi-duan-zhi-fen-zu$ d "颜色" nil)
(try-time-end time t);;10万7.4秒，100万83秒


(setq time(try-time-be))
(test-read d "颜色" )
(try-time-end time t);;10万2.5秒，100万25秒
(princ)



没想到用read只提速3倍，不过随手码的代码，感觉再优化下应该可以提速到4倍以上

tryhi 发表于 2024-11-3 20:40:54

llsheng_73 发表于 2024-11-2 14:58
test-read里边应该是有问题的，用十来个数据测试后发现结果是错的
xy(cons (cdr(assoc zd a)) xy)这里 ...

好几天没用过电脑，上面代码随手写没经过测试，不过临时变量这个思路对于某些大量数据场景可以很好的提高速度

tryhi 发表于 2024-10-30 18:27:07

本帖最后由 tryhi 于 2024-10-30 18:30 编辑

没注释没示例？参数都是啥？干啥用的？
杜老师能写一段创建十万元素的示例吗？

xyp1964 发表于 2024-10-30 18:48:46

lst参数有何用？代码里根本没用到

dcl1214 发表于 2024-10-30 22:45:43

xyp1964 发表于 2024-10-30 18:48
lst参数有何用？代码里根本没用到

今日好看的，他日有用

tryhi 发表于 2024-10-31 08:15:45

本帖最后由 tryhi 于 2024-10-31 22:49 编辑

没电脑测试，不知道杜老师这个跑100万元素要多久，感觉换个算法用read+eval，100万1秒应该问题不大吧，而且代码量还低，一个while解决

chixun99 发表于 2024-10-31 21:45:55

没看懂的收个藏。慢慢学习

dcl1214 发表于 2024-10-31 23:26:47

tryhi 发表于 2024-10-31 22:50
;;返回从n-m之间的一个整数随机数
(defun try_Ran-fix(n m)(fix(+ n (rem (getvar "CPUTICKS")(- m n -1 ...

每一个小表中80个字段，看看速度如何

tryhi 发表于 2024-11-1 07:20:14

本帖最后由 tryhi 于 2024-11-1 07:23 编辑

dcl1214 发表于 2024-10-31 23:26
每一个小表中80个字段，看看速度如何
出外业了，杜老师自己测一下哈，反正就是快

查看完整版本: 高速分组