Concatenating adjacent strings in a list [Lisp]

Prev: Evaluating/compiling forms in the current lexical environment.
Next: When are clojures more advantageous than CLOS?

From: Adam White on 29 Jan 2010 09:56

Given a mixed list of strings and other items, I'd like to concatenate
all strings (and only strings) adjacent to each other.

So for '("1" "2" 3 4 "5" "6" 7 8 "9"), we should return

("12" 3 4 "56" 7 8 "9")

My first solution which works, but is as ugly as sin is:

(loop
with curr = ""
with save = '()
for p in '("1" "2" 3 4 "5" "6" 7 8 "9") do
(cond
((stringp p) (setf curr (concatenate 'string curr p)))
((equal curr "") (push p save))
(t (push curr save) (push p save) (setf curr "")))
finally (return (nreverse (cons curr save))))

Surely there has got to be a better way to do this!

Any pointers?

From: Zach Beane on 29 Jan 2010 10:03

From: Pillsy on 29 Jan 2010 10:38

[...]
> > Surely there has got to be a better way to do this!

> FSVO "better":

> (defun merge-strings (list)
> (let ((result '())
> (buffer (make-string-output-stream)))
> (labels ((out (object)
> (cond ((stringp object)
> (write-string object buffer)
> #'string-run)
> (t
> (push object result)
> #'out)))
> (string-run (object)
> (cond ((stringp object)
> (write-string object buffer)
> #'string-run)
> (t
> (push (get-output-stream-string buffer) result)
> (push object result)
> #'out))))
> (let ((state #'out))
> (dolist (object list (nreverse result))
> (setf state (funcall state object)))))))

This will omit a trailing run of strings (like in the test case). You
have to explicitly check STATE before NREVERSEing in order to account
for that. You can't just check the string-stream because you'll drop a
trailing "".

(defun merge-strings (list)
(let ((result '())
(buffer (make-string-output-stream)))
(labels ((out (object)
(typecase object
((string)
(write-string object buffer)
#'string-run)
(t
(push object result)
#'out)))
(string-run (object)
(typecase object
((string)
(write-string object buffer)
#'string-run)
(t
(push (get-output-stream-string buffer) result)
(push object result)
#'out))))
(let ((state #'out))
(dolist (object list)
(setf state (funcall state object)))
(when (eq state #'string-run)
(push (get-output-stream-string buffer) result))
(nreverse result)))))

Cheers,
Pillsy

From: Ariel Badichi on 29 Jan 2010 10:50

Adam White <spudboy(a)iinet.net.au> writes:

> Given a mixed list of strings and other items, I'd like to concatenate
> all strings (and only strings) adjacent to each other.
>
> So for '("1" "2" 3 4 "5" "6" 7 8 "9"), we should return
>
> ("12" 3 4 "56" 7 8 "9")
>
> My first solution which works, but is as ugly as sin is:
>
> (loop
> with curr = ""
> with save = '()
> for p in '("1" "2" 3 4 "5" "6" 7 8 "9") do
> (cond
> ((stringp p) (setf curr (concatenate 'string curr p)))
> ((equal curr "") (push p save))
> (t (push curr save) (push p save) (setf curr "")))
> finally (return (nreverse (cons curr save))))
>

This has weird semantics for a list like (1 "" 2), which results in a
list (1 2). Is that what you really want? I assume that you don't
want this in my version.

>
> Surely there has got to be a better way to do this!
>
> Any pointers?

How about:

(defun concatenate-adjacent-strings (list)
(cond ((or (endp list) (endp (rest list))) list)
((and (stringp (first list)) (stringp (second list)))
(do ((stream (make-string-output-stream))
(cons list (cdr cons)))
((or (null cons) (not (stringp (car cons))))
(cons (get-output-stream-string stream)
(concatenate-adjacent-strings cons)))
(write-string (car cons) stream)))
(t (cons (first list) (concatenate-adjacent-strings (rest list))))))

This is a recursive solution, so may not be appropriate for large
lists. I suppose a skipping maplist-like function could also be used:

(defun skipping-maplist (function list)
(do ((result '())
(cons list))
((null cons) (nreverse result))
(multiple-value-bind (subresult n)
(funcall function cons)
(push subresult result)
(setf cons (nthcdr (or n 1) cons)))))

(defun concatenate-adjacent-strings (list)
(skipping-maplist
(lambda (cons)
(if (and (stringp (car cons)) (cdr cons) (stringp (cadr cons)))
(do ((stream (make-string-output-stream))
(n 1 (1+ n))
(cons cons (cdr cons)))
((or (null cons) (not (stringp (car cons))))
(values (get-output-stream-string stream) n))
(write-string (car cons) stream))
(car cons)))
list))

But maybe it's not such a good abstraction.

Ariel

From: Ole Arndt on 29 Jan 2010 11:08

| Next | Last
Pages: 1 2 3 4 5 6 7
Prev: Evaluating/compiling forms in the current lexical environment.
Next: When are clojures more advantageous than CLOS?