Best shuffle

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

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

Based on Dan Bron's approach:

<lang j>bestShuf =: verb define

 yy=. (\:#&>)@:(<@I.@=) y
 y C.~ (;yy) </.~ (i.#y) |~ #>{. yy

)

fmtBest=:3 :0

 b=. bestShuf y
 y,', ',b,' (',')',~":+/b=y

) </lang>

Example:

<lang j> fmtBest&>;:'abracadabra seesaw elk grrrrrr up a' abracadabra, bdabararaac (0) seesaw, eawess (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

Scheme

<lang scheme> (define count

 (lambda (str1 str2)
   (let ((len (string-length str1)))
     (let loop ((index 0)
                (result 0))
       (if (= index len)
           result
           (loop (+ index 1)
                 (if (eq? (string-ref str1 index)
                          (string-ref str2 index))
                     (+ result 1)
                     result)))))))

(define swap

 (lambda (str index1 index2)
   (let ((mutable (string-copy str))
         (char1 (string-ref str index1))
         (char2 (string-ref str index2)))
     (string-set! mutable index1 char2)
     (string-set! mutable index2 char1)
     mutable)))

(define shift

 (lambda (str)
   (string-append (substring str 1 (string-length str))
                  (substring str 0 1))))

(define shuffle

 (lambda (str)
   (let* ((mutable (shift str))
          (len (string-length mutable))
          (max-index (- len 1)))
     (let outer ((index1 0)
                 (best mutable)
                 (best-count (count str mutable)))
       (if (or (< max-index index1)
               (= best-count 0))
           best
           (let inner ((index2 (+ index1 1))
                       (best best)
                       (best-count best-count))
             (if (= len index2)
                 (outer (+ index1 1)
                        best
                        best-count)
                 (let* ((next-mutable (swap best index1 index2))
                        (next-count (count str next-mutable)))
                   (if (= 0 next-count)
                       next-mutable
                       (if (< next-count best-count)
                           (inner (+ index2 1)
                                  next-mutable
                                  next-count)
                           (inner (+ index2 1)
                                  best
                                  best-count)))))))))))

(for-each

(lambda (str)
  (let ((shuffled (shuffle str)))
    (display
     (string-append str " " shuffled " ("
                    (number->string (count str shuffled)) ")\n"))))
'("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))

</lang>

Output:

abracadabra baacadabrar (0)
seesaw easews (0)
elk lke (0)
grrrrrr rrrrrrg (5)
up pu (0)
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)