高速分组

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
)

(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<-"))))

((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(cons a(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个字段，看看速度如何

出外业了，杜老师自己测一下哈，反正就是快

账号		自动登录	找回密码
密码			注册

[讨论] 高速分组

评分

评分