|
(let (tbl out (shortest (length str)) (s str))
(defunlabels ((perm (ar l tmpl res overlap)
(when (> overlap shortest) (return-from perm))
(when (zerop l) ; max depth of (return-from perm))
(when (zerop l) ; max depth of perm
(when (< overlap shortest)
(setf shortest overlap out '()))
(when (=setf shortest overlap shortestout '()))
(when (= overlap sqe seq)shortest) ▼
(setf res (reverse (format nil "~{~c~^~}" res)))
(push (list res overlap) out)
(return-from perm)))
(decfreturn-from lperm)))
(dolist (xdecf arl)
(dolist (x ar)
(when (plusp (cdr x))
(if (char= (car x) (char tmpl l)) (incfwhen overlap(plusp (cdr x))
(decf (cdr x)) (pushwhen (char= (car x) res(char tmpl l))
(perm ar l tmpl res (incf overlap))
(pop res) (incfdecf (cdr x))
(push (car x) res)
(if (char= (car x) (char tmpl l)) (decf overlap)))))
(perm ar l tmpl res overlap)
(loop while (plusp (lengthpop sres)) do
(let* ((c (char s 0)) (l (countincf c(cdr s)x))
(pushwhen (conschar= c(car lx) tbl(char tmpl l))
(setf s (remove c s (decf overlap))))))
(perm tbl (lengthloop str)while (reverseplusp str)(length '(s)) 0)do
(let* ((c (char s 0))
( listl (count Tc (mapcar (lambda (x ys) (equalp x y)) ▼ (push (cons c l) tbl)
(setf s (remove c s))))
(perm tbl (length str) (reverse str) '() 0))
out))
(defun best-shuffle (str)
"brilliant algorithm: list all best shuffles, then pick one"
(let ((c (all-best-shuffles str)))
(elt c (random (length c)))))
(format t "All best shuffles:")
(print (all-best-shuffles "seesaw"))
(format t "~%~%Random best shfflesshuffles:~%")
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))
(format t "~A: ~A~%" s (best-shuffle s)))</lang>output<lang>All best shuffles:
(("essewa" 0) ("essawe" 0) ("esswea" 0) ("esaews" 0) ("esawse" 0) ("esawes" 0)
("eswesa" 0) ("eswase" 0) ("eswaes" 0) ("easews" 0) ("easwse" 0) ("easwes" 0)
("eawess" 0) ("ewsesa" 0) ("ewsase" 0) ("ewsaes" 0) ("ewaess" 0) ("assewe" 0)
("asswee" 0) ("aswese" 0) ("aswees" 0) ("awsese" 0) ("awsees" 0) ("wsseea" 0)
("wssaee" 0) ("wsaese" 0) ("wsaees" 0) ("wasese" 0) ("wasees" 0))
Random best shffles:
abracadabra: (caarabbraad 0)
seesaw: (aswees 0)
elk: (lke 0)
grrrrrr: (rrrrrrg 5)
up: (pu 0)
===Alternative===
{{incorrect|Common Lisp|It does not produce best shuffles as defined by task}}
better-shuffle is based on a [http://blog.viridian-project.de/2008/04/06/sequence-shuffling-revisited/ discussion here]
<lang lisp>(defun better-shuffle (seq)
(let ((tagged (mapcar (lambda (x) (cons (random 1.0) x)) (loop for char across seq collect char))))
(coerce (mapcar 'cdr (sort tagged #'> :key 'car)) 'string)))
(defun compare-shuffle (seq sqe)
▲ (list (count T (mapcar (lambda (x y) (equalp x y))
(loop for char across seq collect char)
(loop for char across sqe collect char)))
(defun best-shuffle (seq)
(reverse (car (sort (loop repeat 10 collect
(compare-shuffle seq (better-shuffle seq))) #'< :key 'car))))))
(format t "~:{~a ~a (~d)~%~}"
(let ((input '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a")))
(map 'list 'best-shuffle input)))</lang>
Output:
abracadabra aaababarrcd (1)
| 