Best shuffle

From Rosetta Code
Task
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

D v.2 <lang d>int bestShuffle(string s) {

   int countSamePositions(T, U)(T s1, U s2, uint len) {
       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, len) > 0);
   string result = replace(to!string(ch), "-", to!string(problemChar[0]));
   int samePos = countSamePositions(s, result, len);
   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>

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)