Best shuffle: Difference between revisions
Content added Content deleted
(→{{header|Common Lisp}}: DEFUN is not there to define self recursive local functions. Use LABELS.) |
|||
Line 1,014: | Line 1,014: | ||
(let (tbl out (shortest (length str)) (s str)) |
(let (tbl out (shortest (length str)) (s str)) |
||
( |
(labels ((perm (ar l tmpl res overlap) |
||
(when (> overlap shortest |
(when (> overlap shortest) |
||
(return-from perm)) |
|||
(when (zerop l) ; max depth of perm |
|||
(when (< overlap shortest) |
|||
(setf shortest overlap out '())) |
|||
(setf shortest overlap out '())) |
|||
⚫ | |||
(setf res (reverse (format nil "~{~c~^~}" res))) |
|||
(push (list res overlap) out) |
|||
(return-from perm))) |
|||
( |
(return-from perm))) |
||
(decf l) |
|||
(dolist (x ar) |
|||
(when (plusp (cdr x)) |
|||
(when (plusp (cdr x)) |
|||
(when (char= (car x) (char tmpl l)) |
|||
(incf overlap)) |
|||
(decf (cdr x)) |
|||
(push (car x) res) |
|||
(if (char= (car x) (char tmpl l)) (decf overlap))))) |
|||
(perm ar l tmpl res overlap) |
|||
(pop res) |
|||
(incf (cdr x)) |
|||
(when (char= (car x) (char tmpl l)) |
|||
(decf overlap)))))) |
|||
(loop while (plusp (length s)) do |
|||
(let* ((c (char s 0)) |
|||
⚫ | |||
(push (cons c l) tbl) |
|||
(setf s (remove c s)))) |
|||
(perm tbl (length str) (reverse str) '() 0)) |
|||
out)) |
out)) |
||
(defun best-shuffle (str) |
(defun best-shuffle (str) |
||
"brilliant algorithm: list all best shuffles, then pick one" |
"brilliant algorithm: list all best shuffles, then pick one" |
||
(let ((c (all-best-shuffles str))) |
(let ((c (all-best-shuffles str))) |
||
(elt c (random (length c))))) |
(elt c (random (length c))))) |
||
(format t "All best shuffles:") |
(format t "All best shuffles:") |
||
(print (all-best-shuffles "seesaw")) |
(print (all-best-shuffles "seesaw")) |
||
(format t "~%~%Random best |
(format t "~%~%Random best shuffles:~%") |
||
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a")) |
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a")) |
||
(format t "~A: ~A~%" s (best-shuffle s))) |
(format t "~A: ~A~%" s (best-shuffle s))) |
||
(("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) |
|||
⚫ | |||
(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: |
Output: |
||
abracadabra aaababarrcd (1) |
abracadabra aaababarrcd (1) |