Best shuffle: Difference between revisions

(defun perm (ar l tmpl res overlap)

(when (> overlap shortest) (return-from perm))

(when (zerop l) ; max depth of perm

(when (< overlap shortest)

(setf shortest overlap out '()))

(when (= overlap shortest)

(setf res (reverse (format nil "~{~c~^~}" res)))

(push (list res overlap) out)

(return-from perm)))

(decf l)

(dolist (x ar)

(when (plusp (cdr x))

(if (char= (car x) (char tmpl l)) (incf overlap))

(decf (cdr x)) (push (car x) res)

(perm ar l tmpl res overlap)

(pop res) (incf (cdr x))

(if (char= (car x) (char tmpl l)) (decf overlap)))))

(loop while (plusp (length s)) do

(let* ((c (char s 0)) (l (count c s)))

(push (cons c l) tbl)

(setf s (remove c s))))

(perm tbl (length str) (reverse str) '() 0)

(format t "~%~%Random best shffles:~%")

(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)

a: (a 1)</lang>

===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)))

sqe seq))

(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>