明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1417|回复: 24

[函数] 一个速度很快又简洁的列表分段函数

[复制链接]
发表于 2022-9-30 20:09 | 显示全部楼层 |阅读模式
分享一个速度很快又简洁的列表分段函数,不是我写的 网上找的 ,原作者不详。有没有比这个还快的?有的话请放上来对比下,谢谢!
;;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
)

点评

很难比这个更快了估计。。。只是结果有点小问题  发表于 2022-10-7 18:39

评分

参与人数 1明经币 +1 收起 理由
tigcat + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2022-10-7 18:03 | 显示全部楼层
本帖最后由 llsheng_73 于 2022-10-7 18:30 编辑
tigcat 发表于 2022-10-7 17:47
我是运行后得到的结果。程序有个转置函数,从最后的元素开始满足。可以将cons换成list 与car组合。就不会 ...

我一直以来用的是while+repeat的,测试了下,速度确实比先reverse再foreach慢很多,综合了一下几个楼层的代码,得到代码如下,经测试,结果是正确的,速度还行吧,反正我要把我以前的换成下边这个了
  1. (defun divlst(lst n / l l2)
  2.   (if(< 0 n(length lst))
  3.     (progn
  4.       (repeat(rem(length(setq lst(reverse lst)))n)
  5.         (setq l(cons(car lst)l)lst(cdr lst)))
  6.       (and l(setq l2(cons l l2)l nil))
  7.       (foreach x lst
  8.         (if(=(length(setq l(cons x l)))n)
  9.           (setq l2(cons l l2)l nil)))
  10.       l2)
  11.     (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))


 楼主| 发表于 2022-10-8 08:24 | 显示全部楼层
本帖最后由 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
)

发表于 2022-9-30 21:31 | 显示全部楼层
本帖最后由 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))))
发表于 2022-9-30 21:35 | 显示全部楼层
不完善,不足分组的会舍弃,应该这样

  • ;;表分组----(一级)----              
  • ;(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:51 | 显示全部楼层
尘缘一生 发表于 2022-9-30 21:35
不完善,不足分组的会舍弃,应该这样

3#楼返回值应该((1) (2 3 4) (5 6 7) (8 9 10) (11 12 13))是这样子。
 楼主| 发表于 2022-9-30 22:42 | 显示全部楼层
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 22:43 | 显示全部楼层
尘缘一生 发表于 2022-9-30 21:35
不完善,不足分组的会舍弃,应该这样

感谢你优化!
发表于 2022-10-1 12:04 | 显示全部楼层
;; 我分享一个递归法(包含两个函数)
;; ------------------------------------------------------------
;; [功能] 按照指定长度拆分表
;; (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)
)
 楼主| 发表于 2022-10-1 12:17 | 显示全部楼层
caoyin 发表于 2022-10-1 12:04
;; 我分享一个递归法(包含两个函数)
;; ------------------------------------------------------------ ...

感谢版主共享,节日快乐!
发表于 2022-10-1 12:34 | 显示全部楼层
guosheyang 发表于 2022-10-1 12:17
感谢版主共享,节日快乐!

节日快乐
发表于 2022-10-7 16:13 | 显示全部楼层
tigcat 发表于 2022-9-30 21:31
这个函数有个缺点,(setq lst'(1 2 3 4 5 6 7 8 9 10 11)),执行完后会丢失1 2。
我在网上找到另一个函数
; ...

恩,不错,这个才是正确的。顶楼函数有问题,不要下。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 15:14 , Processed in 0.335357 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表