I am trying to process a sequence like:
(0 1 2 3 0 1 2 3 0 1 2 3)
and produce:
((0 1 2 3)(0 1 2 3)(0 1 2 3))
i.e. create sub-sequences beginning whenever the value decreases.
However, I am not having much luck (being pretty new to LISP). My
attempt was to use a loop with two collect statements, collecting each
number into one until its value decreases compared to the last one,
which then gets collected into another, then reset. Something like
this:
(loop
for num in seq
when (and (not (null subseq)) (<= num (car (last subseq)))
collect subseq into answer and
do (setf subseq nil)
collect num into subseq
finally (return answer))
But, subseq never seems to get reset, and it seems that there are
references at work as the return value contains multiple copies of the
original sequence.
Would someone kindly be able to offer some advice or a nudge in the
right direction?
Best,
Scott
(defun collect-sublists (list)
(flet ((collect-sublist ()
(loop for element = (pop list)
while element collect element
while (and list
(<= element (first list))))))
(loop for sublist = (collect-sublist)
while sublist collect sublist)))
> (defun collect-sublists (list)
> (flet ((collect-sublist ()
> (loop for element = (pop list)
> while element collect element
> while (and list
> (<= element (first list))))))
> (loop for sublist = (collect-sublist)
> while sublist collect sublist)))
Nearly 15 minutes passed since you posted your solution, and William
James still didn’t show his Ruby one-liner that outperforms the Lisp
solution by a factor of 20 (speedwise). ;-)
André
--
Thanks for the quick response! This does exactly what I need, although
I will certainly have to look at it closely to see exactly how.
Best,
Scott
Here is a great function from "On Lisp"
(defun group (source n)
(if (zerop n) (error "zero length"))
(labels ((rec (source acc)
(let ((rest (nthcdr n source)))
(if (consp rest)
(rec rest (cons (subseq source 0 n) acc))
(nreverse (cons source acc))))))
(if source (rec source nil) nil)))
http://www.bookshelf.jp//texi/onlisp/onlisp_5.html
------------
I did it by copy paste, that's 0 lines of code :)
Is one of those functions I keep in my utilities.
Nonsense! Your request was:
> Would someone kindly be able to offer some advice or a nudge in the
> right direction?
You received an alternative solution that did not identify why your
solution was not working. No advice, no nudge.
As Lao Tzu might have said, "The subseq you can setf is not the true
subseq".
hth,kzo
i dunno if this one is faster (it might be because it uses
CL library functions, but theoretically it won't matter for "sufficiently
smart compiler"), but Rainer's one is at least order of magnitude easier
to read/understand, and algorithmically it is same O(N).
acl> (defun group (source n)
acl> (if (zerop n) (error "zero length"))
acl> (labels ((rec (source acc)
acl> (let ((rest (nthcdr n source)))
acl> (if (consp rest)
acl> (rec rest (cons (subseq source 0 n) acc))
acl> (nreverse (cons source acc))))))
acl> (if source (rec source nil) nil)))
That is true, although I was kind of hoping he might open the link and
keep reading after not understanding the function (Rainer's is in
there somewhere, I believe). :-P
Chubby Ruby,
My Dear Hubby,
I love you dear,
But can't you hear,
I'm talking lisp,
... takin' all the risk.
Oh, chubby rubby!
Badooby-booby!
> jos...@corporate-world.lisp.de schrieb:
>
> > (defun collect-sublists (list)
> > (flet ((collect-sublist ()
> > (loop for element = (pop list)
> > while element collect element
> > while (and list
> > (<= element (first list))))))
> > (loop for sublist = (collect-sublist)
> > while sublist collect sublist)))
"We don't need no stinkin' loops!"
Ruby:
list = [0,1,2,3] * 3
def collect_sublists list, prev=nil, accum=[[]]
return accum if not element = list.first
if prev and element < prev
accum << [element]
else
accum[-1] << element
end
collect_sublists( list[1..-1], element, accum )
end
p collect_sublists( list )
# This could be slower if getting the last element in a list
# is expensive.
def collect_sublists_2 list, accum=[[]]
return accum if not element = list.first
if accum != [[]] and accum[-1][-1] > element
accum << [element]
else
accum[-1] << element
end
collect_sublists_2( list[1..-1], accum )
end
>
> Nearly 15 minutes passed since you posted your solution, and William
> James still didn’t show his Ruby one-liner that outperforms the Lisp
> solution by a factor of 20 (speedwise). ;-)
>
>
> André
Ruby is about the slowest "scripting language".
JavaScript is faster.
SpiderMonkey and jslibs:
LoadModule('jsstd')
list = [0,1,2,3,0,1,2,3,1,2,3]
function collect_groups( list, prev, accum )
{ accum = accum || [[]]
var element = list[0]
if ( typeof element == "undefined" )
return accum
if (prev && element < prev)
accum.push( [element] )
else
accum.slice(-1)[0].push( element )
return collect_groups( list.slice(1), element, accum )
}
Print( collect_groups(list).toSource(), '\n')
--- output ---
[[0, 1, 2, 3], [0, 1, 2, 3], [1, 2, 3]]
3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1,
2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0,
1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3,
0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3]
>> p collect_sublists( list )
SystemStackError: stack level too deep
from (irb):8:in `collect_sublists'
from (irb):8:in `collect_sublists'
from (irb):11
from :0
>>
Oops, you don't need loops?
You need Lisp.
) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3
4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3
4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4))
CL-USER 3 >
That's extremely prolix, convoluted, and hideous.
If that's the best that Paul Graham can do ...
Ruby:
def group source, n
acc = []
0.step(source.size - 1, n){|i|
acc << source[i,n] }
acc
end
p group( %w(a b c d e f g), 2)
--- output ---
[["a", "b"], ["c", "d"], ["e", "f"], ["g"]]
Correct. You are learning.
>
> You need Lisp.
>
> ) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3
> 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3
> 4) (1 2 3 4) (1 2 3 4) (1 2 3 4) (1 2 3 4))
>
> CL-USER 3 >
You need Ruby, one line of which does the work of 8 lines of
COBOL Lisp.
# inject is reduce.
list = [2,3,4,5] * 9999
clump=proc{|a| c=[[a[0]]]; a.inject{|p,x| x<p ? c<<[x] : c[-1]<<x;x};c}
p clump[ list ]
....
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5],
[2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5], [2, 3, 4, 5]]
> On Dec 8, 1:08 am, Scott <jsam...@gmail.com> wrote:
> > Hi All,
> >
> > I am trying to process a sequence like:
> >
> > (0 1 2 3 0 1 2 3 0 1 2 3)
> >
> > and produce:
> >
> > ((0 1 2 3)(0 1 2 3)(0 1 2 3))
> >
> > i.e. create sub-sequences beginning whenever the value decreases.
> >
> > However, I am not having much luck (being pretty new to LISP). My
> > attempt was to use a loop with two collect statements, collecting
> > each number into one until its value decreases compared to the last
> > one, which then gets collected into another, then reset. Something
> > like this:
> >
> > (loop
> > for num in seq
> > when (and (not (null subseq)) (<= num (car (last subseq)))
> > collect subseq into answer and
> > do (setf subseq nil)
> > collect num into subseq
> > finally (return answer))
...
>
> (defun collect-sublists (list)
> (flet ((collect-sublist ()
> (loop for element = (pop list)
> while element collect element
> while (and list
> (<= element (first list))))))
> (loop for sublist = (collect-sublist)
> while sublist collect sublist)))
JavaScript (SpiderMonkey):
function clump(a){
var c=[[a[0]]]
a.reduce(function(p,x){x<p ? c.push([x]) : c.slice(-1)[0].push(x)
return x})
return c }
(define-modify-macro b! (&rest args) nconc) (defun clump (l &aux r) (reduce (lambda (a b) (if (> b a) (b! (car (last r)) (list b)) (b! r (list (list b)))) b) l :initial-value (car l)) r)
Using Guile:
(define (group source n)
(if (null? source)
source
(let ((len (min n (length source))))
(cons (take source len) (group (drop source len) n)))))
Arc:
arc> (tuples (range 1 14) 3)
((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13 14))
(define produce
L -> (ph L []))
(define ph
[] L -> [(reverse L)]
[X] L -> (ph [] [X | L])
[X Y | Z] L -> [(reverse [X | L]) | (ph [Y | Z] [])] where
(> X Y)
[X Y | Z] L -> (ph [Y | Z] [X | L]))
the generated Lisp at max speed setting
(DEFUN produce (V31) (ph V31 NIL))
(DEFUN ph (V32 V33)
(BLOCK NIL
(IF (NULL V32) (RETURN (CONS (REVERSE V33) NIL))
(TAGBODY
(IF (CONSP V32)
(LET ((Car37 (CAR V32)) (Cdr38 (CDR V32)))
(IF (NULL Cdr38) (RETURN (ph NIL (CONS Car37 V33)))
(IF (CONSP Cdr38)
(RETURN
(IF (> Car37 (CAR Cdr38))
(CONS (REVERSE (CONS Car37 V33)) (ph Cdr38 NIL))
(ph Cdr38 (CONS Car37 V33))))
(GO tag34)))))
tag34 (RETURN (qi::f_error 'ph))))))
Mark
Cheers
--
Marco
I don't do it for WJ; it's for aesthetic reasons; functional
programming in Qi is a meditation.