Finally, a possible simple solution for arbitrarygeneric sequences.
Finally a possible simple solution for arbitrary sequences.
Finally, a possible simple solution for generic sequences.
Edited
Finally a possible simple solution for arbitrary 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))
Edited
Finally a possible simple solution for arbitrary 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))
- I can't find a better alternative.
- I think "yes" in this case. I prefer to use
reducewith functions that are binary operators on the sequence elements, but maybe this is a just a personal preference. - I think you have done a good work on documentation and choice of identifiers.
- 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:
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.
Tastecan 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 toeqlas 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)))))
lang-lisp