How to group any consecutive numbers or items of a

问题:

I am trying to group any consecutive numbers or items of a given series.

all consecutive number 1 is return as a sublist.

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

can't find any solution for the examples below

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

or

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

Any help much appreciated.

回答1:

The first case (finding repetitions of a single item) can be solved with the following function:

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

where:

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

The second one can be solved with the similar approach, but there will be twice as much code.

回答2:

I agree with the comment, that group-series seems to be doing two separate things depending on if the input is a list or an item.

If the input is a list (the second case), this seems to meet the spec:

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

This makes use of Paul Graham's alambda macro (http://lib.store.yahoo.net/lib/paulgraham/onlisp.pdf). Also note that because the anonymous function is a closure (i.e., it has closed over sublst), it can reference sublst without having to pass it around as an additional input variable.

回答3:

A number of comments say that this looks like the function is doing two different things, but there's actually a way to unify what it's doing. The trick is to treat the first argument a list designator:

list designator n. a designator for a list of objects; that is, an object that denotes a list and that is one of: a non-nil atom (denoting a singleton list whose element is that non-nil atom) or a proper list (denoting itself).

With this understanding, we can see group-series as taking a designator for a sublist of list, and returning a list that's like list, except that all consecutive occurrences of the sublist have been collected into a new sublist. E.g.,

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

With that understanding, the two cases become one, and we just need to convert the first argument to the designated list once, at the beginning. Then it's easy to implement group-series like this:

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