通用Lisp身份组

Question

通用Lisp身份组

3

我是一个Lisp初学者，我写了一个函数来将列表中相邻的equal项分组。如果Lisp专家能够给我一些有关更好的Lispy编写此函数的建议，我将不胜感激。提前致谢！

(defun identity-groups (lst)
  (labels ((travel (tail group groups)
         (cond ((endp tail) (cons group groups))
           ((equal (car tail) (car (last group)))
            (travel (cdr tail) (cons (car tail) group) groups))
           (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (reverse (travel (cdr lst) (list (car lst)) nil))))

(identity-groups '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7))
;; => ((1) (3) (5) (4 4 4 4) (5) (1) (2 2 2) (1) (2) (3 3 3 3 3) (4) (5) (6) (7))

- user4813927

根据您的描述，我期望(identity-groups '(1 3 5 4 5 1 2 1 2 3 4 5 6 7))返回((7) (6) (2 2) (4 4) (5 5 5) (3 3) (1 1 1))（也许分组顺序不同），但是您的函数目前并没有返回这样的结果，而是一列单元素列表：((1) (3) (5) (4) (5) (1) (2) (1) (2) (3) (4) (5) (6) (7))。这是否符合预期？ - coredump

1

抱歉，它应该仅将相邻相等的项分组。已编辑问题。 - user4813927

3个回答

3

所需函数符合此模式：从已知子结果 G0 和新值构建值 G1，可以使用 REDUCE 实现。

匿名缩减函数的第一个参数是累加器，这里是一组列表。第二个参数是新值。

(reduce (lambda (groups value)
           (let ((most-recent-group (first groups)))
              (if (equal (first most-recent-group) value)
                  (list* (cons value most-recent-group) (rest groups))
                  (list* (list value) groups))))
        '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7)
        :initial-value ())

结果是：

((7) (6) (5) (4) (3 3 3 3 3) (2) (1) (2 2 2) (1) (5) (4 4 4 4) (5) (3) (1))

你的代码中存在一个问题，就是调用last来访问最后一组，这会导致代码不断遍历列表。通常情况下，应该避免将列表视为数组，而应该将它们视为堆栈（只操作顶部元素）。

如果需要反转元素，则可以在每个组的末尾（等价值之间的顺序）或整个函数的末尾（组之间的顺序）进行操作。

- coredump

1

一种“经典”的递归解决方案。

(defun identity-groups (l &key (test #'eql))
  (labels ((group (l last-group acc)
              (cond ((null l) (cons last-group acc))
                    ((and last-group (funcall test (car l) (car last-group)))
                     (group (cdr l) (cons (car l) last-group) acc))
                    (t
                     (group (cdr l) (list (car l)) (cons last-group acc))))))
    (cdr (reverse (group l '() '())))))

旧版本（需要一个不等于第一个列表元素的初始值）

因此，上面的版本摆脱了这个关键参数。

(defun identity-groups (l &key (test #'eql) (initial-value '(0))) 
  (labels ((group (l last-group acc)
              (cond ((null l) (cons last-group acc))
                    ((funcall test (car l) (car last-group))
                     (group (cdr l) (cons (car l) last-group) acc))
                    (t
                     (group (cdr l) (list (car l)) (cons last-group acc))))))
    (cdr (reverse (group l initial-value '())))))

命令式循环结构

为了好玩，也尝试使用 do 来创建循环结构。

(defun group-identicals (l &key (test #'eql))
  (let ((lx) (tmp) (res))                       ;; initiate variables
    (dolist (x l (reverse (cons tmp res)))      ;; var list return/result-value
      (cond ((or (null lx) (funcall test x lx)) ;; if first round or 
             (push x tmp)            ;; if last x (lx) equal to current `x`,
             (setf lx x))          ;; collect it in tmp and set lx to x
            (t (push tmp res)      ;; if x not equal to lastx, push tmp to result
               (setf tmp (list x)) ;; and begin new tmp list with x
               (setf lx x))))))    ;; and set last x value to current x
    (cdr (reverse (group l initial-value '()))))) 
    ;; cdr removes initial last-group value

;; test:
(group-identicals '(1 2 3 3 4 4 4 4 5 5 6 3 3 3 3))
;; ((1) (2) (3 3) (4 4 4 4) (5 5) (6) (3 3 3 3))
(group-identicals '("a" "b" "b" "c" "d" "d" "d" "e") :test #'string=)
;; (("a") ("b" "b") ("c") ("d" "d" "d") ("e"))

- Gwang-Jin Kim

(identity-groups '(0 0 0 0)) => NIL。所以这样做应该总是设置一个:initial-value来获得正确的组，对吗？ - user4813927

@atymuri，:initial-value必须与第一个元素不同，例如(identity-groups '(0 0 0 0 0) :initial-value '(1)) -> ((0 0 0 0 0))但是(identity-groups '(0 0 0 0 0) :initial-value '(0)) -> NIL。 - Gwang-Jin Kim

@ateymuri：现在第一个解决方案已经去掉了 :initial-value。 - Gwang-Jin Kim

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- zut · Accepted Answer

看起来很不错！

(equal (car tail) (car (last group))) 看起来等同于 (equal (car tail) (car group))
为了保持原始顺序，反转每个组的项目。
由于您自己构建了结果列表groups，因此使用nreverse而不是reverse是安全且更有效的。
当使用list作为参数而不是lst时，没有名称冲突，因为变量和函数存在不同的命名空间（“Lisp-2”）。
通常认为给像这样的实用程序函数添加&key test key参数是一种良好的风格，以便调用者可以决定何时将列表元素视为相等（请参见例如Common lisp :KEY parameter use），以加入像member、find和sort等通用函数的俱乐部。
还有一个文档字符串！ :)

更新版本：

(defun identity-groups (list &key (test #'eql) (key #'identity))
  "Collect adjacent items in LIST that are the same. Returns a list of lists."
  (labels ((travel (tail group groups)
             (cond ((endp tail) (mapcar #'nreverse (cons group groups)))
                   ((funcall test
                             (funcall key (car tail))
                             (funcall key (car group)))
                    (travel (cdr tail) (cons (car tail) group) groups))
                   (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (nreverse (travel (cdr list) (list (car list)) nil))))

测试:

(identity-groups '(1 2 2 2 3 3 3 4 3 2 2 1))
-> ((1) (2 2 2) (3 3 3) (4) (3) (2 2) (1))

;; Collect numbers in groups of even and odd:
(identity-groups '(1 3 4 6 8 9 11 13 14 15) :key #'oddp)
-> ((1 3) (4 6 8) (9 11 13) (14) (15))

;; Collect items that are EQ:
(identity-groups (list 1 1 2 2 (list "A") (list "A")) :test 'eq)
-> ((1 1) (2 2) (("A")) (("A")))