translate list comprehension into Common Lisp loop - common-lisp

I have very recently started learning lisp. Like many others, I am trying my hand at Project Euler problems, however I am a bit stuck at Problem 14 : Longest Collatz Sequence.
This is what I have so far:
(defun collatz (x)
(if (evenp x)
(/ x 2)
(+ (* x 3) 1)))
(defun collatz-sequence (x)
(let ((count 1))
(loop
(setq x (collatz x))
(incf count)
(when (= x 1)
(return count)))))
(defun result ()
(loop for i from 1 to 1000000 maximize (collatz-sequence i)))
This will correctly print the longest sequence (525) but not the number producing the longest sequence.
What I want is
result = maximum [ (collatz-sequence n, n) | n <- [1..999999]]
translated into Common Lisp if possible.

With some help from macros and using iterate library, which allows you to extend its loop-like macro, you could do something like the below:
(defun collatz (x)
(if (evenp x) (floor x 2) (1+ (* x 3))))
(defun collatz-path (x)
(1+ (iter:iter (iter:counting (setq x (collatz x))) (iter:until (= x 1)))))
(defmacro maximizing-for (maximized-expression into (cause result))
(assert (eq 'into into) (into) "~S must be a symbol" into)
`(progn
(iter:with ,result = 0)
(iter:reducing ,maximized-expression by
(lambda (so-far candidate)
(if (> candidate so-far)
(progn (setf ,result i) candidate) so-far)) into ,cause)))
(defun euler-14 ()
(iter:iter
(iter:for i from 1000000 downto 1)
(maximizing-for (collatz-path i) into (path result))
(iter:finally (return (values result path)))))
(Presented without claim of generality. :))

The LOOP variant is not that pretty:
(defun collatz-sequence (x)
(1+ (loop for x1 = (collatz x) then (collatz x1)
count 1
until (= x1 1))))
(defun result ()
(loop with max-i = 0 and max-x = 0
for i from 1 to 1000000
for x = (collatz-sequence i)
when (> x max-x)
do (setf max-i i max-x x)
finally (return (values max-i max-x))))

A late answer but a 'pretty' one, albeit a losing one:
(defun collatz-sequence (x)
(labels ((collatz (x)
(if (evenp x)
(/ x 2)
(+ (* 3 x) 1))))
(recurse scan ((i x) (len 1) (peak 1) (seq '(1)))
(if (= i 1)
(values len peak (reverse seq))
(scan (collatz i) (+ len 1) (max i peak) (cons i seq))))))
(defun collatz-check (n)
(recurse look ((i 1) (li 1) (llen 1))
(if (> i n)
(values li llen)
(multiple-value-bind (len peak seq)
(collatz-sequence i)
(if (> len llen)
(look (+ i 1) i len)
(look (+ i 1) li llen))))))
(defmacro recurse (name args &rest body)
`(labels ((,name ,(mapcar #'car args) ,#body))
(,name ,#(mapcar #'cadr args))))

Related

How to make recursion using only lambdas in Racket?

I need some help trying to figure out how to make the code below recursive using only lambdas.
(define (mklist2 bind pure args)
(define (helper bnd pr ttl lst)
(cond [(empty? lst) (pure ttl)]
[else (define (func t) (helper bnd pr (append ttl (list t)) (rest lst)))
(bind (first lst) func)])
)
(helper bind pure empty args))
Given a sample factorial program -
(define fact
(lambda (n)
(if (= n 0)
1
(* n (fact (- n 1)))))) ;; goal: remove reference to `fact`
(print (fact 7)) ; 5040
Above fact is (lambda (n) ...) and when we call fact we are asking for this lambda so we can reapply it with new arguments. lambda are nameless and if we cannot use top-level define bindings, the only way to bind a variable is using a lambda's parameter. Imagine something like -
(lambda (r)
; ...lambda body...
; call (r ...) to recur this lambda
)
We just need something to make our (lambda (r) ...) behave this way -
(something (lambda (r)
(print 1)
(r)))
; 1
; 1
; 1
; ... forever
introducing U
This something is quite close to the U combinator -
(define u
(lambda (f) (f f)))
(define fact
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1))))))) ;; replace fact with (r r)
(print ((u fact) 7))
; => 5040
And now that recursion is happening thru use of a parameter, we could effectively remove all define bindings and write it using only lambda -
; ((u fact) 7)
(print (((lambda (f) (f f)) ; u
(lambda (r) ; fact
(lambda (n)
(if (= n 0)
1
(* n ((r r) (- n 1)))))))
7))
; => 5040
Why U when you can Y?
The U-combinator is simple but having to call ((r r) ...) inside the function is cumbersome. It'd be nice if you could call (r ...) to recur directly. This is exactly what the Y-combinator does -
(define y
(lambda (f)
(f (lambda (x) ((y f) x))))) ;; pass (y f) to user lambda
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1))))))) ;; recur directly
(print ((y fact) 7))
; => 5040
But see how y has a by-name recursive definition? We can use u to remove the by-name reference and recur using a lambda parameter instead. The same as we did above -
(define u
(lambda (f) (f f)))
(define y
(lambda (r) ;; wrap in (lambda (r) ...)
(lambda (f)
(f (lambda (x) (((r r) f) x)))))) ;; replace y with (r r)
(define fact
(lambda (recur)
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
(print (((u y) fact) 7)) ;; replace y with (u y)
; => 5040
We can write it now using only lambda -
; (((u y) fact) 7)
(print ((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (recur) ; fact
(lambda (n)
(if (= n 0)
1
(* n (recur (- n 1)))))))
7))
; => 5040
need more parameters?
By using currying, we can expand our functions to support more parameters, if needed -
(define range
(lambda (r)
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
(define map
(lambda (r)
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(define nums
((((u y) range) 3) 9))
(define squares
((((u y) map) (lambda (x) (* x x))) nums))
(print squares)
; '(9 16 25 36 49 64 81)
And as a single lambda expression -
; ((((u y) map) (lambda (x) (* x x))) ((((u y) range) 3) 9))
(print (((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; map
(lambda (f)
(lambda (l)
(if (null? l)
null
(cons (f (car l))
((r f) (cdr l))))))))
(lambda (x) (* x x))) ; square
(((((lambda (f) (f f)) ; u
(lambda (r) ; y
(lambda (f)
(f (lambda (x) (((r r) f) x))))))
(lambda (r) ; range
(lambda (start)
(lambda (end)
(if (> start end)
null
(cons start ((r (add1 start)) end)))))))
3) ; start
9))) ; end
; => '(9 16 25 36 49 64 81)
lazY
Check out these cool implementations of y using lazy
#lang lazy
(define y
(lambda (f)
(f (y f))))
#lang lazy
(define y
((lambda (f) (f f)) ; u
(lambda (r)
(lambda (f)
(f ((r r) f))))))
#lang lazy
(define y
((lambda (r)
(lambda (f)
(f ((r r) f))))
(lambda (r)
(lambda (f)
(f ((r r) f))))))
In response to #alinsoar's answer, I just wanted to show that Typed Racket's type system can express the Y combinator, if you put the proper type annotations using Rec types.
The U combinator requires a Rec type for its argument:
(: u (All (a) (-> (Rec F (-> F a)) a)))
(define u
(lambda (f) (f f)))
The Y combinator itself doesn't need a Rec in its type:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
However, the definition of the Y combinator requires a Rec type annotation on one of the functions used within it:
(: y (All (a b) (-> (-> (-> a b) (-> a b)) (-> a b))))
(define y
(lambda (f)
(u (lambda ([g : (Rec G (-> G (-> a b)))])
(f (lambda (x) ((g g) x)))))))
Recursion using only lambdas can be done using fixed point combinators, the simplest one being Ω.
However, take into account that such a combinator has a type of infinite length, so if you program with types, the type is recursive and has infinite length. Not every type checker is able to compute the type for recursive types. The type checker of Racket I think it's Hindley-Miller and I remember typed racket it's not able to run fixed point combinators, but not sure. You have to disable the type checker for this to work.

Sum of multiples of 3 & 5 using LISP

(defun modsum2 (n)
(let ((summ 0))
(if (>= n 3)
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ))))
I am trying to get the sum of multiples of 3 and 5 below the given number. But the code always returns to 0. What is the problem with it?
(defun modsum2 (n)
(let ((summ 0))
(if (>= n 3)
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ))))
Right, now you got it indented. Let's trace it:
* (trace modsum2)
(MODSUM2)
* (modsum2 4)
0: (MODSUM2 4)
1: (MODSUM2 3)
2: (MODSUM2 2)
0 2: MODSUM2 returned 0
1: MODSUM2 returned 0
0: MODSUM2 returned 0
0
You can see that 0 gets printed when the argument to n is 2. Since the print form is also the last form, the function returns its value. (print 0) returns 0. Since the return value is in your function used, it just gets returned from each recursive call.
A typical way to repair it would be to have a local recursive function using labels inside the let. You then need to call the function. Later you would need to return the summ.
;; your function has some flaws
(defun modsum2 (n)
(let ((summ 0)) ;; in every call, `summ` is put to `0`!
(if (>= n 3) ;; for n = 2, the alternative `(print summ)` is executed
(if (or (zerop (mod n 3)) (zerop (mod n 5)))
(progn (setq summ (+ n summ))
(modsum2 (1- n)))
(modsum2 (1- n)))
(print summ)))) ;; for n = 2 already this is called
;; since summ is set to `0` for this last modsum2 call, it prints 0
;; tail call recursion with inner function
(defun modsum2 (n)
(let ((summ 0))
(labels ((.modsum2 (.n)
(cond ((zerop .n) summ)
((or (zerop (mod .n 3)) (zerop (mod .n 5)))
(setq summ (+ .n summ))
(.modsum2 (1- .n)))
(t (.modsum2 (1- .n))))))
(print (.modsum2 n)))))
;; tail call recursion with optional accumulator for the proper start
(defun modsum2 (n &optional (acc 0))
(cond ((zerop n) acc)
((or (zerop (mod n 3))
(zerop (mod n 5)))
(modsum2 (1- n) (+ acc n)))
(t (modsum2 (1- n) acc))))
;; using loop
(defun modsum2 (n)
(loop for x from 1 to n
when (or (zerop (mod x 3)) (zerop (mod x 5)))
sum x into res
finally (return res)))
;; which is equivalent to (thanks #Rainer Joswig):
(defun modsum2 (n)
(loop for x from 1 to n
when (or (zerop (mod x 3)) (zerop (mod x 5)))
sum x))
;; using reduce or apply
(defun modsum2 (n)
(reduce #'+ (remove-if-not #'(lambda (x) (or (zerop (mod x 3))
(zerop (mod x 5))))
(loop for x from 1 to n))))
;; instead of `reduce`, `apply` would work, too.
You’re doing far too much work. Just do inclusion-exclusion:
(defun modsum2 (max)
(let ((a (floor max 3))
(b (floor max 5))
(c (floor max 15)))
(/ (- (+ (* 3 a (1+ a))
(* 5 b (1+ b)))
(* 15 c (1+ c)))
2)))
To extend this a bit to more than just 3,5:
(defun multsum (k max)
"The sum of multiples of `k' below `max'"
(let ((a (floor max k)))
(* k a (1+ a))))
(defun subsequences-reduce (f items)
(unless items (return ()))
(loop for (item . rest) on items
collect (cons 1 item)
nconc (loop for (len . val) in (subsequences-reduce f rest)
collect (cons (1+ len) (funcall f item val)))))
(defun modsum (max &rest nums)
(loop for (len . lcm) in (subsequences-reduce #'lcm nums)
sum (* (if (oddp len) 1 -1) (multsum lcm max))))
(defun modsum2 (max) (modsum max 3 5))
I have solved the same problem last week for project euler. I have noticed the way I wrote it does not included in answers. Dropping it here, it might be useful.
;;finds the multiple of 3's and 5's below the number n
;;since "or" turns t, whenever one of its arguments returns t. No need to substract multiple of 15.
(defun modsum2 (n)
(cond ((< n 3) 0)
(t (do ((i 3 (1+ i))
(summ 0))
((> i n) summ)
(cond ((or (zerop (mod i 3))
(zerop (mod i 5)))
(setq summ (+ summ i))))))))

Lisp: labels or separate global functions?

This is what my wason-deck produces:
((15 . D) (35 . H) (3 . B) (19 . K) (L . 15) (A . 16) (T . 23) (R . 53)
(N . 13) (M . 7) (I . 52) (35 . Q) (S . 19) (Y . 29) (45 . G) (44 . W)
(11 . V) (J . 25) (21 . F) (39 . Z) (25 . X) (50 . E) (5 . P) (33 . C)
(O . 34))
this being a list of pairs representing a Wason deck. (See this, Example 6). In the deck there should be all the letters of the alphabet matched with even or odd numbers depending on whether a vowel or consonant respectively. I randomly shuffle and flip the cards as you can see. Then I (optionally) randomly pollute the deck by occasionally breaking the vowel:even, consonant:odd rule. Here's the code I've come up with:
(defun wason-deck (&optional (p 0))
"This `consolst` and `vowlist` building is unnecessary, but a good exercise"
(let* ((alphab '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(consonents '(b c d f g h j k l m n p q r s t v w x y z))
(consolst (remove 'NIL (mapcar (lambda (x) (find x consonents)) alphab)))
(vowlst (remove 'NIL (mapcar (lambda (x) (find x '(a e i o))) alphab)))
(wdeck '()))
(labels ((make-consodeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (evenp num)
(1+ num)
num)))) consolst))
(make-voweldeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (oddp num)
(1+ num)
num)))) vowlst))
(swap (slst el1 el2)
(let ((tmp (elt slst el1)))
(setf (elt slst el1) (elt slst el2))
(setf (elt slst el2) tmp)))
(shuffle (slst)
(loop for i in (reverse (range (length slst) :min 1))
do (let ((j (random (+ i 1))))
(swap slst i j)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append (make-consodeck) (make-voweldeck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck)))))
It works, but what I fear is not really knowing what I'm doing, i.e., I've misused labels as well as done a setf in the code. If some of the more senior people could tell me whether this is totally off in the wrong direction or not.
Addendum:
This is what I've got after the suggestions from below:
(defun wason-deck3 (&optional (p 0))
(let* ((consonents '(b c d f g h j k l m n p q r s t v w x y z))
(vowels '(a e i o u))
(conso-deck (mapcar (lambda (x)
(cons x (1+ (* 2 (random 27)))))
consonents))
(vowel-deck (mapcar (lambda (x)
(cons x (* 2 (random 27))))
vowels))
(wdeck '()))
(labels
((shuffle (slst)
(loop :for i :from (1- (length slst)) :downto 1
:do (rotatef (nth i slst)
(nth (random (1+ i)) slst)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append conso-deck vowel-deck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck))))
Please add any new suggestions.
Using labels is totally OK, and your code is not entirely unreasonable.
A few pointers:
I'd represent characters as characters: '(#\a #\b #\c …)
I'd take my list exercises elsewhere, or at least use set-difference.
When you create a function for just one call, you might as well just save the result:
(let ((consonant-deck (mapcar (lambda (c)
(cons c (1+ (* 2 (random 27)))))
consonants))
(vowel-deck (mapcar (lambda (c)
(cons c (* 2 (random 27))))
vowels)))
…)
For swapping, there is rotatef: (rotatef (nth i list) (nth j list)). Such things are rather expensive on lists, so I'd prefer to use a vector for this. Then it comes in handy that a string is just a vector of characters…
Loop can do counting for you, you don't need to create lists:
(loop :for i :from (1- (length list)) :downto 1
:do (rotatef (nth i list)
(nth (random (1+ i)) list)))
(Using keywords as loop keywords is optional, but indentation should be like this.)
If you put the labels around the let, you can immediately bind wdeck, so that you do not need to setf it afterwards.
You do not need this function for the exercise that you linked to.

DrRacket and Recursive Statement Binary to Decimal

I am trying to convert a binary number entered as "1010" for 10 using recursion. I can't seem to wrap my head around the syntax for getting this to work.
(define (mod N M)
(modulo N M))
(define (binaryToDecimal b)
(let ([s 0])
(helper b s)))
(define (helper b s)
(if (= b 0)
(begin (+ s 0))
(begin (* + (mod b 2) (expt 2 s) helper((/ b 10) + s 1)))))
Thanks!
Here's a simple recursive solution:
(define (bin->dec n)
(if (zero? n)
n
(+ (modulo n 10) (* 2 (bin->dec (quotient n 10))))))
testing:
> (bin->dec 1010)
10
> (bin->dec 101)
5
> (bin->dec 10000)
16
If you want "1010" to translate to 10 (or #b1010, #o12 or #xa) you implement string->number
(define (string->number str radix)
(let loop ((acc 0) (n (string->list str)))
(if (null? n)
acc
(loop (+ (* acc radix)
(let ((a (car n)))
(- (char->integer a)
(cond ((char<=? a #\9) 48) ; [#\0-#\9] => [0-9]
((char<? a #\a) 55) ; [#\A-#\Z] => [10-36]
(else 87))))) ; [#\a-#\z] => [10-36]
(cdr n)))))
(eqv? #xAAF (string->number "aAf" 16)) ; ==> #t
It processes the highest number first and everytime a new digit is processed it multiplies the accumulated value with radix and add the new "ones" until there are not more chars. If you enter "1010" and 2 the accumulated value from beginning to end is 0, 0*2+1, 1*2+0, 2*2+1, 5*2+0 which eventually would make sure the digits numbered from right to left 0..n becomes Sum(vn*radic^n)
Now, if you need a procedure that only does base 2, then make a wrapper:
(define (binstr->number n)
(string->number n 2))
(eqv? (binstr->number "1010") #b1010) ; ==> #t

how to merge two strings ordered alphabetically, using recursion

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.

Resources