Concatenating adjacent strings in a list
Adam White
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?
Zach Beane
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)))))))
Zach
Pillsy
> > 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
Ariel Badichi
> 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
Ole Arndt
And another solution:
(defun merge-strings (list)
(labels ((conc (beg cur rest)
(cond ((null cur)
beg)
((and (stringp cur) (stringp (first rest)))
(conc beg
(concatenate 'string cur (first rest))
(rest rest)))
(t
(conc (nconc beg (list cur))
(first rest)
(rest rest))))))
(conc nil (first list) (rest list))))
--
Ole Arndt http://www.sugarshark.com
---------------------------------------------------------------
This message was ROT-13 encrypted twice for extra security.
Frode V. Fjeld
> 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)))))))
--
Frode V. Fjeld
W. James
CL (COBOL-LISP) isn't very good at handling lists. You've illustrated
that very well.
Let's use Matzlisp:
["1","2",3,4,"5","6",7,8,"9"].inject([]){|a,x|
(if x.is_a?(String) and a.last.is_a?(String)
a.last
else
a
end) << x
a
}
==>["12", 3, 4, "56", 7, 8, "9"]
--
Richard Fateman
(defun f(l)
(cond ((and(stringp (car l))(stringp (cadr l)))
(f (cons (concatenate 'string (car l) (cadr l))
(cddr l))))
((cadr l) (cons (car l)(f (cdr l))))
(t l)))
;; (f '("1" "2" 3 4 "5" "6" 7 8 "9")) --> ("12" 3 4 "56" 7 8 "9")
;; obviously this could be made longer and more "self documenting"
;; and avoiding cdr and friends.
;; like this
(defun f(lis)
(let ((h (first lis))(r (rest lis)))
(cond ((and(stringp h)(stringp (first r)))
(f (cons (concatenate 'string h (first r))
(rest r))))
(r (cons h (f r)))
(t lis))))
Kaz Kylheku
I dislike all of the solutions hitherto given. :)
The following is fantasy syntax, based on imaginary extensions to Fare Rideau's
pattern notation:
;; 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.
(lex-collect input-list (tok)
((list (1+ (of-type string))) (apply #'concatenate 'string tok))
((list item) item))
Notes:
- lex-collect returns an implicit list, which is constructed by
collecting the return values of the rule bodies.
- A rule can append multiple items to the list by returning multiple
values. Returning (values) means that nothing is collected.
- 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.
- 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.
- 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).
- 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))
- If the input doesn't match any rule, and the input object is other than nil,
an error is signaled.
- A rule with an empty body signals the same kind of error, if it matches.
Successful rules must evaluate at least one expression.
Raymond Wiker
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.
Michael Gardner
> On 2010-01-29, Adam White <spu...@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=
Raffael Cavallaro
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
W. James
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))))))
--
Pascal J. Bourguignon
> On 2010-01-29 16:20:08 -0500, Raymond Wiker said:
>
>> "Frode V. Fjeld" <fr...@netfonds.no> writes:
>>
>>> Adam White <spu...@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__
Pascal J. Bourguignon
> On 2010-01-29 16:20:08 -0500, Raymond Wiker said:
>
>> "Frode V. Fjeld" <fr...@netfonds.no> writes:
>>
>>> Adam White <spu...@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)))
Adam White
> (defun f(l)
> (cond ((and(stringp (car l))(stringp (cadr l)))
> (f (cons (concatenate 'string (car l) (cadr l))
> (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
>
> ;; (f '("1" "2" 3 4 "5" "6" 7 8 "9")) --> ("12" 3 4 "56" 7 8 "9")
Thanks Richard - that's exactly the sort of thing I had in mind but
couldn't express.
A
Pillsy
> Raymond Wiker wrote:
> > "Frode V. Fjeld" <fr...@netfonds.no> writes:
[...]
> Users of CL (COBOL-LISP) would be helpless without loop.
You mean helpless the same way you are, writing programs O(N^2)
behavior due to repeatedly using string-append?
> 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))))))
Sheesh,
Pillsy
Raymond Wiker
Please be more careful with your attributions... I don't want to
be held responsible for the crap that W. James produces, and I suspect
that neither do Kaz Kylheku and Frode V. Fjeld.
Pillsy
[...]
> Please be more careful with your attributions... I don't want to
> be held responsible for the crap that W. James produces, and I suspect
> that neither do Kaz Kylheku and Frode V. Fjeld.
Oops. I was sorta quoting on autopilot there.
Sorry about that,
Pillsy
Huai Yuan
> 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")
(defun concatenate-adjacent-strings (list)
(reduce (lambda (x y)
(if (and (stringp x) (stringp (car y)))
(cons (concatenate 'string x (car y)) (cdr y))
(cons x y)))
list :from-end t :initial-value nil))
Ole Arndt
> (defun f(lis)
> (let ((h (first lis))(r (rest lis)))
> (cond ((and(stringp h)(stringp (first r)))
> (f (cons (concatenate 'string h (first r))
> (rest r))))
> (r (cons h (f r)))
> (t lis))))
Much nicer, but not tail recursive anymore ;)
Ole
Tayssir John Gabbour
On Jan 29, 8:06 pm, Richard Fateman <fate...@cs.berkeley.edu> wrote:
> (defun f(l)
> (cond ((and(stringp (car l))(stringp (cadr l)))
> (f (cons (concatenate 'string (car l) (cadr l))
> (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
If I understand correctly, there's a bug -- CADR will have a problem
with nil. Instead, CDDR should be used, otherwise this happens:
cl-user> (f '(1 nil "2" "3" "4" "5"))
(1 NIL "2" "3" "4" "5")
This computer I'm on don't have Slime+SBCL, so excuse me for the
Clojure version -- this is trivially translatable to idiomatic CL:
(defn vec-butlast [a-vector]
(subvec a-vector 0 (max 0 (dec (count a-vector)))))
(defn concatenate-adjacent-strings [lst]
(reduce (fn [accumulator item]
(if (and (string? (last accumulator))
(string? item))
(conj (into [] (vec-butlast accumulator))
(str (last accumulator) item))
(conj accumulator item)))
[]
lst))
People elsewhere on this thread are attempting to buffer the strings
to avoid worst-case repeated string concatenation, so here's an
optimized version:
(defn concatenate-adjacent-strings-2 [lst]
(let [[result buffer]
(reduce (fn [[accumulator buffer] item]
(cond (string? item)
[accumulator (conj buffer item)]
(seq buffer)
[(conj accumulator (apply str buffer) item)
[]]
:else
[(conj accumulator item) buffer]))
[[] []]
lst)
result (if (seq buffer)
(conj result (apply str buffer))
result)]
result))
While I'm a big LOOP partisan, I think REDUCE is just more
streamlined, perhaps clearer than LOOP. I agree with Kaz that pattern-
matching would be great, if there were an available library.
All the best,
Tayssir
Tayssir John Gabbour
wrote:
> While I'm a big LOOP partisan, I think REDUCE is just more
> streamlined, perhaps clearer than LOOP.
Hmm, I take that back; some of the ones where you're modifying lists
while iterating over them are pretty concise and clear.
All the best,
Tayssir
Raymond Wiker
Tayssir John Gabbour
wrote:
> > While I'm a big LOOP partisan, I think REDUCE is just more
> > streamlined, perhaps clearer than LOOP.
>
> Hmm, I take that back; some of the ones where you're modifying lists
> while iterating over them are pretty concise and clear.
Bothered that the LOOP versions are shorter than the relative
monstrosity I created, I looked for more impressive higher-order
function stuff to cut down on size:
(defn concatenate-adjacent-strings [lst]
(lazy-seq
(cond (empty? lst)
nil
(string? (first lst))
(let [[strings remainder] (split-with string? lst)]
(cons (apply str strings) (concatenate-adjacent-strings
remainder)))
:else
(cons (first lst) (concatenate-adjacent-strings (rest
lst))))))
Ssomeone more familiar with lazy eval than me can probably translate
this into idiomatic CL, and compare it to the succinct LOOP versions.
All the best,
Tayssir
Kaz Kylheku
> Richard Fateman <fat...@cs.berkeley.edu> writes:
>
>> (defun f(lis)
>> (let ((h (first lis))(r (rest lis)))
>> (cond ((and(stringp h)(stringp (first r)))
>> (f (cons (concatenate 'string h (first r))
>> (rest r))))
>> (r (cons h (f r)))
>> (t lis))))
>
> Much nicer, but not tail recursive anymore ;)
Don't forget that we can rewrite tail recursion into proper iteration
with a macro, which preserves the tail recursive expression.
Search the archives for the TAILPROG macro.
W. James
A little golfing:
["1","2",3,4,"5","6",7,8,"9"].reduce([]){|a,x|
(x.is_a?(String) && a[-1].is_a?(String) ? a[-1] : a ) << x
Tayssir John Gabbour
> I dislike all of the solutions hitherto given. :)
>
> The following is fantasy syntax, based on imaginary extensions to Fare Rideau's
> pattern notation:
>
> ;; 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.
>
> (lex-collect input-list (tok)
> ((list (1+ (of-type string))) (apply #'concatenate 'string tok))
> ((list item) item))
Thanks Kaz for the brilliant idea. Combined with the pattern matching
lib* I saw today on Planet Clojure, here's this little beauty:
(defn concat-adj-strings [lst]
(lazy-seq
(match (split-with string? lst)
[[] []] nil
[[] b] (cons (first b) (concat-adj-strings (rest b)))
[a b] (cons (apply str a) (concat-adj-strings b)))))
Let the soul sing.
Tayssir
Richard Fateman
This is tail recursive:
(defun f(l)
(cond ((null l) nil)
((and(stringp (car l))(stringp (cadr l)))
(cons (concatenate 'string (car l) (cadr l))
(f (cddr l))))
((cadr l) (cons (car l)(f (cdr l))))
(t l)))
;; and (cadr l) should not be a problem as long as l is a proper list.
;; (cadr nil) is nil. I don't know what other peoples' solutions would
;; do with, say, ( "1" "2" 3 4 . 5)
Kaz Kylheku
> Kaz Kylheku wrote:
>> On 2010-01-30, Ole Arndt <o...@sugarshark.com> wrote:
>>> Richard Fateman <fat...@cs.berkeley.edu> writes:
>>>
>>>> (defun f(lis)
>>>> (let ((h (first lis))(r (rest lis)))
>>>> (cond ((and(stringp h)(stringp (first r)))
>>>> (f (cons (concatenate 'string h (first r))
>>>> (rest r))))
>>>> (r (cons h (f r)))
>>>> (t lis))))
>>> Much nicer, but not tail recursive anymore ;)
>>
>> Don't forget that we can rewrite tail recursion into proper iteration
>> with a macro, which preserves the tail recursive expression.
>>
>> Search the archives for the TAILPROG macro.
>
> This is tail recursive:
>
> (defun f(l)
> (cond ((null l) nil)
> ((and(stringp (car l))(stringp (cadr l)))
> (cons (concatenate 'string (car l) (cadr l))
> (f (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
These recursive calls are arguments in a call to CONS, and so they are relied
upon to return to that expression, so that it can complete evaluating its
arguments and invoke the CONS function.
Rule of thumb: if the algorithm would break if a recursive call did not return
normally, then it's not a tail call.
Thomas A. Russ
> This is tail recursive:
>
> (defun f(l)
> (cond ((null l) nil)
> ((and(stringp (car l))(stringp (cadr l)))
> (cons (concatenate 'string (car l) (cadr l))
> (f (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
>
> ;; and (cadr l) should not be a problem as long as l is a proper list.
> ;; (cadr nil) is nil. I don't know what other peoples' solutions would
> ;; do with, say, ( "1" "2" 3 4 . 5)
Unfortunately, it is also slightly incorrect, in that if fails if there
are three strings in a row. Try it on:
("1" "2" "WWW" 3 4)
But I think the fix is easy. The recursive call in the second COND
clause needs to be outside the concatenate, whose results need to be
combined with the remaining list to be processed again.
(defun f(l)
(cond ((null l) nil)
((and (stringp (car l))(stringp (cadr l)))
(f (cons (concatenate 'string (car l) (cadr l))
(cddr l))))
((cadr l) (cons (car l)(f (cdr l))))
(t l)))
--
Thomas A. Russ, USC/Information Sciences Institute
Tayssir John Gabbour
> (defun f(l)
> (cond ((null l) nil)
> ((and(stringp (car l))(stringp (cadr l)))
> (cons (concatenate 'string (car l) (cadr l))
> (f (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
>
> ;; and (cadr l) should not be a problem as long as l is a proper list.
> ;; (cadr nil) is nil. I don't know what other peoples' solutions would
> ;; do with, say, ( "1" "2" 3 4 . 5)
I like the brevity of your solution (more succinct than some of my
attempts), but it unfortunately has a bug or two even with proper
lists. Under SBCL:
cl-user> (f '(1 nil "2" "3" "4" "5"))
(1 NIL "2" "3" "4" "5")
That input is by definition a proper list, as it's a list terminated
by the empty list.
<http://www.lispworks.com/documentation/HyperSpec/Body/
26_glo_p.htm#proper_list>
This input can occur in the real world. If you already have a mix of
strings and non-strings, then some of those non-strings could be
nulls. Maybe the original poster is writing a tokenizer, and nil
represents some kinda null object.
All the best,
Tayssir
Frode V. Fjeld
> (defun f(l)
> (cond ((null l) nil)
> ((and (stringp (car l))(stringp (cadr l)))
> (f (cons (concatenate 'string (car l) (cadr l))
> (cddr l))))
> ((cadr l) (cons (car l)(f (cdr l))))
> (t l)))
Doesn't this break if the list contains a NIL element? I guess the cadr
should be a cdr.
This is of course a very subjective issue, but I'm surprised that
apparently so many programmers find it attractive to write trivial
iterations in so many .. well, strange ways. I think the loop example I
gave before is pretty much superior to all the other examples provided
in this thread in the sense that it's easy to see what it does
(correctly), and it's easy to see that it has perfect O(N) behavior both
in terms of the number of list elements, the string lengths, and number
of consecutive strings:
(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))))))
--
Frode V. Fjeld
Adam White
[snippity doo dah]
> Maybe the original poster is writing a tokenizer, and nil
> represents some kinda null object.
Actually there aren't supposed to be any '()s in the input stream.
There are only supposed to be sublists representing actors
(nominative, accusative, dative, genitive, verbs), four value tuples
representing RGBA colours, and strings for verbatim text.
The intended purpose is an english-grammar state machine. Given a
list of strings and other items in a list, the state machine
turns tokens into an english string.
The adjacent string concatenation is just an optimisation hack for
rendering.
A
Pillsy
> t...@sevak.isi.edu (Thomas A. Russ) writes:
>
> > (defun f(l)
> > (cond ((null l) nil)
> > ((and (stringp (car l))(stringp (cadr l)))
> > (f (cons (concatenate 'string (car l) (cadr l))
> > (cddr l))))
> > ((cadr l) (cons (car l)(f (cdr l))))
> > (t l)))
>
> Doesn't this break if the list contains a NIL element? I guess the cadr
> should be a cdr.
>
> This is of course a very subjective issue, but I'm surprised that
> apparently so many programmers find it attractive to write trivial
> iterations in so many .. well, strange ways.
I find it surprising too, and it's especially surprising that no one's
used the one alternative strategy that would, IMO, actually have
comparable clarity, which is to use *two* mutually recursing
functions. The problem can be easily handled by a simple finite state
machine, and mutually recursing functions are a good, obvious way to
implement finite state machines. Put them inside a LABELS form and you
can use Kaz's TAILPROG macro if your implementation won't merge the
tail calls for some reason.
> I think the loop example I
> gave before is pretty much superior to all the other examples provided
> in this thread in the sense that it's easy to see what it does
> (correctly), and it's easy to see that it has perfect O(N) behavior both
> in terms of the number of list elements, the string lengths, and number
> of consecutive strings:
>
> (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 agree. I also think it's better than the obvious mutually recursing
solution, but the disparity isn't as glaring.
(defun merge-strings (list)
(labels ((normal (list acc)
(if (null list)
(nreverse acc)
(destructuring-bind (f . r) list
(if (stringp f)
(string-run r acc (list f))
(normal r (cons f acc))))))
(string-run (list acc sacc)
(let ((f (first list)))
(if (stringp f)
(string-run (rest list) acc (cons f sacc))
(normal list
(cons (apply #'concatenate 'string
(nreverse sacc))
acc))))))
(normal list '())))
It would even work in Scheme, unlike the alleged Scheme solution
posted in the thread, though you might have to write the moral
equivalent of CONCATENATE for strings yourself.
Cheers,
Pillsy
André Thieme
> Let's use Matzlisp:
>
> ["1","2",3,4,"5","6",7,8,"9"].inject([]){|a,x|
> (if x.is_a?(String) and a.last.is_a?(String)
> a.last
> else
> a
> end)<< x
> a
> }
> ==>["12", 3, 4, "56", 7, 8, "9"]
OMG, is Ruby really that complicated? William, you should try it in Lisp:
(mapcat #(if (string? (first %)) [(apply str %)] %)
(partition-by string? ["1" "2" 3 4 "5" "6" 7 8 "9"]))
André
--
Lisp is not dead. It’s just the URL that has changed:
http://clojure.org/
Wade
> 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")
>
Saturday is play day...
(defun concatas (list &aux result)
(dolist (element list (nreverse result))
(if (and (stringp element) (stringp (car result)))
(setf (car result) (concatenate 'string (car result) element))
(push element result))))
CL-USER> (concatas '("1" "2" 3 4 "5" "6" 7 8 "9"))
("12" 3 4 "56" 7 8 "9")
CL-USER>
Wade
WJ
Clojure:
(reverse
(reduce (fn [accum x]
(if (and (string? x)(string? (first accum)))
(cons (str (first accum) x) (rest accum))
(cons x accum)))
'()
mylist))
WJ
> "Frode V. Fjeld" <fr...@netfonds.no> writes:
>
> > Adam White <spu...@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.
Clojure:
user=> (def mylist '("1" "2" 3 4 "5" "6" 7 8 "9"))
#'user/mylist
user=> (partition-by string? mylist)
(("1" "2") (3 4) ("5" "6") (7 8) ("9"))
user=> (mapcat #(if (string? (first %)) [(apply str %)] %)
(partition-by string? mylist))
WJ
No, it's a bad idea, and it doesn't "show off" LOOP; it puts LOOP
in the bad light that it deserves.
Scheme:
(fold-right
(lambda (x accum)
(if (and (string? x) (pair? accum) (string? (car accum)))
(cons (string-append x (car accum)) (cdr accum))
Tim Bradshaw
> No, it's a bad idea, and it doesn't "show off" LOOP; it puts LOOP
> in the bad light that it deserves.
Quite right. People could *read* the code that uses LOOP and work out
what it did, which wouldn't do at all: we need things to be more
inscrutable than that to preserve the mystique. For instance it's
*never* a good idea to write things which look like
<loop-indicator> <variables-to-bind> <things-to-loop-over>
<things-to-do>
Instead always write this
<strange-word>
<meaningless-symbol> <variables>
<things-to-do>
<obscure-starting-value>
<things-to-loop-over>
That's much harder to understand, and therefore, obviously, better.
Rainer Joswig
> Raymond Wiker wrote:
> > "Frode V. Fjeld" <fr...@netfonds.no> writes:
>
Common Lisp:
$ (reduce (lambda (x accum)
(if (and (stringp x) (stringp (car accum)))
(cons (concatenate 'string x (car accum))
(cdr accum))
(cons x accum)))
'("1" "2" 3 4 "5" "6" 7 8 "9")
:initial-value ()
:from-end t)
Rainer Joswig
Common Lisp, using LOOP:
$ (loop with list = '("1" "2" "3" 4 "5" "6" 7 8 "9")
while list
when (and (stringp (first list)) (stringp (second list)))
do (push (concatenate 'string (pop list) (pop list)) list)
else collect (pop list))
("123" 4 "56" 7 8 "9")
Mark Tarver
> in the bad light that it deserves.
>
> Scheme:
WJ,
I fear your anti-loop campaign is only going to encourage CL
programmers to cling more closely to this style. This is one reason
why I would not recommend Common Lisp as an introduction to functional
programming for beginners.
Anyway in Qi.
(define conc
[] -> []
[X Y | Z] -> (conc [(make-string "~A~A" X Y) | Z]) where (and
(string? X) (string? Y))
[X | Y] -> [X | (conc Y)])
And a more interesting example - Pascal's triangle cited in the thread
on great loop (?)programming.
(define pascals-triangle
N -> [[1] | (iterate (/. X [1 | (build-triangle X)]) [1] N)])
(define iterate
F X 0 -> []
F X N -> (let FX (F X) [FX | (iterate F FX (- N 1))]))
(define build-triangle
[X Y | Z] -> [(+ X Y) | (build-triangle [Y | Z])]
_ -> [1])
Mark
Tim Bradshaw
> This is one reason
> why I would not recommend Common Lisp as an introduction to functional
> programming for beginners.
Where did the Canard that CL was a particularly functional programming
language spring from? It's not: neither are Java, SmallTalk or
Fortran. If the only sort of programming that interests you is
functional, then you want another language (and, please, another
newsgroup).
Rainer Joswig
> On 2011-03-06 15:36:33 +0000, Mark Tarver said:
>
> > This is one reason
> > why I would not recommend Common Lisp as an introduction to functional
> > programming for beginners.
>
> Where did the Canard that CL was a particularly functional programming
> language spring from? It's not: neither are Java, SmallTalk or
Smalltalk ;-)
Tim Bradshaw
>
> Smalltalk ;-)
I have been infected with the studlycaps virus. There is no hope for me now.
Rainer Joswig
I propose printing the symbol table of the Common Lisp package
and reading through the first hundred symbols as a cure.
Tim Bradshaw
> I propose printing the symbol table of the Common Lisp package
> and reading through the first hundred symbols as a cure.
That would certainly be more use than listening to WJ. Actually, the
ragged and rather malodourous person I passed on my way to work today
was muttering something that sounded like "Matz", in between drinks
from a bottle full of a disturbing yellow liquid, so I have my
suspicions now.
Mark Tarver
Lisp is discussed as a functional language in nearly every
introduction to functional programming and is thought of as the first
of the species. I think if any Lisp cedes it's ground as a serious
functional language to other alternatives by refusing to compete on
those terms then it will have yielded its future. CL minus its
functional core is just an assortment of various add ons; not all of
them all that great.
Good for WJ for posting some alternatives from other members of the
Lisp family.
Mark
Frode V. Fjeld
> CL minus its functional core is just an assortment of various add ons;
> not all of them all that great.
"Functional" is a pretty ambiguous term. CL and Lisp in general has
always had first-class function objects and "higher-order functions",
but many lisps and CL in particular has nothing whatsoever to do with
side-effect-free programming which is what is typically meant by
"functional programming" today. (The two concepts are almost completely
orthogonal, btw.)
--
Frode V. Fjeld
Pascal J. Bourguignon
> Mark Tarver <dr.mt...@ukonline.co.uk> writes:
>
>> CL minus its functional core is just an assortment of various add ons;
>> not all of them all that great.
>
> "Functional" is a pretty ambiguous term. CL and Lisp in general has
> always had first-class function objects and "higher-order functions",
Always, and foremost, the FIRST!
(But then, it was also the first to have garbage collection, the first
to have a standardized OO system, the first to have an interactive
environment, etc. Perhaps it should have been named FIRST).
> but many lisps and CL in particular has nothing whatsoever to do with
> side-effect-free programming which is what is typically meant by
> "functional programming" today. (The two concepts are almost completely
> orthogonal, btw.)
I don't agree. Lisp has a lot to do with side effect programming,
because it's one of the rare languages that _allows_ it. (Less rare
nowadays, but still).
In a language that distinguishes statements from expressions, and that
has no garbage collector, (eg. C, C++, etc), it is just close to
impossible to write side-effect-free code.
These two features, all code is an expression, and there's a garbage
collector (which hides the mutations of memory), plus the fact that
functions are first class objects, are what let you write "functional"
code. Not a lot of languages have these three items.
(You can generalize the garbage collector to any abstraction mechanism
that let you slip the side-effects under the rug, such as monads).
--
__Pascal Bourguignon__ http://www.informatimago.com/
A bad day in () is better than a good day in {}.
Didier Verna
> Where did the Canard that CL was a particularly functional programming
> language spring from? It's not: neither are Java, SmallTalk or
> Fortran. If the only sort of programming that interests you is
> functional, then you want another language (and, please, another
> newsgroup).
That's a terminology problem, and a *big* one in fact[1]. The problem
is that some (too many) people use the term "functional" in the sense of
"purely functional", which is wrong IMO.
Being "functional" should mean only "having functions as 1st class
citizens", as per Christopher Stratchey's definition. End of story.
Now being purely functional is another story, and a completely
orthogonal one BTW. It just happens that there's not much you can do
with a pure language if it's not a functional one as well.
So yes, Common Lisp is a functional language. It also is a
/particularly/ functional one as all Lisp dialects, but the truth is,
being perhaps the most multi-paradigm language, Lisp is also
/particularly/ procedural, /particularly/ OO etc. It's just not
particularly pure :-)
Footnotes:
[1] So why terminology is such a big problem here? Because by mixing up
"functional" and "purely functional", you make communities unable to
talk to each other. I remember one ECOOP conference where Simon Peyton
Jones were giving a keynote on Haskell in front of a crowd of mostly
Java/C++ guys. I remember talking to both crowds about Lisp.
For the average C++/Java guy, Lisp is this weird /functional/ language
with lots of parens. Functional, because they're impressed with 1st
order.
For the average Haskell guy, Lisp is this weird /imperative/ language
with lots of parens. Imperative, because for some reason, they forgot
that 1st class functions are useful, even without purity.
So basically, these guys can't talk to each other, and you can't talk to
them either. Terminology matters. The only thing that we all agree on is
that Lisp has lots of parens, and is weird ;-)
--
Resistance is futile. You will be jazzimilated.
Scientific site: http://www.lrde.epita.fr/~didier
Music (Jazz) site: http://www.didierverna.com
Tim Bradshaw
> "Functional" is a pretty ambiguous term. CL and Lisp in general has
> always had first-class function objects and "higher-order functions",
> but many lisps and CL in particular has nothing whatsoever to do with
> side-effect-free programming which is what is typically meant by
> "functional programming" today. (The two concepts are almost completely
> orthogonal, btw.)
This is what I meant. I am of course aware of the history, but I'm
interested in what functional programming means *now* not what it meant
in the late 50s (if it meant anything). CL has a huge collection of
mutation operators, many of them user-extensible, up to an including
protocols to mutate the type of objects while maintaining identity.
That is not the hallmark of a modern FP language. CL obviously has
functional aspects - being an expression language, for instance - but
if I wanted a functional language - even a functional Lisp, I'd not be
using CL. I might use CL to *write* a functional language.
Tim Bradshaw
> So yes, Common Lisp is a functional language. It also is a
> /particularly/ functional one as all Lisp dialects, but the truth is,
> being perhaps the most multi-paradigm language, Lisp is also
> /particularly/ procedural, /particularly/ OO etc. It's just not
> particularly pure :-)
I guess that is right: I should perhaps have said "particularly pure
...". What I really meant was "particularly when compared with other
Lisp dialects": for instance I'd say it is less strong as a functional
language than various other Lisp dialects (for instance Racket with its
immutable-by-default everything).
Gary Schiltz
Hey, the waxy one may be a troll, but at least he/she/it passes the Turing test and adds useful information to the discussion. After all the mindless BS from the C-tunafish-bot[ulism] sandwich, I kind of look forward to reading WJ.
Marco Antoniotti
I agree. Morevoer, in his/her/it bout with Scheme he is less
obnoxious and he is slowly turning to my side... He/she/it may never
write a LOOP, but that's ok :)
Cheers
--
MA
Cthun
> Hey, the waxy one may be a troll, but at least he/she/it passes the
> Turing test and adds useful information to the discussion. After all
> the mindless BS from the C-tunafish-bot[ulism] sandwich, I kind of
> look forward to reading WJ.
Who is "the C-tunafish-bot[ulism] sandwich", Schiltz? There is nobody in
this newsgroup using that alias.
Tim Bradshaw
> Hey, the waxy one may be a troll, but at least he/she/it passes the
> Turing test and adds useful information to the discussion. After all
> the mindless BS from the C-tunafish-bot[ulism] sandwich, I kind of look
> forward to reading WJ.
Well, obviously anything is better than the other one, but WJ is
interesting only in the sense that listening to a politician answer
questions is interesting - you *know* that he has some big personal
agenda about CL in general and LOOP in particular, and everything he
says will be pushing that agenda - and I think that's really not
interesting at all, because you don't get any useful information from
that kind of bias. I'm all for the discussion of advantages &
disadvantages of various languages and programing styles, but it needs
to be based on something other than blind prejudice.
WJ
> Adam White <spu...@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))))
> >
> > Surely there has got to be a better way to do this!
> >
> > Any pointers?
>
> And another solution:
>
> (defun merge-strings (list)
> (labels ((conc (beg cur rest)
> (cond ((null cur)
> beg)
> ((and (stringp cur) (stringp (first rest)))
> (conc beg
> (concatenate 'string cur (first rest))
> (rest rest)))
> (t
> (conc (nconc beg (list cur))
> (first rest)
> (rest rest))))))
> (conc nil (first list) (rest list))))
Arc:
(def clump (func lst)
(if (empty lst)
'()
(withs (test (if (func (car lst)) (complement func) func)
p (or (pos test lst) (len lst)))
(cons (firstn p lst) (clump func (nthcdr p lst))))))
(flat (map [if (number (car _)) _ (apply string _)]
(clump number '("1" "2" 3 4 "5" "6" 7 8 "9"))))