pack.lisp

;;; L-99: Ninety-Nine Lisp Problems

;; Problem 9: Pack consecutive duplicates of list elements into sublists.

; If a list contains repeated elements they should be placed in separate sublists.
;
; Example:
;
; * (pack '(a a a a b c c a a d e e e e))
; ((A A A A) (B) (C C) (A A) (D) (E E E E))

; Georg Berky, Rainer Joswig, 2016



; tail recursive version with COND

(defun pack (aList &optional accumulator &aux (elementToAdd (first aList)))
  (cond ((null aList)
         (reverse accumulator))
        ((null accumulator)
         (pack (rest aList) (list (list elementToAdd))))
        ((eql elementToAdd (first (first accumulator)))
         (pack (rest aList) (cons (cons elementToAdd (first accumulator)) (rest accumulator))))
        (t
         (pack (rest aList) (cons (list elementToAdd) accumulator)))))


; not so good looking LOOP version

(defun pack (list)
  (loop with sublist = nil
        for (element . rest) on list
        if (or (null sublist)
               (eql element (first sublist)))
        do (push element sublist)
        else collect (nreverse sublist) and do (setf sublist (list element))
        if (null rest)
        collect (nreverse sublist)))


; elegant DOLIST solution

(defun pack (list &key (test #'eql) (key #'identity) &aux acc)
  (dolist (element list (nreverse acc))
    (if (or (null acc)
            (not (funcall test (funcall key element) (funcall key (caar acc)))))
        (push (list element) acc)
      (push element (first acc)))))
      
; slightly shorter

(defun pack (list &key (test #'eql) (key #'identity) &aux acc)
  (dolist (element list (nreverse acc))
    (if (and acc (funcall test (funcall key element) (funcall key (caar acc))))
        (push element (first acc))
      (push (list element) acc))))


; nested LOOPs, nice

(defun pack (list)
  (loop for a = (first list)
        while list
        collect (loop for b = (first list)
                      while (and list (eql a b))
                      collect (pop list))))


; using CLOS
        
(defun pack (list)
  (pack-rec list nil))

(defgeneric pack-rec (list accumulator)
  (:method ((list null) accumulator)
   (reverse accumulator))
  (:method (list (accumulator null) &aux (element (first list)))
   (pack-rec (rest list) (list (list element))))
  (:method (list accumulator &aux (element (first list)))
   (if (eql element (first (first accumulator)))
       (pack-rec (rest list)
                 (cons (cons element (first accumulator))
                       (rest accumulator)))
     (pack-rec (rest list) (cons (list element) accumulator)))))