I want to map over a list, but keeping track of the element index in the list.
In Python I can do something along the lines of:
map(lambda (idx, elt): "Elt {0}: {1}".format(idx, elt), enumerate(mylist))
I was trying to translate it to something along the lines of:
(mapcar-something (lambda (elt idx) (format nil "Elt ~D: ~S" idx elt))
'(a b c d))
Expected result:
("Elt 0: A" "Elt 1: B" "Elt 2: C" "Elt 3: D")
But I can't find the mapcar-something function that I should use. Do I need to implement that myself (via loop, maybe)?
CL-USER 25 > (defun iota (n)
(loop for i below n collect i))
IOTA
CL-USER 26 > (iota 4)
(0 1 2 3)
CL-USER 27 > (mapcar (lambda (elt idx)
(format nil "Elt ~D: ~S" idx elt))
'(a b c d)
(iota 4))
("Elt 0: A" "Elt 1: B" "Elt 2: C" "Elt 3: D")
or
CL-USER 28 > (loop for elt in '(a b c d) and idx from 0
collect (format nil "Elt ~D: ~S" idx elt))
("Elt 0: A" "Elt 1: B" "Elt 2: C" "Elt 3: D")
Common Lisp's LOOP macro can automatically keep track of the index.
(loop for elt in '(a b c d) and idx from 0
collect (operation-on idx elt))
LOOP automatically increases by 1 a variable initialized with from; and if they are introduced by and then both assignations (the element of the array and the index) happen at once, not nested.
Thus, an enumerate function would be along the lines of:
(defun enumerate (list &optional (first-index 0))
(loop for elt in list and idx from first-index
collect (cons idx elt)))
In the expressiveness of Common Lisp, it would possibly be useful to define a macro along the lines of:
(defmacro with-enumerated-list ((list elt idx &key (first-index 0)) &body body)
`(loop for ,elt in ,list and ,idx from ,first-index
collect (progn ,#body)))
In which case, the enumerate function could be reduced to:
(defun enumerate (list &optional (first-index 0))
(with-enumerated-list (list elt idx :first-index first-index)
(cons idx elt)))
Here's another one:
(defun enumerate (collection &key (as 'list))
(let ((index -1))
(map as
(lambda (element)
(cons (incf index) element))
collection)))
This one has the advantage that it works for and can result in both lists and vectors:
CL-USER[2]: (enumerate '(1 2 3))
((0 . 1) (1 . 2) (2 . 3))
CL-USER[3]: (enumerate "abc" :as 'vector)
#((0 . #\a) (1 . #\b) (2 . #\c))
If you want something that looks like your original example:
(defun enumerate (function list)
(let ((idx 0))
(loop for elt in list
collect (funcall function elt idx)
do (incf idx))))
Your example:
(enumerate (lambda (elt idx) (format nil "Elt ~D: ~S" idx elt))
'(a b c d))
=> ("Elt 0: A" "Elt 1: B" "Elt 2: C" "Elt 3: D")
Related
I am using a function from an external library returning a vector of four numbers and I want to access these values directly like it would be possible with destructuring-bind. See this pointless example:
(defun a-vector ()
(vector 1 2 3 4))
(defun a-list ()
(list 1 2 3 4))
(destructuring-bind (a b c d)
(a-list)
(format t "~D ~D ~D ~D~%" a b c d))
(destructuring-bind (a b c d)
(coerce (a-vector) 'list)
(format t "~D ~D ~D ~D~%" a b c d))
If I coerce the vector into a list it is possible and as performance isn't a problem here, it is maybe fine. But I was wondering if there is a more simple way?
You can bind variables to each cell as follows:
(defmacro with-aref ((&rest indices) array &body body)
(let ((a (gensym)))
`(let ((,a ,array))
(symbol-macrolet
,(loop
for n from 0
for i in indices
collect (list i `(aref ,a ,n)))
,#body))))
You would use it as follows:
(with-aref (w x y z) vec
(setf w (+ x y z)))
With a bit more work, you can also support indices and different categories of accessors. Let's say each binding is a triple (i n k) where i is an identifier, n a number (or nil) that represents the numerical index and k is either :place, :value or nil; :place binds the symbol with symbol-macrolet, :value just binds it with let.
First, let's help the user by providing shortcut notations:
x stands for (x nil nil)
(x o) either stands for (x o nil) or (x nil o), depending on whether option o is a number or a symbol (at macroexpansion time).
Besides, we may want to automatically ignore the nil identifier, the empty symbol || or symbols starting with an underscore (e.g. _, _var).
Here is the normalization function:
(defun normalize-index (index)
(flet ((ret (i n k)
(let ((ignored (or (null i)
(string= i "")
(char= #\_ (char (string i) 0)))))
(list (if ignored (gensym) i) n k ignored))))
(let ((index (alexandria:ensure-list index)))
(typecase index
(null (ret nil nil nil))
(cons (destructuring-bind (i &optional n (k nil kp)) index
(if kp
(ret i n k)
(etypecase n
(symbol (ret i nil n))
((integer 0) (ret i n nil))))))))))
We can apply this normalization to a list of indices, and keep track of ignored symbols:
(defun normalize (indices)
(loop
for i in indices
for norm = (normalize-index i)
for (index number kind ignore) = norm
collect norm into normalized
when ignore
collect index into ignored
finally (return (values normalized ignored))))
Then, we take care of nil numbers in normalized entries. We want the indices to increase from the last used index, or be given explicitly by the user:
(defun renumber (indices)
(loop
for (v n k) in indices
for next = nil then (1+ index)
for index = (or n next 0)
collect (list v index k)))
For example:
(renumber (normalize '(a b c)))
((A 0 NIL) (B 1 NIL) (C 2 NIL))
(renumber (normalize '((a 10) b c)))
((A 10 NIL) (B 11 NIL) (C 12 NIL))
(renumber (normalize '((a 10) (b 3) c)))
((A 10 NIL) (B 3 NIL) (C 4 NIL))
We do the same for the kind of variable we bind:
(defun rekind (indices)
(loop
for (v n k) in indices
for next = nil then kind
for kind = (or k next :place)
collect (list v n kind)))
For example:
(rekind (normalize '(a b c)))
((A NIL :PLACE) (B NIL :PLACE) (C NIL :PLACE))
(rekind (normalize '(a (b :value) c)))
((A NIL :PLACE) (B NIL :VALUE) (C NIL :VALUE))
Finally, all those steps are combined in parse-indices:
(defun parse-indices (indices)
(multiple-value-bind (normalized ignored) (normalize indices)
(values (rekind (renumber normalized))
ignored)))
Finally, the macro is as follows:
(defmacro with-aref ((&rest indices) array &body body)
(multiple-value-bind (normalized ignored) (parse-indices indices)
(labels ((ignored (b) (remove-if-not #'ignoredp (mapcar #'car b)))
(ignoredp (s) (member s ignored)))
(loop
with a = (gensym)
for (i n k) in normalized
for binding = `(,i (aref ,a ,n))
when (eq k :value) collect binding into values
when (eq k :place) collect binding into places
finally (return
`(let ((,a ,array))
(let ,values
(declare (ignore ,#(ignored values)))
(symbol-macrolet ,places
(declare (ignore ,#(ignored places)))
,#body))))))))
For example:
(let ((vec (vector 0 1 2 3 4 5 6 7 8 9 10)))
(prog1 vec
(with-aref ((a 2) (b :value) c _ _ d (e 0) (f 1)) vec
(setf a (list a b c d e f)))))
The above is macroexpanded as:
(LET ((VEC (VECTOR 0 1 2 3 4 5 6 7 8 9 10)))
(LET ((#:G1898 VEC))
(LET ((#:G1901 VEC))
(LET ((B (AREF #:G1901 3))
(C (AREF #:G1901 4))
(#:G1899 (AREF #:G1901 5))
(#:G1900 (AREF #:G1901 6))
(D (AREF #:G1901 7))
(E (AREF #:G1901 0))
(F (AREF #:G1901 1)))
(DECLARE (IGNORE #:G1899 #:G1900))
(SYMBOL-MACROLET ((A (AREF #:G1901 2)))
(DECLARE (IGNORE))
(LET* ((#:G19011902 #:G1901)
(#:NEW1 (LIST (AREF #:G1901 2) B C D E F)))
(FUNCALL #'(SETF AREF) #:NEW1 #:G19011902 2)))))
#:G1898))
It produces the following result
#(0 1 (2 3 4 7 0 1) 3 4 5 6 7 8 9 10)
coredump's answer is lovely. This is a variant of it which binds variables rather than accessors, and also lets you optionally specify indices. So
(with-vector-elements ((a 3) b) x
...)
will bind a to the result of (aref x 3) and b to the result of (aref x 4), for instance.
This is really only useful over coredump's answer if you're intending to (a) not write back to the vector and (b) use the bindings a lot, so you want to avoid a lot of possible arefs (which I don't think compilers can generally optimize away without some fairly strong assumptions).
(defmacro with-vector-elements ((&rest indices) vector &body forms)
(let ((canonical-indices
(loop with i = 0
for index in indices
collect (etypecase index
(symbol
(prog1
`(,index ,i)
(incf i)))
(cons
(destructuring-bind (var idx) index
(assert (and (symbolp var)
(typep idx '(and fixnum (integer 0))))
(var idx) "Invalid index spec")
(prog1
index
(setf i (1+ idx))))))))
(vname (gensym "V")))
`(let ((,vname ,vector))
(let ,(loop for (var index) in canonical-indices
collect `(,var (aref ,vname ,index)))
,#forms))))
There is also a package called metabang-bind - with nickname bind - in which the function bind can handle much more destructuring situations:
(ql:quickload :metabang-bind)
(in-package :metabang-bind)
(bind ((#(a b c) #(1 2 3)))
(list a b c))
;; => (1 2 3)
If not using in-package, you can call the function as bind:bind.
The function bind you can think of roughly as a destructuring-let* (similar idea to clojure's let, however not so clean in syntax but understandable because it has also to handle structs and classes and also values).
All the other use cases it can handle are described here.
So I have to count the occurrence of a word(or character, to be more specific) in a list in lisp. For example, the input:
(freq 'c '(a c c c c (c c c e)))
should produce a count of 7, since there are 7 c's in the list argument. The code I have is the following but it does not work. I can count the 4 c's that are base elements and the 3 c's that are in the sublist, but I dont know how to add them together. Also, I'm using only primitive data types.
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t ((freq a (cdr L))))))
If it's a character then it's should be written with this prefix -> #\
and the sequence would be a string so there is no need recursion here.
(count #\c "(a c c c c (c c c e))") => 7
What you're dealing with in your example is symbol (with a single quote) through a list which contains other symbols or cons. So if you need to count all the same symbol you could write something like that :
(defparameter *nb* 0)
(defun look-deeper (test seq)
(loop for i in seq do
(compare test i)))
(defun compare (test item)
(let ((type (type-of item)))
(case type
(symbol (when (eql test item) (incf *nb*)))
(cons (look-deeper test item)))))
(look-deeper 'c '(a c c c c (c c c e))) => NIL
*nb* => 7
Or something better..
(defun count-occurences (obj lst)
(let ((acc 0))
(labels ((test (obj-2)
(eq obj obj-2)))
(dolist (x lst)
(if (consp x)
(let ((sample (remove-if-not #'test x)))
(if sample
(incf acc (length sample))))
(if (eq x obj)
(incf acc 1)))))
acc))
We could create a function that takes an obj to test and a lst as the argument and create a local accumulator to keep track of how many times the obj occurs in the list. Then we could create a local function that tests to see if the obj we pass to it is eq to the obj passed as an argument to the global function (also note that if you are working with strings you might want to use string-equal or equal because eq will not work since they are not the same object, but eq will work with symbols which you used in your example). We can then iterate through the list, and if the element in the list is a cons we can use remove-if-not to remove any element that doesn't pass our test (is not eq to the obj), and based on the length of the list increment our accumulator accordingly. If it is not a cons and is eq to our obj we will also increment the accumulator, then we can return the value of our accumulator.
And if we test it:
CL-USER> (count-occurences 'c '(a c c c c (c c c)))
7
Your logic is actually correct, there are just some small mis-parenthesis problems in your code. The only change you need for your code to work is to change you listp and t clauses from
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
into
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
and from
(t ((freq a (cdr L))))
into
(t (freq a (cdr L)))
Then evaluating your function works just as you expect:
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t (freq a (cdr L)))))
(freq 'c '((a (c f c)) c c c (c c (d c f (c 8 c) c) e))) ; => 11 (4 bits, #xB, #o13, #b1011)
When I try this code on Emacs SLIME, the apply function gives a different result. Isn't it supposed to give the same result? Why does it give a different result? Thanks.
CL-USER> (apply #'(lambda (n)
(cons n '(b a))) '(c))
(C B A)
CL-USER> (cons '(c) '(b a))
((C) B A)
cons takes an element and a list as arguments. So (cons 'x '(a b c d)) will return (x a b c d).
apply takes a function and a list of arguments -- but the arguments will not be passed to the function as a list! They will be split and passed individually:
(apply #'+ '(1 2 3))
6
(actually, it takes one function, several arguments, of which the last must be a list -- this list will be split and treated as "the rest of the arguments to the function". try, for example, (apply #'+ 5 1 '(1 2 3)), which will return 12)
Now to your code:
The last argument you passed to the apply function is '(c), a list with one element, c. Apply will treat it as a list of arguments, so the first argument you passed to your lambda-form is c.
In the second call, you passed '(c) as first argument to cons. This is a list, which was correctly included in the first place of the resulting list: ( (c) b a).
The second call would be equivalent to the first if you did
(cons 'c '(b a))
(c b a)
And the first call would be equivalent to the second if you did
(apply #'(lambda (n) (cons n '(b a))) '((c)))
((c) b a)
CL-USER 51 > (cons '(c) '(b a))
((C) B A)
CL-USER 52 > (apply #'(lambda (n)
(cons n '(b a)))
'(c))
(C B A)
Let's use FUNCALL:
CL-USER 53 > (funcall #'(lambda (n)
(cons n '(b a)))
'(c))
((C) B A)
See also what happens when we apply a two element list:
CL-USER 54 > (apply #'(lambda (n)
(cons n '(b a)))
'(c d))
Error: #<anonymous interpreted function 40600008E4> got 2 args, wanted 1.
There is a symmetry between &rest arguments in functions and apply.
(defun function-with-rest (arg1 &rest argn)
(list arg1 argn))
(function-with-rest 1) ; ==> (1 ())
(function-with-rest 1 2) ; ==> (1 (2))
(function-with-rest 1 2 3 4 5) ; ==> (1 (2 3 4 5))
Imagine we want to take arg1 and argn and use it the same way with a function of our choice in the same manner as function-with-rest. We double the first argument and sum the rest.
(defun double-first-and-sum (arg1 &rest argn)
(apply #'+ (* arg1 2) argn))
(double-first-and-sum 1 1) ; ==> 3
(double-first-and-sum 4 5 6 7) ; ==> 26
The arguments between the function and the list of "rest" arguments are additional arguments that are always first:
(apply #'+ 1 '(2 3 4)) ; ==> (+ 1 2 3 4)
(apply #'+ 1 2 3 '(4)) ; ==> (+ 1 2 3 4)
This is very handy since often we want to add more arguments than we are passed (or else we could just have used the function apply is using in the first place. Here is something called zip:
(defun zip (&rest args)
(apply #'mapcar #'list args))
So what happens when you call it like this: (zip '(a b c) '(1 2 3))? Well args will be ((a b c) (1 2 3)) and the apply will make it become (mapcar #'list '(a b c) '(1 2 3)) which will result in ((a 1) (b 2) (c 3)). Do you see the symmetry?
Thus you could in your example you could have done this:
(apply #'(lambda (&rest n)
(cons n '(b a))) '(c))
;==> ((c) b a)
(apply #'(lambda (&rest n)
(cons n '(b a))) '(c d e))
;==> ((c d e) b a)
In this problem, I have three (identically-structured) lists. Two have all numbers and the other is filled with nil. I'm trying to replace the corresponding value in the empty list with the addition of the corresponding values from the two lists. What I have so far utilizes a loop and uses setf to replace the value.
(defun add-two-lists (list1 list2 list3)
(loop for a in list1
for b in list2
for c in list3 do
(setf c (+ a b))))
The problem is that this function is not being destructive. How do I make this function destructive?
Ok, I am aware I could use an apply to do this, but for future or tangent purposes, is there a way to use a loop to do the same thing?
I've decided to resort to my penultimate solution; use the list-length to transverse the lists.
(defun add-two-lists (list1 list2 list3)
(loop for x from 0 to (- (list-length list1) 1) do
(setf (nth x list3) (+ (nth x list1) (nth x list2))))
(values list3))
Here's one way:
(defun add-two-lists (list1 list2 list3)
(loop for a in list1
for b in list2
for c on list3 do
(rplaca c (+ a b)))
ADDENDUM
Here's another way that uses map instead of loop:
(defun add-two-lists (list1 list2 list3)
(mapl #'(lambda (cl al bl) (rplaca cl (+ (car al) (car bl))))
list3 list1 list2))
Yet another way to do the same thing without using a loop (though it's conceptually similar)
(defun add-two-lists (a b c &optional (d c))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca c (+ (car a) (car b)))) d) d))
(add-two-lists '(1 2 3 4 5) '(1 2 3 4 5) '(nil nil nil nil nil))
EDIT
(defun add-two-lists (a b c &optional (d c))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca c (+ (car a) (car b)))) d) d))
(time
(dotimes (i 1e6)
(add-two-lists '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.077 seconds of real time
;; 0.076004 seconds of total run time (0.076004 user, 0.000000 system)
;; 98.70% CPU
;; 214,723,476 processor cycles
;; 0 bytes consed
(defun add-two-lists-1 (list1 list2 list3)
(loop for a in list1
for b in list2
for c on list3 do
(rplaca c (+ a b))))
(time
(dotimes (i 1e6)
(add-two-lists-1 '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.060 seconds of real time
;; 0.060004 seconds of total run time (0.060004 user, 0.000000 system)
;; 100.00% CPU
;; 169,395,444 processor cycles
;; 0 bytes consed
EDIT 2
But notice the optimized version behavior. Possibly, again, YMMV, but this is what I get on 64-bit Debian with SBCL.
(defun add-two-lists (a b c &optional (d c))
(declare (optimize (speed 3) (safety 0)))
(declare (type list a b c d))
(if a
(add-two-lists
(cdr a) (cdr b)
(cdr (rplaca
c
(the fixnum
(+ (the fixnum (car a))
(the fixnum (car b)))))) d) d))
(time
(dotimes (i 1e6)
(add-two-lists '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.041 seconds of real time
;; 0.040002 seconds of total run time (0.040002 user, 0.000000 system)
;; 97.56% CPU
;; 114,176,175 processor cycles
;; 0 bytes consed
(defun add-two-lists-1 (list1 list2 list3)
(declare (optimize (speed 3) (safety 0)))
(loop for a fixnum in list1
for b fixnum in list2
for c cons on list3 do
(rplaca c (the fixnum (+ a b)))))
(time
(dotimes (i 1e6)
(add-two-lists-1 '(1 2 3 4 5)
'(1 2 3 4 5)
'(nil nil nil nil nil))))
;; Evaluation took:
;; 0.040 seconds of real time
;; 0.040003 seconds of total run time (0.040003 user, 0.000000 system)
;; 100.00% CPU
;; 112,032,123 processor cycles
;; 0 bytes consed
Common Lisp provides a function for that: MAP-INTO.
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.