Common lisp 如何对给定系列的任何连续数字或项目进行分组

我试图对给定系列的任何连续数字或项目进行分组

所有连续的数字1都作为子列表返回

(defun length1-to-atom (l)
  (loop for x in l collect (if (= (length x) 1) (car x) x)))

(defun group-series (n list)
  (length1-to-atom
   (reduce (lambda (item result)
             (cond
              ((endp result) (list (list item)))
              ((and (eql (first (first result)) item) (= n item))
               (cons (cons item (first result))
                     (rest result)))
              (t (cons (list item) result))))
           list
           :from-end t
           :initial-value '())))

(group-series 1 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
;=> ((1 1) 2 3 (1 1 1) 2 1 5 6 (1 1))

(group-series 2 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
;=> (1 1 2 3 1 1 1 (2 2) 1 5 6 1 1)

无法找到以下示例的任何解决方案

(group-series '(1 2) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
;=> ((1 (1 2) 3 1 1 (1 2) 1 5 6 1 1))

或

非常感谢您的帮助。

第一种情况（查找单个项目的重复）可以通过以下功能解决：

(defun group-series-1 (x list)
  (let (prev
        rez)
    (dolist (elt list)
      (setf rez (if (and (equal elt x)
                         (equal elt prev))
                    ;; found consecutive number
                    (cons (cons elt (mklist (car rez)))
                          (cdr rez)))
                    (cons elt
                          (if (and rez (listp (car rez)))
                              ;; finished a series
                              (cons (reverse (car rez))
                                    (cdr rez))
                              ;; there was no series
                              rez)))
            prev elt))
    (reverse rez)))

其中：

(defun mklist (x)
  (if (consp x) x (list x)))

---

第二个问题可以用类似的方法解决，但代码会增加一倍。

我同意这一评论，该组系列似乎在做两件独立的事情，这取决于输入是列表还是项目

如果输入是一个列表（第二种情况），这似乎符合规范：

(defun group-series (sublst lst)
  (funcall (alambda (lst res)
                    (if (null lst)
                      res
                      (if (equal (subseq lst 0 (min (length lst) (length sublst)))
                                 sublst)
                        (self (nthcdr (length sublst) lst) 
                              (nconc res (list sublst)))
                        (self (cdr lst)
                              (nconc res (list (car lst)))))))
           lst '()))

---

这利用了Paul Graham的alambda宏(http://lib.store.yahoo.net/lib/paulgraham/onlisp.pdf). 还要注意的是，由于匿名函数是一个闭包（即，它已在sublst上关闭），因此它可以引用sublst，而无需将其作为额外的输入变量传递。

许多评论说，这看起来像是函数在做两件不同的事情，但实际上有一种方法可以统一它所做的事情。诀窍是将第一个参数视为列表指示符：

n。对象列表的指示符；就是， 一个表示一个列表的对象，它是一个非零原子 （表示元素为非零原子的单态列表）或 适当的列表（表示其本身）

有了这样的理解，我们可以将

组系列

视为使用列表子列表的指示符，并返回一个类似于列表的列表，只是子列表的所有连续出现都已收集到一个新的子列表中。例如：

(group-series 1 '(1 2 1 1 2) ==
(group-series '(1) '(1 2 1 1 2)
;=> ((1) 2 (1 1) 2)

(group-series '(1 2) '(1 2 3 4 1 2 1 2 3 4))
;=> ((1 2) 3 4 (1 2 1 2) 3 4)

有了这样的理解，这两种情况就成为一种情况，我们只需要在开始时将第一个参数转换为指定的列表一次。这样就很容易实现

组系列

，如下所示：

(defun group-series (sublist list)
  (do* ((sublist (if (listp sublist) sublist (list sublist)))
        (len (length sublist))
        (position (search sublist list))
        (result '()))
       ((null position)
        (nreconc result list))
    ;; consume any initial non-sublist prefix from list, and update
    ;; position to 0, since list then begins with the sublist.
    (dotimes (i position)
      (push (pop list) result))
    (setf position 0)
    ;; consume sublists from list into group until the list does not
    ;; begin with sublist.  add the group to the result.  Position is
    ;; left pointing at the next occurrence of sublist.
    (do ((group '()))
        ((not (eql 0 position))
         (push (nreverse group) result))
      (dotimes (i len)
        (push (pop list) group))
      (setf position (search sublist list)))))

---

那么问题在哪里呢？问题是如何解决这个问题。

Group-series

似乎做了两件不同的事情，这取决于第一次输入的类型。我不确定把它放在同一个名字下是否明智。没错，它可以是一个单独的函数。我有一个解决方案，但它不是很漂亮。在我看来，这个问题有点不明确，但取决于它的解释方式，实际上可以用相同的代码解决这两种情况，和这个解决方案的代码行数差不多。我补充说，虽然OP似乎从2011年就不存在了，所以我不认为任何人会很快被接受。

(defun group-series (sublist list)
  (do* ((sublist (if (listp sublist) sublist (list sublist)))
        (len (length sublist))
        (position (search sublist list))
        (result '()))
       ((null position)
        (nreconc result list))
    ;; consume any initial non-sublist prefix from list, and update
    ;; position to 0, since list then begins with the sublist.
    (dotimes (i position)
      (push (pop list) result))
    (setf position 0)
    ;; consume sublists from list into group until the list does not
    ;; begin with sublist.  add the group to the result.  Position is
    ;; left pointing at the next occurrence of sublist.
    (do ((group '()))
        ((not (eql 0 position))
         (push (nreverse group) result))
      (dotimes (i len)
        (push (pop list) group))
      (setf position (search sublist list)))))

CL-USER> (group-series 1 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
((1 1) 2 3 (1 1 1) 2 2 (1) 5 6 (1 1))
CL-USER> (group-series 2 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
(1 1 (2) 3 1 1 1 (2 2) 1 5 6 1 1)
CL-USER> (group-series '(1 2) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
(1 (1 2) 3 1 1 (1 2) 1 5 6 1 1)
CL-USER> (group-series '(1 2 1) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
(1 1 2 3 1 1 (1 2 1) 5 6 1 1)
CL-USER> (group-series '(a b) '(c a b a b c d e f a b))
(C (A B A B) C D E F (A B))