Best shuffle
You are encouraged to solve this task according to the task description, using any language you may know.
Shuffle the characters of a string in such a way that as many of the characters are in a different position as possible. Print the result as follows: original string, shuffled string, (num characters ignored)
For example: tree, eetr, (0)
The words to test with are: abracadabra
, seesaw
, elk
, grrrrrr
, up
, a
D
<lang d>int bestShuffle(string s) {
int countSamePositions(T, U)(T s1, U s2) { return count!("a[0] == a[1] && a[0] != b")(zip(s1, s2), '-'); }
const len = s.length; if (len == 0) { throw new Exception("input string cannot have zero length"); }
char[] ch = s.dup.sort;
auto problemChar = sort!("a[1] > b[1]")(array(group(ch)))[0]; if ((problemChar[1] - len / 2) > 0) { int numToRemove = problemChar[1] - (len - problemChar[1]); for (int i, j; i < len && j < numToRemove; i++) { if (ch[i] == problemChar[0]) { ch[i] = '-'; j++; } } }
do { for (int i = len; i > 1; i--) { swap(ch[i-1], ch[uniform(0, i)]); } } while(countSamePositions(s, ch) > 0);
string result = replace(to!string(ch), "-", to!string(problemChar[0])); int samePos = countSamePositions(s, result);
writefln("%s %s (%s)", s, result, samePos);
return samePos;
}</lang>
output:
abracadabra baadacbraar (0) seesaw easwes (0) elk lke (0) grrrrrr rrrrrgr (5) up pu (0) a a (1)
<lang d>unittest {
assert(bestShuffle("abracadabra") == 0); assert(bestShuffle("seesaw") == 0); assert(bestShuffle("elk") == 0); assert(bestShuffle("grrrrrr") == 5); assert(bestShuffle("up") == 0); assert(bestShuffle("a") == 1);
}</lang>
J
Brute force approach:
<lang j>bestShuf=:3 :0
target=. 0 >. ({. - +/@}.) \:~ #/.~y n=._1 [ lim=.!#y while.lim > n=.n+1 do. r=.n A. y if.target=+/r=y do.return.end. end.
)
fmtBest=:3 :0
b=. bestShuf y y,', ',b,' (',')',~":+/b=y
) </lang>
Example:
<lang j> fmtBest&>;:'abracadabra seesaw elk grrrrrr up a' abracadabra, baaracadrab (0) seesaw, essewa (0) elk, lke (0) grrrrrr, rgrrrrr (5) up, pu (0) a, a (1) </lang>
PicoLisp
<lang PicoLisp>(de bestShuffle (Str)
(let Lst NIL (for C (setq Str (chop Str)) (if (assoc C Lst) (con @ (cons C (cdr @))) (push 'Lst (cons C)) ) ) (setq Lst (apply conc (flip (by length sort Lst)))) (let Res (mapcar '((C) (prog1 (or (find <> Lst (circ C)) C) (setq Lst (delete @ Lst)) ) ) Str ) (prinl Str " " Res " (" (cnt = Str Res) ")") ) ) )</lang>
Output:
: (bestShuffle "abracadabra") abracadabra raarababadc (0) : (bestShuffle "seesaw") seesaw essewa (0) : (bestShuffle "elk") elk lke (0) : (bestShuffle "grrrrrr") grrrrrr rgrrrrr (5) : (bestShuffle "up") up pu (0) : (bestShuffle "a") a a (1)
REXX
<lang rexx> /*REXX program to find best shuffle (of a character string). */
list='tree abracadabra seesaw elk grrrrrr up a'
/*find width of the longest word (prettify output).*/
L=0; do k=1 for words(list); L=max(L,length(word(list,k))); end; L=L+5
do j=1 for words(list) /*process the words in the list. */ $=word(list,j) /*the original word in the list. */ new=bestShuffle($) /*shufflized version of the word.*/ say 'original:' left($,L) 'new:' left(new,L) 'count:' countSame($,new) end
exit
/*─────────────────────────────────────bestShuffle procedure────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
if Lx<3 then return reverse(x) /*fast track these puppies. */
do j=1 for Lx-1 /*first take care of replications*/ a=substr(x,j ,1) b=substr(x,j+1,1) if a\==b then iterate _=verify(x,a); if _==0 then iterate /*switch 1st rep with some char. */ y=substr(x,_,1); x=overlay(a,x,_); x=overlay(y,x,j) rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/ y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd rep with later char.*/ x=overlay(a,x,_); x=overlay(y,x,j+1) /*OVERLAYs: a fast way to swap*/ end
do j=1 for Lx /*take care of same o'-same o's. */ a=substr(x, j,1) b=substr(ox,j,1) if a\==b then iterate if j==Lx then x=left(x,j-2)a||substr(x,j-1,1) /*spec case of last*/ else x=left(x,j-1)substr(x,j+1,1)a || substr(x,j+2) end
return x
/*─────────────────────────────────────countSame procedure──────────────*/
countSame: procedure; parse arg x,y; k=0
do j=1 for min(length(x),length(y)) k=k+(substr(x,j,1)==substr(y,j,1)) end
return k </lang> Output (with a freebie thrown in):
original: tree new: eert count: 0 original: abracadabra new: baaracadrab count: 0 original: seesaw new: eswase count: 0 original: elk new: lke count: 0 original: grrrrrr new: rrrrrrg count: 5 original: up new: pu count: 0 original: a new: a count: 1
Tcl
<lang tcl>package require Tcl 8.5 package require struct::list
- Simple metric function; assumes non-empty lists
proc count {l1 l2} {
foreach a $l1 b $l2 {incr total [string equal $a $b]} return $total
}
- Find the best shuffling of the string
proc bestshuffle {str} {
set origin [split $str ""] set best $origin set score [llength $origin] struct::list foreachperm p $origin {
if {$score > [set score [tcl::mathfunc::min $score [count $origin $p]]]} { set best $p }
} set best [join $best ""] return "$str,$best,($score)"
}</lang> Demonstration: <lang tcl>foreach sample {abracadabra seesaw elk grrrrrr up a} {
puts [bestshuffle $sample]
}</lang> Output:
abracadabra,baabacadrar,(0) seesaw,assewe,(0) elk,kel,(0) grrrrrr,rgrrrrr,(5) up,pu,(0) a,a,(1)