Break down a list SEQUENCE into consecutive lists of constant TASTE

Question

I am looking for ways to improve this little utility function:

(defun break-down (taste sequence)
  "Break down a list SEQUENCE into consecutive lists of constant TASTE.
The TASTE argument is a function which is applied on sequence elements to
taste them. Taste values are 

The answer is an alist whose terms have the form

   (TASTE1 . SEQUENCE1)

such that:

  1. The concatenation of the SEQUENCE1s yields SEQUENCE.
  2. Each element of the list SEQUENCE1 has the given TASTE1.
  3. Consecutive terms of the answer have distinct TASTE1.
"
…)

Examples:

CL-USER> (break-down #'stringp '(1 2 3 "a" "b" 5 "c" "d"))
((NIL 1 2 3) (T "a" "b") (NIL 5) (T "c" "d"))

CL-USER> (break-down
      (lambda (n)
          (cond ((< 0 n) :positive)
                ((> 0 n) :negative)
                (t :zero)))
      '(-1 3 34 -5 -6 0 1 2 0 34 -3 -6))
((:NEGATIVE -1) (:POSITIVE 3 34) (:NEGATIVE -5 -6) (:ZERO 0) (:POSITIVE 1 2)
 (:ZERO 0) (:POSITIVE 34) (:NEGATIVE -3 -6))

(defun break-down (taste sequence)
  "Break down a list SEQUENCE into consecutive lists of constant TASTE.
The TASTE argument is a function which is applied on sequence elements to
taste them. Taste values are 

The answer is an alist whose terms have the form

   (TASTE1 . SEQUENCE1)

such that:

  1. The concatenation of the SEQUENCE1s yields SEQUENCE.
  2. Each element of the list SEQUENCE1 has the given TASTE1.
  3. Consecutive terms of the answer have distinct TASTE1.
"
  (flet ((catamorphism (state next)
       (destructuring-bind (current-taste current-subsequence accumulator) state
         (let ((next-taste
             (funcall taste next)))
           (cond
         ((eq nil current-subsequence)
          (list next-taste (list next) accumulator))
         ((eq next-taste current-taste)
          (list current-taste (cons next current-subsequence) accumulator))
         (t
          (list next-taste
            (list next)
            (cons (cons current-taste (nreverse current-subsequence)) accumulator))))))))
    (destructuring-bind (current-taste current-subsequence accumulator)
    (reduce #'catamorphism sequence :initial-value (list nil nil nil))
      (nreverse (cons (cons current-taste (nreverse current-subsequence)) accumulator)))))

I am especially interested in:

1. Is there a good alternative to destructuring-bind in the catamorphism?
2. Is is more idiosyncratic to use loop instead of reduce ?
3. Better identifiers and documentation :-)
4. Is it possible to process arbitrary sequences?

Answer 1

1. I can't find a better alternative.
2. I think “yes” in this case. I prefer to use reduce with functions that are binary operators on the sequence elements, but maybe this is a just a personal preference.
3. I think you have done a good work on documentation and choice of identifiers.
4. It is not clear to me what are “arbitrary sequences”. Do you mean list with element other lists (i.e. trees)? Or arrays and lists? I think in that case you should give a precise definition of what do you mean by arbitrary sequence and what should be the result.

A couple of minor points:

1. I think that in case of empty list the result should be an empty list (since no sublist of the original list can be produced). This is not true for the current version.

2. Taste can return any value, so I think the function could take an argument which is the equality function to use for test the equality of such values (defaulting to eql as usual in the language).

As an example of use of loop instead of reduce, here is a possible solution that takes into account the two previous points.

(defun break-down (taste sequence &optional (test #'eql))
  "... the above comment ..."
  (if (null sequence)
      nil
      (let ((subsequences nil)
            (current-taste (funcall taste (first sequence)))
            (current-list (list (first sequence))))
        (loop for element in (rest sequence)
              for new-taste = (funcall taste element)
              if (funcall test new-taste current-taste)
                do (push element current-list)
              else
                do (push (cons current-taste (nreverse current-list)) subsequences)
                   (setf current-list (list element)
                         current-taste new-taste)
              end)
        (nreverse (cons (cons current-taste (nreverse current-list)) subsequences)))))

Edited

Finally, a possible simple solution for generic sequences.

(defun break-down (taste sequence &optional (test #'eql))
  "Break down a SEQUENCE into a list of sequences of constant TASTE.
 The TASTE argument is a function which is applied on sequence elements to
 taste them. Taste values are checked for equality with the test argument.

The answer is a couple of lists:

TASTE1
SEQUENCE1

such that:

1. The concatenation of the SEQUENCE1s yields SEQUENCE.
2. Each element of the list SEQUENCE1 has the corresponding taste in TASTE1.
3. Consecutive terms of the two lists of the answer have distinct TASTE1.
"
(if (= 0 (length sequence))
    nil
    (let* ((current-taste (funcall taste (elt sequence 0)))
           (indexes nil)
           (tastes nil))
      (loop for scan from 1 below (length sequence)
            for new-taste = (funcall taste (elt sequence scan))
            for index from 1
            unless (funcall test new-taste current-taste)
            do (push index indexes)
               (push current-taste tastes)
               (setf current-taste new-taste)
            end
            finally (push index indexes)
                    (push current-taste tastes))
       (values
         (nreverse tastes)
         (loop for start = 0 then end
               for end in (nreverse indexes)
               collect (subseq sequence start end))))))

Example:

(break-down
  (lambda (n)
    (cond ((< 0 n) :positive)
          ((> 0 n) :negative)
          (t :zero)))
  #(-1 3 34 -5 -6 0 1 2 0 34 -3 -6))
(:NEGATIVE :POSITIVE :NEGATIVE :ZERO :POSITIVE :ZERO :POSITIVE :NEGATIVE)
(#(-1) #(3 34) #(-5 -6) #(0) #(1 2) #(0) #(34) #(-3))