Best shuffle

From Rosetta Code
Revision as of 13:52, 13 December 2010 by rosettacode>Dkf (→‎Tcl: Added implementation)
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) {
       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>

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)

Tcl

Library: Tcllib (Package: struct::list)

<lang tcl>package require Tcl 8.5 package require struct::list

  1. Simple metric function; assumes non-empty lists

proc count {l1 l2} {

   foreach a $l1 b $l2 {incr total [string equal $a $b]}
   return $total

}

  1. 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)