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.
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))
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"))