用于对整数排序列表进行分组的惯用法？

Question

我有一个整数排序列表(1 2 4 5 6 6 7 8 10 10 10)。我想将它们全部分组，以便得到((1) (2) (4) (5) (6 6) (7) (8) (10 10 10))。

到目前为止，我有这个，有效：

(let ((current-group (list)) (groups (list)))
  (dolist (n *sorted*)
    (when (and (not (null current-group)) (not (eql (first current-group) n)))
      (push current-group groups)
      (setf current-group (list)))
    (push n current-group))
  (push current-group groups)
  (nreverse groups))

但我确信必须有更多的LISPy方法来做到这一点。有什么想法吗？

Answer 1

没那么糟糕。我会这样写：

(defun group (list)
  (flet ((take-same (item)
           (loop while (and list (eql (first list) item))
                 collect (pop list))))
    (loop while list
          collect (take-same (first list)))))


CL-USER 1 > (group '(1 2 4 5 6 6 7 8 10 10 10))
((1) (2) (4) (5) (6 6) (7) (8) (10 10 10))

Answer 2

已经有了accepted answer，但我认为值得研究另一种分解这个问题的方法，尽管这里的方法基本相同）。首先，让我们定义带有列表和谓词的cut，并返回列表的前缀和后缀，其中后缀以满足谓词的列表的第一个元素开头，前缀是之前的所有内容那不是：

(defun cut (list predicate)
  "Returns two values: the prefix of the list 
containing elements that do no satisfy predicate,
and the suffix beginning with an element that 
satisfies predicate."
  (do ((tail list (rest tail))
       (prefix '() (list* (first tail) prefix)))
      ((or (funcall predicate (first tail))
           (endp tail))
       (values (nreverse prefix) tail))))

(cut '(1 1 1 2 2 3 3 4 5) 'evenp)
;=> (1 1 1) (2 2 3 3 4 5)

(let ((l '(1 1 2 3 4 4 3)))
  (cut l (lambda (x) (not (eql x (first l))))))
;=> (1 1), (2 3 4 4 3)

然后，使用cut，我们可以向下移动一个输入列表，其中前缀和后缀带有一个谓词，该谓词检查元素是否不 eql到列表的第一个元素。也就是说，从（1 1 1 2 3 3）开始，你用谓词检查＆＃34;而不是eql到1＆＃34;，得到（1 1 1）和（2 3 3）。您将第一个添加到组列表中，第二个成为新尾部。

(defun group (list)
  (do ((group '())                           ; group's initial value doesn't get used
       (results '() (list* group results)))  ; empty, but add a group at each iteration
      ((endp list) (nreverse results))       ; return (reversed) results when list is gone
    (multiple-value-setq (group list)        ; update group and list with the prefix
      (cut list                              ; and suffix from cutting list on the 
           (lambda (x)                       ; predicate "not eql to (first list)".
             (not (eql x (first list))))))))

(group '(1 1 2 3 3 3))
;=> ((1 1) (2) (3 3 3))

实施cut

我试图让那个剪辑相对有效，只要它只通过列表。由于member会返回以找到的元素开头的列表的整个尾部，因此您实际上可以使用member和:test-not来获得所需的尾部：

(let ((list '(1 1 1 2 2 3)))
  (member (first list) list :test-not 'eql))
;=> (2 2 3)

然后，您可以使用ldiff返回该尾部之前的前缀：

(let* ((list '(1 1 1 2 2 3))
       (tail (member (first list) list :test-not 'eql)))
  (ldiff list tail))
;=> (1 1 1)

然后，组合这些方法并将尾部和前缀作为多个值返回是一件简单的事情。这给出了cut的版本，它只将列表作为参数，并且可能更容易理解（但效率稍差）。

(defun cut (list)
  (let ((tail (member (first list) list :test-not 'eql)))
    (values (ldiff list tail) tail)))

(cut '(1 1 2 2 2 3 3 3))
;=> (1 1), (2 2 2 3 3)

Answer 3

我喜欢使用reduce：

(defun group (lst)
  (nreverse
   (reduce (lambda (r e) (if (and (not (null r)) (eql e (caar r)))
                           (cons (cons e (car r)) (cdr r))
                           (cons (list e) r)))
           lst
           :initial-value nil)))

或使用push：

(defun group (lst)
  (nreverse
   (reduce (lambda (r e) 
             (cond 
              ((and (not (null r)) (eql e (caar r))) (push e (car r)) r)
              (t (push (list e) r))))
           lst
           :initial-value nil)))