John Thingstad wrote:

> > CL-USER> (pack '(a a a a b c c a a d e e e e))
> > (NIL (A A A A) (B) (C C) (A A) (D) (E E E E))
> >
> > and cons of the list seemed to have unnecessary NIL.
> >
> > I'm not sure if it is a bug on clisp.
> > Please give me some advice.
> >
> > Sorry about my strange English. (I'm not a native speaker)
>
> I have a devil of a time understanding your code.
> After translating it I came up with:
>
> (defun pack (list)
> (labels ((build (source sub-list result)
> (let ((current (first source))
> (previous (first sub-list)))
> (cond ((null source)
> (nreverse (cons sub-list result)))
> ((eql current previous)
> (build (rest source) (cons current sub-list) result))
> (t
> (build (rest source) (cons current nil)
> (if (consp sub-list) (cons sub-list result)
> result))))))) ; this is different
> (build list nil nil)))
>
> The problem came from cons'ing ls1 to ls2 the first time the function is
> called when ls1 is nil.
> The code here corrects the problem.
> This way of solving the problem using tail recursion and accumulators is
> very Scheem'ish.
> Here is a more Lisp'ish solution.
>
> (defun pack (list)
> (let (result-list sub-list)
> (do ((current list (rest current))
> (previous nil current))
> ((null current)
> (push sub-list result-list)
> (nreverse result-list))
> (when (and (not (eql (first current) (first previous))) (consp
> sub-list))
> (push sub-list result-list)
> (setf sub-list nil))
> (push (first current) sub-list))))

Gauche Scheme:

(define (place x a b)
(let ((ok (or (null? a) (equal? x (car a)))))
(list (cons x (if ok a '()))
(if ok b (cons a b)))))

(define (clump the-list)
(apply cons
(fold-right
(cut apply place <> <>)
'(() ())
the-list)))

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

On 2/17/2022, Robert L. wrote:

> John Thingstad wrote:
>
> > > CL-USER> (pack '(a a a a b c c a a d e e e e))
> > > (NIL (A A A A) (B) (C C) (A A) (D) (E E E E))
> > >
> > > and cons of the list seemed to have unnecessary NIL.
> > >
> > > I'm not sure if it is a bug on clisp.
> > > Please give me some advice.
> > >
> > > Sorry about my strange English. (I'm not a native speaker)
> >
> > I have a devil of a time understanding your code.
> > After translating it I came up with:
> >
> > (defun pack (list)
> > (labels ((build (source sub-list result)
> > (let ((current (first source))
> > (previous (first sub-list)))
> > (cond ((null source)
> > (nreverse (cons sub-list result)))
> > ((eql current previous)
> > (build (rest source) (cons current sub-list) result))
> > (t
> > (build (rest source) (cons current nil)
> > (if (consp sub-list) (cons sub-list result)
> > result))))))) ; this is different
> > (build list nil nil)))
> >
> > The problem came from cons'ing ls1 to ls2 the first time the function is
> > called when ls1 is nil.
> > The code here corrects the problem.
> > This way of solving the problem using tail recursion and accumulators is
> > very Scheem'ish.
> > Here is a more Lisp'ish solution.
> >
> > (defun pack (list)
> > (let (result-list sub-list)
> > (do ((current list (rest current))
> > (previous nil current))
> > ((null current)
> > (push sub-list result-list)
> > (nreverse result-list))
> > (when (and (not (eql (first current) (first previous))) (consp
> > sub-list))
> > (push sub-list result-list)
> > (setf sub-list nil))
> > (push (first current) sub-list))))
>
> Gauche Scheme:
>
> (define (place x a b)
> (let ((ok (or (null? a) (equal? x (car a)))))
> (list (cons x (if ok a '()))
> (if ok b (cons a b)))))
>
> (define (clump the-list)
> (apply cons
> (fold-right
> (cut apply place <> <>)
> '(() ())
> the-list)))
>
> (clump '(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))

Shorter:

(use srfi-1) ;; car+cdr

(define (place x acc)
(let-values (((a b) (car+cdr acc)))
(if (or (null? a) (equal? x (car a)))
(cons (cons x a) b)
(cons* (list x) a b))))

(define (clump the-list)
(fold-right
place
'(())
the-list))

On 2/17/2022, Robert L. wrote:

> John Thingstad wrote:
>
> > > CL-USER> (pack '(a a a a b c c a a d e e e e))
> > > (NIL (A A A A) (B) (C C) (A A) (D) (E E E E))
> > >
> > > and cons of the list seemed to have unnecessary NIL.
> > >
> > > I'm not sure if it is a bug on clisp.
> > > Please give me some advice.
> > >
> > > Sorry about my strange English. (I'm not a native speaker)
> >
> > I have a devil of a time understanding your code.
> > After translating it I came up with:
> >
> > (defun pack (list)
> > (labels ((build (source sub-list result)
> > (let ((current (first source))
> > (previous (first sub-list)))
> > (cond ((null source)
> > (nreverse (cons sub-list result)))
> > ((eql current previous)
> > (build (rest source) (cons current sub-list) result))
> > (t
> > (build (rest source) (cons current nil)
> > (if (consp sub-list) (cons sub-list result)
> > result))))))) ; this is different
> > (build list nil nil)))
> >
> > The problem came from cons'ing ls1 to ls2 the first time the function is
> > called when ls1 is nil.
> > The code here corrects the problem.
> > This way of solving the problem using tail recursion and accumulators is
> > very Scheem'ish.
> > Here is a more Lisp'ish solution.
> >
> > (defun pack (list)
> > (let (result-list sub-list)
> > (do ((current list (rest current))
> > (previous nil current))
> > ((null current)
> > (push sub-list result-list)
> > (nreverse result-list))
> > (when (and (not (eql (first current) (first previous))) (consp
> > sub-list))
> > (push sub-list result-list)
> > (setf sub-list nil))
> > (push (first current) sub-list))))
>
> Gauche Scheme:
>
> (define (place x a b)
> (let ((ok (or (null? a) (equal? x (car a)))))
> (list (cons x (if ok a '()))
> (if ok b (cons a b)))))
>
> (define (clump the-list)
> (apply cons
> (fold-right
> (cut apply place <> <>)
> '(() ())
> the-list)))
>
> (clump '(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))

(use srfi-1) ;; car+cdr for Gauche Scheme
or
(require srfi/1) ;; car+cdr for Racket

(define (clump them r)
(if (null? them)
r
(let ((x (car them)))
(let-values
(((a b)
(if (and (pair? r) (equal? x (caar r)))
(car+cdr r)
(values '() r))))
(clump (cdr them) (cons (cons x a) b))))))

(clump '(a a b c c) '())
===>
((c c) (b) (a a))