Best shuffle

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

Works with: D version 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>

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

Library: Tcllib (Package: struct::list)

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