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: Michael Gardner on 29 Jan 2010 16:55

On Jan 29, 2010, at 3:15 PM, Kaz Kylheku wrote:

> On 2010-01-29, Adam White <spudboy(a)iinet.net.au> wrote:
>>=20
>> Given a mixed list of strings and other items, I'd like to =
concatenate=20
>> all strings (and only strings) adjacent to each other.
>>=20
>> So for '("1" "2" 3 4 "5" "6" 7 8 "9"), we should return
>>=20
>> ("12" 3 4 "56" 7 8 "9")
>>=20
>> My first solution which works, but is as ugly as sin is:
>>=20
>> (loop
>> with curr =3D ""
>> with save =3D '()
>> 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))))
>>=20
>>=20
>> Surely there has got to be a better way to do this!
>>=20
>> Any pointers?
>=20
> I dislike all of the solutions hitherto given. :)
>=20
> The following is fantasy syntax, based on imaginary extensions to Fare =
Rideau's
> pattern notation:
>=20
> ;; munch the input-list as follows: sequences of strings are catenated
> ;; into a single string object which is collected. All other items are
> ;; collected as-is.
>=20
> (lex-collect input-list (tok)
> ((list (1+ (of-type string))) (apply #'concatenate 'string tok))
> ((list item) item))
>=20
> Notes:
>=20
> - lex-collect returns an implicit list, which is constructed by
> collecting the return values of the rule bodies.
>=20
> - A rule can append multiple items to the list by returning multiple
> values. Returning (values) means that nothing is collected.
>=20
> - tok specifies the name of a variable which is always bound to the =
entire
> lexeme that is matched by a rule. This spares the user from writing =
patterns
> of the form (and variable-name (actual pattern match ...)) just to =
capture
> the whole thing into a variable.
>=20
> - Rules extract the longest possible match from the input object. If =
two or
> more rules apply to the object, the one which extracts the most wins. =
In case
> of a tie, the earlier rule wins.
>=20
> - The unmatched remainder of the input object becomes a new object, =
handled by
> the next iteration. If the input object is (1 2 3), then
> the rule (list item) binds item to 1, and leaves the remainder (2 3).
>=20
> - If the input object is nil, lex-collect evaluates any explicit
> rule which matches nil, and then terminates, returning the collected =
list.
> Thus if there is no explicit rule for nil, the behavior is as if =
there
> was a rule (nil (values))
>=20
> - If the input doesn't match any rule, and the input object is other =
than nil,
> an error is signaled.
>=20
> - A rule with an empty body signals the same kind of error, if it =
matches.
> Successful rules must evaluate at least one expression.

Why not use CL-Yacc instead? In this case you'd need only a very simple =
grammar, and a trivial lexer to grab successive items from the list.

-Michael=

From: Raffael Cavallaro on 29 Jan 2010 18:12

On 2010-01-29 16:20:08 -0500, Raymond Wiker said:

> "Frode V. Fjeld" <frode(a)netfonds.no> writes:
>
>> 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.
>>
>> (defun f (list)
>> (loop while list
>> collect (if (not (stringp (car list)))
>> (pop list)
>> (with-output-to-string (s)
>> (loop while list
>> while (stringp (car list))
>> do (write-string (pop list) s)))))))
>
> I came up with the following:
>
> (defun f(list)
> (loop for (item . next) on list
> with saved = nil
> when (stringp item)
> do (push item saved)
> when (and saved (or (null next) (not (stringp item))))
> collect (apply #'concatenate 'string (nreverse saved))
> when (not (stringp item))
> do (setq saved nil)
> and
> collect item))
>
> --- not sure if this is a good idea, but at least it shows off some
> other aspects of loop.

or combining yours and Frode's approaches:

(defun merge-strings (list)
(loop while list
if (stringp (car list)) collect
(apply #'concatenate 'string
(loop while (stringp (car list))
collect (pop list)))
else collect (pop list)))
--
Raffael Cavallaro

From: W. James on 29 Jan 2010 19:09

Raymond Wiker wrote:

> "Frode V. Fjeld" <frode(a)netfonds.no> writes:
>
> > 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.
> >
> > (defun f (list)
> > (loop while list
> > collect (if (not (stringp (car list)))
> > (pop list)
> > (with-output-to-string (s)
> > (loop while list
> > while (stringp (car list))
> > do (write-string (pop list) s)))))))
>
> I came up with the following:
>
> (defun f(list)
> (loop for (item . next) on list
> with saved = nil
> when (stringp item)
> do (push item saved)
> when (and saved (or (null next) (not (stringp item))))
> collect (apply #'concatenate 'string (nreverse saved))
> when (not (stringp item))
> do (setq saved nil)
> and
> collect item))
>
> --- not sure if this is a good idea, but at least it shows off some
> other aspects of loop.

Users of CL (COBOL-LISP) would be helpless without loop.

Scheme:

(define (fuse in out)
(if (null? in) (reverse out)
(let ((x (car in)))
(fuse (cdr in)
(if (and (string? x) (pair? out) (string? (car out)))
(cons (string-append (car out) x) (cdr out))
(cons x out))))))

--

From: Pascal J. Bourguignon on 29 Jan 2010 19:26

Raffael Cavallaro <raffaelcavallaro(a)pas.espam.s.il.vous.plait.mac.com> writes:

> On 2010-01-29 16:20:08 -0500, Raymond Wiker said:
>
>> "Frode V. Fjeld" <frode(a)netfonds.no> writes:
>>
>>> 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.
> [...]
> or combining yours and Frode's approaches:
>
> (defun merge-strings (list)
> (loop while list
> if (stringp (car list)) collect
> (apply #'concatenate 'string
> (loop while (stringp (car list))
> collect (pop list)))
> else collect (pop list)))

Yes, but it's too far from what was expressed in the first place.

I would translate the requirements:

"Concatenating adjacent strings in a list"

as:

(doing concatenate-string adjacent stringp list)

(defmacro doing (transformer qualifier predicate list)
`(funcall (function ,qualifier) (function ,transformer) (function ,predicate) ,list))

(defun concatenate-string (&rest arguments)
(apply (function concatenate) 'string arguments))

(defun adjacent (transformer predicate list)
(loop
:while list
:if (funcall predicate (car list))
:collect (apply transformer
(loop
:while (funcall predicate (car list))
:collect (pop list)))
:else :collect (pop list)))

(mapcar (lambda (list)
(doing concatenate-string adjacent stringp list))
'(("abc" 1 2 3 "def")
("a" "b" "c" 1 2 3 "d" "e" "f")
("abc" 1 2 "def" 3 4 "ghi")
("a" "b" "c" 1 2 "d" "e" "f" 3 4 "g" "h" "i")
(0 "abc" 1 2 3 "def" 9)
(0 "a" "b" "c" 1 2 3 "d" "e" "f" 9)
(0 "abc" 1 2 "def" 3 4 "ghi" 9)
(0 "a" "b" "c" 1 2 "d" "e" "f" 3 4 "g" "h" "i" 9)))
--> (("abc" 1 2 3 "def")
("abc" 1 2 3 "def")
("abc" 1 2 "def" 3 4 "ghi")
("abc" 1 2 "def" 3 4 "ghi")
(0 "abc" 1 2 3 "def" 9)
(0 "abc" 1 2 3 "def" 9)
(0 "abc" 1 2 "def" 3 4 "ghi" 9)
(0 "abc" 1 2 "def" 3 4 "ghi" 9))

See also: http://groups.google.com/group/comp.lang.lisp/msg/a827235ce7466a92

--
__Pascal Bourguignon__

From: Pascal J. Bourguignon on 29 Jan 2010 19:16

First | Prev | 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?