# cl-loop 如何实现按条件分组收集？

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

``````(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 个赞

``````(->> input
(-partition-by #'listp)
(--mapcat (if (listp (car it)) it (list it))))
``````

3 个赞

dash.el操作的是直接的列表而不是惰性的iterator导致这些东西一旦串太多就会反复遍历列表然后显得十分没效率

Clojure里面没有这个问题，dash我没有看过实现。

`byte-compile`+`benchmark-run` 表明 cireu 的方案比DogLooksGood快两倍.

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

``````<= '((1 2 3) 4 (5 6) 7 8 9 (10))
=> '(nil (1 2 3) (4) (5 6) (7 8 9) (10))``````
``````(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))
``````

`(0.06382499999999999 0 0.0) (0.063794 0 0.0)`

`(0.07922499999999999 0 0.0)`

`ncollect` 的定义改一下性能就能大幅提高了。

``````(defmacro ncollect (&rest body)
(let ((place (gensym)))
`(macrolet ((next (a) (list 'push a ',place)))
(let (,place)
,@body
(nreverse ,place)))))
``````

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 个赞

``````-   (dolist (item list (nreverse result))
+   (dolist (item list (progn (when probe
+                               (cl-callf nreverse (car result)))
+                             (nreverse result)))
``````

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

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

1 个赞