December 21st, 2008

# String permutations using Lisp

Someone in #lisp asked about permutations the other day. I hadn’t come across them before so after looking up what they where I decided it sounded like a good programming exercise to try and find all the permutations for a given string.

Anyway, it took me a little while to figure out how to do it but once I did it wasn’t so hard, here’s the code:

```
(defun transpose (string position)
"Return string with the characters at position transposed"
(let ((before (when (> position 0)
(subseq string 0 position)))
(after (when (< (+ 1 position) (length string))
(subseq string (+ 2 position)))))
(concatenate 'string before
(subseq string (+ position 1) (+ position 2))
(subseq string position (+ position 1))
after)))
(defun permutations-helper (permutations position)
"Does the hard work for the permutations function."
(cond ((not permutations) nil)
((eql (length (car permutations)) (+ position 1)) permutations)
(t (permutations-helper
(append permutations (mapcar (lambda (x) (transpose x position)) permutations))
(+ 1 position)))))
(defun permutations (string)
"Take a string and return a list of it's permutations"
(remove-duplicates (permutations-helper (list string) 0) :test #'equal))
(permutations "population")
```

Any feedback would be great, feel free to use the code.

Cheers, Dave.

Edit: Before I re-wrote my blog there was a great comment from **Kelsar** that corrected the above code. I’ve included it below so anyone reading this has a working example to peek at and to help demonstrate what’s wrong with the above example.

There is something wrong in your program; for example:***`(member "trebor" (permutations "robert")) -> NIL`

You probably need something like “rotation” of string. This is my version (on lists, not strings, but this is the same):

`;utility function (defun mappend (fn lst) (apply #'append (mapcar fn lst))) ;rotation (defun rot (lst) `(,@(cdr lst) ,(car lst))) (defun full-rot (lst) (let ((bf (list lst))) (do ((x (rot lst) (rot x))) ((equal x lst)) (push x bf)) bf)) ;;permutations (defun permutation (lst) (if (null lst) '(()) (mappend #'(lambda (x) (full-rot (cons (car lst) x))) (permutation (cdr lst))))) (permutation '(1 2 3 4))`

greetings, kelsar

Edit 2: This old post caught my eye, the year is now 2015, and it’s been quite a while since I’ve done any Lisp! Here’s a quick version of Kelsar’s algorithm rewritten in Clojure:

```
(defn rotations [s]
(let [length (count s)]
(take length (partition length 1 (cycle s)))))
(defn permutations [s]
(if (seq s)
(mapcat #(rotations (cons (first s) %)) (permutations (rest s)))
[[]]))
(map #(apply str %) (permutations "robert"))
```