我想实现如下效果，把所有连续的 value 元素都搜集到 list 中：
input: '((1 2 3) 4 (5 6) 7 8)
output: '((1 2 3) (4) (5 6) (7 8))
用 cl-loop 写了一个初步的方案：
#+BEGIN_SRC emacs-lisp :results value pp
(let (tmp)
(cl-loop for (elm rest) on '((1 2 3) 4 (5 6) 7 8) by #'cdr
if (listp elm)
collect elm
else
if (or (not rest) (listp rest))
collect (prog1 (reverse (push elm tmp)) (setq tmp nil))
else
do (push elm tmp)))
#+END_SRC
#+RESULTS:
: ((1 2 3)
: (4)
: (5 6)
: (7 8))
但是觉得变量 tmp 有点碍眼，有办法去掉吗？
cireu
2020 年3 月 14 日 08:58
2
(cl-loop for (elm rest) on '((1 2 3) 4 (5 6) 7 8) by #'cdr
if (listp elm)
collect elm
else
collect elm into tmp
and when (or (not rest) (listp rest))
collect tmp
and do (setq tmp nil))
不觉得可读性高多少
1 个赞
如果不限定cl-loop的话感觉还是很好写的，比如用dash
(->> input
(-partition-by #'listp)
(--mapcat (if (listp (car it)) it (list it))))
比较clojure的风格
3 个赞
cireu
2020 年3 月 14 日 14:39
4
dash.el操作的是直接的列表而不是惰性的iterator导致这些东西一旦串太多就会反复遍历列表然后显得十分没效率
Clojure里面没有这个问题，dash我没有看过实现。
不过，对于不部分处理的情况，惰性不惰性是没有区别的。
partition和mapcat两个从逻辑上看都只需要遍历一次。
byte-compile+benchmark-run 表明 cireu 的方案比DogLooksGood快两倍.
我还是情愿DogLooksGood 的方案
这不是弥补的特点. 您需要付出特别的努力搞成quadratic 或 n lg n.
可能比较优雅的做法的话，可以学 Clojure 里面的 transducer，解耦迭代和变换的逻辑。
应该会快一些，但要多写很多代码。dash 自己没有带这个。
写了个 reduce 版的:
(cl-reduce ;; (-reduce
(lambda (acc it) ;; (lambda (acc it)
(if (listp it)
(cons nil (append acc (list it)))
(if (eq nil (car acc))
(append (cdr acc) `((,it)))
(setf (cdr (last (car (last acc)))) `(,it))
acc)))
(cons nil '((1 2 3) 4 (5 6) 7 8)))
;; => ((1 2 3) (4) (5 6) (7 8))
效率好像不太行（-reduce 略优于 cl-reduce），而且这个写法有时（当输入列表的尾部为 list）输出结果的头部多一个 nil 需要剔除，例如：
<= '((1 2 3) 4 (5 6) 7 8 9 (10))
=> '(nil (1 2 3) (4) (5 6) (7 8 9) (10))
LdBeth
2020 年3 月 15 日 05:30
11
(cl-defun collaspe (list &aux cur)
(ncollect
(while (consp list) ;; cond
(setq cur (car list)
list (cdr list))
(if (listp cur)
(next cur)
(next (ncollect
(next cur)
(while (and (consp list)
(not (listp (car list))))
(setq cur (car list)
list (cdr list))
(next cur))))))))
(defmacro ncollect (&rest body)
(let ((ret (gensym 'ret))
(prev (gensym 'prev))
(cpos (gensym 'cpos)))
`(macrolet
((next (a) (list 'progn
(list 'setcar ',cpos a)
(list 'setcdr ',cpos '(cons nil nil))
(list 'setq ',prev ',cpos
',cpos (list 'cdr ',cpos)))))
(let* ((,ret (cons nil nil))
,prev
(,cpos ,ret))
,@body
(when ,prev
(setcdr ,prev nil)
,ret)))))
(collaspe '((1 2 3) 1 2 3 (3 4 5) (2) (5 5) 2 3))
((1 2 3) (1 2 3) (3 4 5) (2) (5 5) (2 3))
真要纯粹只考虑性能的话这里有个只遍历一次的版本。写了个用指针操作收集元素了的 ncollect 连 nreverse 的遍历都不用。
更新了下，实际测试下和这个差不多。
(0.06382499999999999 0 0.0) (0.063794 0 0.0)
比这一个稍好一点。
(0.07922499999999999 0 0.0)
说明用 emacs lisp 写的 function everhead 还是比用 C 写的大一点。主要是 emacs lisp 沒有 Common Lisp 的 prog，不然开销可以做得更小一点。在 Common Lisp 下用 ncollect 比 push + nreverse 快 10%。
把 ncollect 的定义改一下性能就能大幅提高了。
(defmacro ncollect (&rest body)
(let ((place (gensym)))
`(macrolet ((next (a) (list 'push a ',place)))
(let (,place)
,@body
(nreverse ,place)))))
还是要提一下在 Common Lisp 反而是前一种 ncollect 性能更好
1 个赞
用 cl-loop 写的代码一旦看起来比较怪，我就不想用它，因为看起来不像 Emacs Lisp 了，而且就这个例子，cl-loop 没有很大帮助。
(defun listify (list)
(let (result probe)
(dolist (item list (nreverse result))
(cond
((listp item)
(when probe
(setq probe nil)
(cl-callf nreverse (car result)))
(push item result))
(probe
(push item (car result)))
(t
(push (list item) result)
(setq probe t))))))
(listify '((1 2 3) 4 (5 6) 7 8))
;; => ((1 2 3) (4) (5 6) (8 7))
1 个赞
末尾的 list 忘了反转：
- (dolist (item list (nreverse result))
+ (dolist (item list (progn (when probe
+ (cl-callf nreverse (car result)))
+ (nreverse result)))
从没注意到 dolist 竟然可以这样返回，学习了。
这个实现在我电脑上表现比 @LdBeth 大佬那个还略好一些，我用 benchmark 各跑了几组 10w 次。
LdBeth
2020 年3 月 15 日 11:53
14
看来是 Emacs Lisp 的 byte code 不如 C function 强势，用 nreverse 在 C 內部遍历比 byte compile 不遍历的 setcar/setcdr overhead 要小很多。
把 10楼 的 reduce 版改成 while:
(defun my/collect (rest)
(let (it acc)
(while rest
(setq it (pop rest))
(if (listp it)
(setq acc (cons nil (append acc (list it))))
(if (not (car acc))
(setq acc (append (cdr acc) `((,it))))
(setf (cdr (last (car (last acc)))) `(,it)))))
(if (not (car acc))
(cdr acc)
acc)))
(my/collect '((1 2 3) 4 (5 6) 7 8))
;; => ((1 2 3) (4) (5 6) (7 8))
benchmakr 10w次 效率较 cl-reduce 版有较大提升，跟 -reduce 版相当：
;; my/collect (cl-reduce)
(4.994094 7 1.085835000000003)
;; my/collect (-reduce)
(0.940522 4 0.5306130000000095)
;; my/collect (while)
(0.9091450000000001 3 0.39869999999999806)
LdBeth
2020 年3 月 15 日 12:17
16
我把 ncollect 宏用 push + nreverse 重新定义了下
(benchmark-run 100000 (collaspe '((1 2 3) 1 2 3 (3 4 5) (2) (5 5) 2 3)))
(0.04428800000000001 0 0.0)
(0.044309 0 0.0)
(0.04406600000000001 0 0.0)
(0.358124 1 0.31633900000000015)
(benchmark-run 100000 (listify '((1 2 3) 1 2 3 (3 4 5) (2) (5 5) 2 3)))
(0.04665999999999999 0 0.0)
(0.048356 0 0.0)
(0.047854999999999995 0 0.0)
(0.345088 1 0.3005519999999997)
但是显然 append 比用 reference cell update 还是慢很多的。
1 个赞
