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

guosheyang

分享一个速度很快又简洁的列表分段函数，不是我写的 网上找的 ，原作者不详。有没有比这个还快的？有的话请放上来对比下，谢谢！
;;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

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

(defun divlst(lst n / l l2)<br />   (if(< 0 n(length lst))<br />     (progn<br />       (repeat(rem(length(setq lst(reverse lst)))n)<br />         (setq l(cons(car lst)l)lst(cdr lst)))<br />       (and l(setq l2(cons l l2)l nil))<br />       (foreach x lst<br />         (if(=(length(setq l(cons x l)))n)<br />           (setq l2(cons l l2)l nil)))<br />       l2)<br />     (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

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

这个函数有个缺点,(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
• )
  

tigcat

尘缘一生 发表于 2022-9-30 21:35
不完善，不足分组的会舍弃，应该这样

3#楼返回值应该((1) (2 3 4) (5 6 7) (8 9 10) (11 12 13))是这样子。

guosheyang

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

guosheyang

尘缘一生 发表于 2022-9-30 21:35
不完善，不足分组的会舍弃，应该这样

感谢你优化！

caoyin

;; 我分享一个递归法（包含两个函数）
;; ------------------------------------------------------------
;; [功能] 按照指定长度拆分表
;; (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)
)

guosheyang

caoyin 发表于 2022-10-1 12:04
;; 我分享一个递归法（包含两个函数）
;; ------------------------------------------------------------ ...

感谢版主共享，节日快乐！

caoyin

guosheyang 发表于 2022-10-1 12:17
感谢版主共享，节日快乐！

节日快乐

cchessbd

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

恩，不错，这个才是正确的。顶楼函数有问题，不要下。