一个速度很快又简洁的列表分段函数
分享一个速度很快又简洁的列表分段函数，不是我写的 网上找的 ，原作者不详。有没有比这个还快的？有的话请放上来对比下，谢谢！;;Sub-function to group a list of items into a list of multiple lists, each of length N, e.g.
;(setq lst'(1 2 3 4 5 6 7 8 9 10 11 12))
;(@group lst 3)返回((1 2 3)(4 5 6)(7 8 9)(10 11 12))
(defun @group (lst n / item new)
(foreach element(reverse lst)
(setq item(cons element item))
(if(= (length item) n)
(setq new (cons item new) item nil)
)
)
new
) 本帖最后由 llsheng_73 于 2022-10-7 18:30 编辑
tigcat 发表于 2022-10-7 17:47
我是运行后得到的结果。程序有个转置函数，从最后的元素开始满足。可以将cons换成list 与car组合。就不会 ...
我一直以来用的是while+repeat的，测试了下，速度确实比先reverse再foreach慢很多，综合了一下几个楼层的代码，得到代码如下，经测试，结果是正确的，速度还行吧,反正我要把我以前的换成下边这个了
(defun divlst(lst n / l l2)
(if(< 0 n(length lst))
(progn
(repeat(rem(length(setq lst(reverse lst)))n)
(setq l(cons(car lst)l)lst(cdr lst)))
(and l(setq l2(cons l l2)l nil))
(foreach x lst
(if(=(length(setq l(cons x l)))n)
(setq l2(cons l l2)l nil)))
l2)
(list lst)))
从表头开始，多余的尾巴保持在最后
(DIVLST '(1 2 3 4 5 6 7 8 9 10 11 12 13) 3)=>((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13))
(DIVLST '(1 2 3 4 5 6 7 8 9 10 11 12) 3)=>((1 2 3) (4 5 6) (7 8 9) (10 11 12))
例外情况处理
(DIVLST '(1 2 3 4 5 6 7 8 9 10 11 12 13) 50)=>((1 2 3 4 5 6 7 8 9 10 11 12 13))
(DIVLST '(1 2 3 4 5 6 7 8 9 10 11 12 13) -1)=>((1 2 3 4 5 6 7 8 9 10 11 12 13))
本帖最后由 guosheyang 于 2022-10-8 08:55 编辑
wzg356 发表于 2022-10-7 16:33
改用mapcar还可以提高10～20%速度，以前全测过mapacar比repeat，foreach，while都快
针对本实例经测试少量数据时foreach快些但是如果将列表的数据长度加大比如10万个 再repeat100次 则是mapcar形式的运行稍微快点这只是针对纯数字的针对文本点坐标数据可能又不一样需要多测试 但是套上mapcar 需要加上lambda临时函数 多了这些环节 总觉得没有foreach那么简洁这是代码
(defun @group2(lst n / ITEM N NEW X)
(mapcar'(lambda(x)
(setq item(cons x item))
(if(= (length item) n)
(setq new (cons item new) item nil)
)
)
(reverse lst)
)
new
)
本帖最后由 tigcat 于 2022-9-30 21:33 编辑
这个函数有个缺点,(setq lst'(1 2 3 4 5 6 7 8 9 10 11)),执行完后会丢失1 2。
我在网上找到另一个函数
;作者dexus
(defun pool (n lst / i rtn)
(while lst
(repeat (min n (length lst))
(setq i (cons (car lst) i)
lst (cdr lst))
)
(setq rtn (cons (reverse i) rtn)
i nil)
)
(reverse rtn)
)
;作者lee-mac
(defun GroupByNum (lst num / rtn) (setq rtn nil)
(if lst
(cons (reverse
(repeat num
(progn
(setq rtn (cons (car lst) rtn) lst (cdr lst)) rtn)))
(GroupByNum lst num))))
不完善，不足分组的会舍弃，应该这样
[*];;表分组----(一级)----
[*];(setq lst'(1 2 3 4 5 6 7 8 9 10 11 12 13))
[*];(xl-div lst 3)返回((1 2 3)(4 5 6)(7 8 9)(10 11 12) (13))
[*](defun xl-div (lst x / item new)
[*](foreach n (reverse lst)
[*] (setq item (cons n item))
[*] (if (= (length item) x)
[*] (setq new (cons item new) item nil)
[*] )
[*])
[*](setq new (cons item new))
[*]new
[*])
尘缘一生 发表于 2022-9-30 21:35
不完善，不足分组的会舍弃，应该这样
3#楼返回值应该((1) (2 3 4) (5 6 7) (8 9 10) (11 12 13))是这样子。 tigcat 发表于 2022-9-30 21:31
这个函数有个缺点,(setq lst'(1 2 3 4 5 6 7 8 9 10 11)),执行完后会丢失1 2。
我在网上找到另一个函数
; ...
这两个代码也不错不过还是没有我提供的那个快重复十万次可以看相互差别
(progn
(setq stime (getvar "millisecs"));;计时起点
(repeat 100000
(@group lst 3)
)
(setq zsj(-(getvar "millisecs") stime))
) 尘缘一生 发表于 2022-9-30 21:35
不完善，不足分组的会舍弃，应该这样
感谢你优化！ ;; 我分享一个递归法（包含两个函数）
;; ------------------------------------------------------------
;; [功能] 按照指定长度拆分表
;; (Split '(0 1 2 3 4 5 6 7 8 9) 4)
(defun Split (L N)
(if L
(cons (car (setq L (Break L N)))
(Split (cadr L) N)
)
)
)
;; ------------------------------------------------------------
;; [功能] 将表在指定位置断开，并返回包含两个子表的表
;; (Break '(1 2.5 2.8 3.5 5 7 3 4 6) 4)
(defun Break (L N / *F* X)
(defun *F* (L N)
(if (setq X L)
(if (/= N 0)
(cons (car X) (*F* (cdr X) (1- N)))
)
)
)
(list (*F* L N) X)
) caoyin 发表于 2022-10-1 12:04
;; 我分享一个递归法（包含两个函数）
;; ------------------------------------------------------------ ...
感谢版主共享，节日快乐！ guosheyang 发表于 2022-10-1 12:17
感谢版主共享，节日快乐！
节日快乐:handshake tigcat 发表于 2022-9-30 21:31
这个函数有个缺点,(setq lst'(1 2 3 4 5 6 7 8 9 10 11)),执行完后会丢失1 2。
我在网上找到另一个函数
; ...
恩，不错，这个才是正确的。顶楼函数有问题，不要下。