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

Question

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

所有连续数字 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))

或

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

非常感谢任何帮助。

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

第二种情况可以使用类似的方法来解决，但代码量会增加两倍。

Answer 2

我同意这个评论，组系列似乎在做两件不同的事情，具体取决于输入是列表还是项目。

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

(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，而无需将其作为附加输入变量传递。

Answer 3

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

列表指示符 n。对象列表的指示符；那是，
表示列表的对象，并且是以下之一： 非零原子
（表示一个单例列表，其元素是非零原子）或
正确的列表（表示其本身）。

有了这种理解，我们可以将group-series视为采用列表子列表的指示符，并返回一个类似于列表的列表，只不过该子列表的所有连续出现都已被收集到一个新的子列表中。例如，

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

有了这样的理解，两种情况就变成了一种，我们只需要在开始时将第一个参数转换为指定的列表一次。然后很容易实现group-series，如下所示：

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