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

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

list designator n。对象列表的指示符;那是，一个表示列表的对象，它是以下之一：非零原子（表示单元素列表，其元素是非零原子）或a 正确的清单（表示自己）。

根据这种理解，我们可以看到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))

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

3 个答案: