new files

Task/Best-shuffle/0DESCRIPTION

@@ -0,0 +1,11 @@
+Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible. Print the result as follows: original string, shuffled string, (score). The score gives the number of positions whose character value did ''not'' change.
+
+For example: <code>tree, eetr, (0)</code>
+
+A shuffle that produces a randomized result among the best choices is to be preferred. A deterministic approach that produces the same sequence every time is acceptable as an alternative.
+
+The words to test with are: <code>abracadabra</code>, <code>seesaw</code>, <code>elk</code>, <code>grrrrrr</code>, <code>up</code>, <code>a</code>
+
+;Cf.
+* [[Anagrams/Deranged anagrams]]
+* [[Permutations/Derangements]]

Task/Best-shuffle/AWK/best-shuffle-1.awk

@@ -0,0 +1,40 @@
+{
+	scram = best_shuffle($0)
+	print $0 " -> " scram " (" unchanged($0, scram) ")"
+}
+
+function best_shuffle(s,    c, i, j, len, r, t) {
+	len = split(s, t, "")
+
+	# Swap elements of t[] to get a best shuffle.
+	for (i = 1; i <= len; i++) {
+		for (j = 1; j <= len; j++) {
+			# Swap t[i] and t[j] if they will not match
+			# the original characters from s.
+			if (i != j &&
+			    t[i] != substr(s, j, 1) &&
+			    substr(s, i, 1) != t[j]) {
+				c = t[i]
+				t[i] = t[j]
+				t[j] = c
+				break
+			}
+		}
+	}
+
+	# Join t[] into one string.
+	r = ""
+	for (i = 1; i <= len; i++)
+		r = r t[i]
+	return r
+}
+
+function unchanged(s1, s2,    count, len) {
+	count = 0
+	len = length(s1)
+	for (i = 1; i <= len; i++) {
+		if (substr(s1, i, 1) == substr(s2, i, 1))
+			count++
+	}
+	return count
+}

Task/Best-shuffle/AWK/best-shuffle-2.awk

@@ -0,0 +1,79 @@
+# out["string"] = best shuffle of string _s_
+# out["score"] = number of matching characters
+function best_shuffle(out, s,    c, i, j, k, klen, p, pos, set, rlen, slen) {
+	slen = length(s)
+	for (i = 1; i <= slen; i++) {
+		c = substr(s, i, 1)
+
+		# _set_ of all characters in _s_, with count
+		set[c] += 1
+
+		# _pos_ classifies positions by letter,
+		# such that pos[c, 1], pos[c, 2], ..., pos[c, set[c]]
+		# are the positions of _c_ in _s_.
+		pos[c, set[c]] = i
+	}
+
+	# k[1], k[2], ..., k[klen] sorts letters from low to high count
+	klen = 0
+	for (c in set) {
+		# insert _c_ into _k_
+		i = 1
+		while (i <= klen && set[k[i]] <= set[c])
+			i++              # find _i_ to sort by insertion
+		for (j = klen; j >= i; j--)
+			k[j + 1] = k[j]  # make room for k[i]
+		k[i] = c
+		klen++
+	}
+
+	# Fill pos[slen], ..., pos[3], pos[2], pos[1] with positions
+	# in the order that we want to fill them.
+	i = 1
+	while (i <= slen) {
+		for (j = 1; j <= klen; j++) {
+			c = k[j]
+			if (set[c] > 0) {
+				pos[i] = pos[c, set[c]]
+				i++
+				delete pos[c, set[c]]
+				set[c]--
+			}				
+		}
+	}
+
+	# Now fill in _new_ with _letters_ according to each position
+	# in pos[slen], ..., pos[1], but skip ahead in _letters_
+	# if we can avoid matching characters that way.
+	rlen = split(s, letters, "")
+	for (i = slen; i >= 1; i--) {
+		j = 1
+		p = pos[i]
+		while (letters[j] == substr(s, p, 1) && j < rlen)
+			j++
+		for (new[p] = letters[j]; j < rlen; j++)
+			letters[j] = letters[j + 1]
+		delete letters[rlen]
+		rlen--
+	}
+
+	out["string"] = ""
+	for (i = 1; i <= slen; i++) {
+		out["string"] = out["string"] new[i]
+	}
+
+	out["score"] = 0
+	for (i = 1; i <= slen; i++) {
+		if (new[i] == substr(s, i, 1))
+			out["score"]++
+	}
+}
+
+BEGIN {
+	count = split("abracadabra seesaw elk grrrrrr up a", words)
+	for (i = 1; i <= count; i++) {
+		best_shuffle(result, words[i])
+		printf "%s, %s, (%d)\n",
+		    words[i], result["string"], result["score"]
+	}
+}

Task/Best-shuffle/AWK/best-shuffle-3.awk

@@ -0,0 +1,7 @@
+$ awk -f best-shuffle.awk
+abracadabra, baarrcadaab, (0)
+seesaw, essewa, (0)
+elk, kel, (0)
+grrrrrr, rgrrrrr, (5)
+up, pu, (0)
+a, a, (1)

Task/Best-shuffle/Ada/best-shuffle.ada

@@ -0,0 +1,42 @@
+with Ada.Text_IO;
+
+procedure Best_Shuffle is
+
+   function Best_Shuffle(S: String) return String is
+      T: String(S'Range) := S;
+      Tmp: Character;
+   begin
+      for I in S'Range loop
+         for J in S'Range loop
+            if I /= J and S(I) /= T(J) and S(J) /= T(I) then
+               Tmp  := T(I);
+               T(I) := T(J);
+               T(J) := Tmp;
+            end if;
+         end loop;
+      end loop;
+      return T;
+   end Best_Shuffle;
+
+   Stop : Boolean := False;
+
+begin -- main procedure
+   while not Stop loop
+      declare
+         Original: String := Ada.Text_IO.Get_Line;
+         Shuffle: String  := Best_Shuffle(Original);
+         Score: Natural := 0;
+      begin
+         for I in Original'Range loop
+            if Original(I) = Shuffle(I) then
+            Score := Score + 1;
+            end if;
+         end loop;
+         Ada.Text_Io.Put_Line(Original & ", " & Shuffle & ", (" &
+                                Natural'Image(Score) & " )");
+         if Original = "" then
+            Stop := True;
+         end if;
+      end;
+   end loop;
+end Best_Shuffle;

Task/Best-shuffle/C/best-shuffle-1.c

@@ -0,0 +1,111 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+#define DEBUG
+
+void best_shuffle(const char* txt, char* result) {
+    const size_t len = strlen(txt);
+    if (len == 0)
+        return;
+
+#ifdef DEBUG
+    // txt and result must have the same length
+    assert(len == strlen(result));
+#endif
+
+    // how many of each character?
+    size_t counts[UCHAR_MAX];
+    memset(counts, '\0', UCHAR_MAX * sizeof(int));
+    size_t fmax = 0;
+    for (size_t i = 0; i < len; i++) {
+        counts[(unsigned char)txt[i]]++;
+        const size_t fnew = counts[(unsigned char)txt[i]];
+        if (fmax < fnew)
+             fmax = fnew;
+    }
+    assert(fmax > 0 && fmax <= len);
+
+    // all character positions, grouped by character
+    size_t *ndx1 = malloc(len * sizeof(size_t));
+    if (ndx1 == NULL)
+        exit(EXIT_FAILURE);
+    for (size_t ch = 0, i = 0; ch < UCHAR_MAX; ch++)
+       if (counts[ch])
+            for (size_t j = 0; j < len; j++)
+                if (ch == (unsigned char)txt[j]) {
+                    ndx1[i] = j;
+                    i++;
+                }
+
+    // regroup them for cycles
+    size_t *ndx2 = malloc(len * sizeof(size_t));
+    if (ndx2 == NULL)
+        exit(EXIT_FAILURE);
+    for (size_t i = 0, n = 0, m = 0; i < len; i++) {
+        ndx2[i] = ndx1[n];
+        n += fmax;
+        if (n >= len) {
+            m++;
+            n = m;
+        }
+    }
+
+    // how long can our cyclic groups be?
+    const size_t grp = 1 + (len - 1) / fmax;
+    assert(grp > 0 && grp <= len);
+
+    // how many of them are full length?
+    const size_t lng = 1 + (len - 1) % fmax;
+    assert(lng > 0 && lng <= len);
+
+    // rotate each group
+    for (size_t i = 0, j = 0; i < fmax; i++) {
+        const size_t first = ndx2[j];
+        const size_t glen = grp - (i < lng ? 0 : 1);
+        for (size_t k = 1; k < glen; k++)
+            ndx1[j + k - 1] = ndx2[j + k];
+        ndx1[j + glen - 1] = first;
+        j += glen;
+    }
+
+    // result is original permuted according to our cyclic groups
+    result[len] = '\0';
+    for (size_t i = 0; i < len; i++)
+        result[ndx2[i]] = txt[ndx1[i]];
+
+    free(ndx1);
+    free(ndx2);
+}
+
+void display(const char* txt1, const char* txt2) {
+    const size_t len = strlen(txt1);
+    assert(len == strlen(txt2));
+    int score = 0;
+    for (size_t i = 0; i < len; i++)
+        if (txt1[i] == txt2[i])
+            score++;
+    (void)printf("%s, %s, (%u)\n", txt1, txt2, score);
+}
+
+int main() {
+    const char* data[] = {"abracadabra", "seesaw", "elk", "grrrrrr",
+                          "up", "a", "aabbbbaa", "", "xxxxx"};
+    const size_t data_len = sizeof(data) / sizeof(data[0]);
+    for (size_t i = 0; i < data_len; i++) {
+        const size_t shuf_len = strlen(data[i]) + 1;
+        char shuf[shuf_len];
+
+#ifdef DEBUG
+        memset(shuf, 0xFF, sizeof shuf);
+        shuf[shuf_len - 1] = '\0';
+#endif
+
+        best_shuffle(data[i], shuf);
+        display(data[i], shuf);
+    }
+
+    return EXIT_SUCCESS;
+}

Task/Best-shuffle/C/best-shuffle-2.c

@@ -0,0 +1,106 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+typedef struct letter_group_t {
+	char c;
+	int count;
+} *letter_p;
+
+struct letter_group_t all_letters[26];
+letter_p letters[26];
+
+/* counts how many of each letter is in a string, used later
+ * to generate permutations
+ */
+int count_letters(const char *s)
+{
+	int i, c;
+	for (i = 0; i < 26; i++) {
+		all_letters[i].count = 0;
+		all_letters[i].c = i + 'a';
+	}
+	while (*s != '\0') {
+		i = *(s++);
+
+		/* don't want to deal with bad inputs */
+		if (i < 'a' || i > 'z') {
+			fprintf(stderr, "Abort: Bad string %s\n", s);
+			exit(1);
+		}
+
+		all_letters[i - 'a'].count++;
+	}
+	for (i = 0, c = 0; i < 26; i++)
+		if (all_letters[i].count)
+			letters[c++] = all_letters + i;
+
+	return c;
+}
+
+int least_overlap, seq_no;
+char out[100], orig[100], best[100];
+
+void permutate(int n_letters, int pos, int overlap)
+{
+	int i, ol;
+	if (pos < 0) {
+                /* if enabled will show all shuffles no worse than current best */
+	//	printf("%s: %d\n", out, overlap);
+
+                /* if better than current best, replace it and reset counter */
+		if (overlap < least_overlap) {
+			least_overlap = overlap;
+			seq_no = 0;
+		}
+
+                /* the Nth best tie has 1/N chance of being kept, so all ties
+                 * have equal chance of being selected even though we don't
+                 * how many there are before hand
+                 */
+		if ( (double)rand() / (RAND_MAX + 1.0) * ++seq_no <= 1)
+			strcpy(best, out);
+
+		return;
+	}
+
+        /* standard "try take the letter; try take not" recursive method */
+	for (i = 0; i < n_letters; i++) {
+		if (!letters[i]->count) continue;
+
+		out[pos] = letters[i]->c;
+		letters[i]->count --;
+		ol = (letters[i]->c == orig[pos]) ? overlap + 1 : overlap;
+
+                /* but don't try options that's already worse than current best */
+		if (ol <= least_overlap)
+			permutate(n_letters, pos - 1, ol);
+
+		letters[i]->count ++;
+	}
+	return;
+}
+
+void do_string(const char *str)
+{
+	least_overlap = strlen(str);
+	strcpy(orig, str);
+
+	seq_no = 0;
+	out[least_overlap] = '\0';
+	least_overlap ++;
+
+	permutate(count_letters(str), least_overlap - 2, 0);
+	printf("%s -> %s, overlap %d\n", str, best, least_overlap);
+}
+
+int main()
+{
+	srand(time(0));
+	do_string("abracadebra");
+	do_string("grrrrrr");
+	do_string("elk");
+	do_string("seesaw");
+	do_string("");
+	return 0;
+}

Task/Best-shuffle/C/best-shuffle-3.c

@@ -0,0 +1,5 @@
+abracadebra -> edbcarabaar, overlap 0
+grrrrrr -> rrgrrrr, overlap 5
+elk -> kel, overlap 0
+seesaw -> ewsesa, overlap 0
+ -> , overlap 0

Task/Best-shuffle/C/best-shuffle-4.c

@@ -0,0 +1,36 @@
+#include <stdio.h>
+#include <string.h>
+
+#define FOR(x, y) for(x = 0; x < y; x++)
+char *best_shuffle(const char *s, int *diff)
+{
+	int i, j = 0, max = 0, l = strlen(s), cnt[128] = {0};
+	char buf[256] = {0}, *r;
+
+	FOR(i, l) if (++cnt[(int)s[i]] > max) max = cnt[(int)s[i]];
+	FOR(i, 128) while (cnt[i]--) buf[j++] = i;
+
+	r = strdup(s);
+	FOR(i, l) FOR(j, l)
+		if (r[i] == buf[j]) {
+			r[i] = buf[(j + max) % l] & ~128;
+			buf[j] |= 128;
+			break;
+		}
+
+	*diff = 0;
+	FOR(i, l) *diff += r[i] == s[i];
+
+	return r;
+}
+
+int main()
+{
+	int i, d;
+	const char *r, *t[] = {"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a", 0};
+	for (i = 0; t[i]; i++) {
+		r = best_shuffle(t[i], &d);
+		printf("%s %s (%d)\n", t[i], r, d);
+	}
+	return 0;
+}

Task/Best-shuffle/Clojure/best-shuffle.clj

@@ -0,0 +1,54 @@
+(defn score [before after]
+   (->> (map = before after)
+	(filter true? ,)
+	count))
+
+(defn merge-vecs [init vecs]
+  (reduce (fn [counts [index x]]
+		 (assoc counts x (conj (get counts x []) index)))
+	  init vecs))
+
+(defn frequency
+  "Returns a collection of indecies of distinct items"
+  [coll]
+  (->> (map-indexed vector coll)
+       (merge-vecs {} ,)))
+
+(defn group-indecies [s]
+  (->> (frequency s)
+       vals
+       (sort-by count ,)
+       reverse))
+
+(defn cycles [coll]
+  (let [n (count (first coll))
+	cycle (cycle (range n))
+	coll (apply concat coll)]
+    (->> (map vector coll cycle)
+	 (merge-vecs [] ,))))
+
+(defn rotate [n coll]
+  (let [c (count coll)
+	n (rem (+ c n) c)]
+    (concat (drop n coll) (take n coll))))
+
+(defn best-shuffle [s]
+  (let [ref (cycles (group-indecies s))
+	prm (apply concat (map (partial rotate 1) ref))
+	ref (apply concat ref)]
+    (->> (map vector ref prm)
+	 (sort-by first ,)
+	 (map second ,)
+	 (map (partial get s) ,)
+	 (apply str ,)
+	 (#(vector s % (score s %))))))
+
+user> (->> ["abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"]
+	   (map best-shuffle ,)
+	   vec)
+[["abracadabra" "bdabararaac" 0]
+ ["seesaw" "eawess" 0]
+ ["elk" "lke" 0]
+ ["grrrrrr" "rgrrrrr" 5]
+ ["up" "pu" 0]
+ ["a" "a" 1]]

Task/Best-shuffle/Go/best-shuffle.go

@@ -0,0 +1,37 @@
+package main
+
+import (
+    "fmt"
+    "math/rand"
+    "time"
+)
+
+var ts = []string{"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"}
+
+func main() {
+    rand.Seed(time.Now().UnixNano())
+    for _, s := range ts {
+        // create shuffled byte array of original string
+        t := make([]byte, len(s))
+        for i, r := range rand.Perm(len(s)) {
+            t[i] = s[r]
+        }
+        // algorithm of Icon solution
+        for i := 0; i < len(s); i++ {
+            for j := 0; j < len(s); j++ {
+                if i != j && t[i] != s[j] && t[j] != s[i] {
+                    t[i], t[j] = t[j], t[i]
+                    break
+                }
+            }
+        }
+        // count unchanged and output
+        var count int
+        for i, ic := range t {
+            if ic == s[i] {
+                count++
+            }
+        }
+        fmt.Printf("%s -> %s (%d)\n", s, string(t), count)
+    }
+}

Task/Best-shuffle/Haskell/best-shuffle-1.hs

@@ -0,0 +1,33 @@
+import Data.Function (on)
+import Data.List
+import Data.Maybe
+import Data.Array
+import Text.Printf
+
+main = mapM_ f examples
+  where examples = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]
+        f s = printf "%s, %s, (%d)\n" s s' $ score s s'
+          where s' = bestShuffle s
+
+score :: Eq a => [a] -> [a] -> Int
+score old new = length $ filter id $ zipWith (==) old new
+
+bestShuffle :: (Ord a, Eq a) => [a] -> [a]
+bestShuffle s = elems $ array bs $ f positions letters
+  where positions =
+            concat $ sortBy (compare `on` length) $
+            map (map fst) $ groupBy ((==) `on` snd) $
+            sortBy (compare `on` snd) $ zip [0..] s
+        letters = map (orig !) positions
+
+        f [] [] = []
+        f (p : ps) ls = (p, ls !! i) : f ps (removeAt i ls)
+          where i = fromMaybe 0 $ findIndex (/= o) ls
+                o = orig ! p
+
+        orig = listArray bs s
+        bs = (0, length s - 1)
+
+removeAt :: Int -> [a] -> [a]
+removeAt 0 (x : xs) = xs
+removeAt i (x : xs) = x : removeAt (i - 1) xs

Task/Best-shuffle/Haskell/best-shuffle-2.hs

@@ -0,0 +1,2 @@
+bestShuffle :: Eq a => [a] -> [a]
+bestShuffle s = minimumBy (compare `on` score s) $ permutations s

Task/Best-shuffle/Java/best-shuffle.java

@@ -0,0 +1,36 @@
+import java.util.*;
+
+public class BestShuffle {
+
+    public static void main(String[] args) {
+        String[] words = {"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"};
+        for (String w : words)
+            System.out.println(bestShuffle(w));
+    }
+
+    public static String bestShuffle(final String s1) {
+        char[] s2 = s1.toCharArray();
+        Collections.shuffle(Arrays.asList(s2));
+        for (int i = 0; i < s2.length; i++) {
+            if (s2[i] != s1.charAt(i))
+                continue;
+            for (int j = 0; j < s2.length; j++) {
+                if (s2[i] != s2[j] && s2[i] != s1.charAt(j) && s2[j] != s1.charAt(i)) {
+                    char tmp = s2[i];
+                    s2[i] = s2[j];
+                    s2[j] = tmp;
+                    break;
+                }
+            }
+        }
+        return s1 + " " + new String(s2) + " (" + count(s1, s2) + ")";
+    }
+
+    private static int count(final String s1, final char[] s2) {
+        int count = 0;
+        for (int i = 0; i < s2.length; i++)
+            if (s1.charAt(i) == s2[i])
+                count++;
+        return count;
+    }
+}

Task/Best-shuffle/JavaScript/best-shuffle-1.js

@@ -0,0 +1,47 @@
+function raze(a) { // like .join('') except producing an array instead of a string
+    var r= [];
+    for (var j= 0; j<a.length; j++)
+        for (var k= 0; k<a[j].length; k++)  r.push(a[j][k]);
+    return r;
+}
+function shuffle(y) {
+    var len= y.length;
+    for (var j= 0; j < len; j++) {
+        var i= Math.floor(Math.random()*len);
+        var t= y[i];
+        y[i]= y[j];
+        y[j]= t;
+    }
+    return y;
+}
+function bestShuf(txt) {
+    var chs= txt.split('');
+    var gr= {};
+    var mx= 0;
+    for (var j= 0; j<chs.length; j++) {
+        var ch= chs[j];
+        if (null == gr[ch])  gr[ch]= [];
+        gr[ch].push(j);
+        if (mx < gr[ch].length)  mx++;
+    }
+    var inds= [];
+    for (var ch in gr)  inds.push(shuffle(gr[ch]));
+    var ndx= raze(inds);
+    var cycles= [];
+    for (var k= 0; k < mx; k++)  cycles[k]= [];
+    for (var j= 0; j<chs.length; j++)  cycles[j%mx].push(ndx[j]);
+    var ref= raze(cycles);
+    for (var k= 0; k < mx; k++)  cycles[k].push(cycles[k].shift());
+    var prm= raze(cycles);
+    var shf= [];
+    for (var j= 0; j<chs.length; j++)  shf[ref[j]]= chs[prm[j]];
+    return shf.join('');
+}
+
+function disp(ex) {
+    var r= bestShuf(ex);
+    var n= 0;
+    for (var j= 0; j<ex.length; j++)
+        n+= ex.substr(j, 1) == r.substr(j,1) ?1 :0;
+    return ex+', '+r+', ('+n+')';
+}

Task/Best-shuffle/JavaScript/best-shuffle-2.js

@@ -0,0 +1,7 @@
+<html><head><title></title></head><body><pre id="out"></pre></body></html>
+<script type="text/javascript">
+/* ABOVE CODE GOES HERE */
+var sample= ['abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a']
+for (var i= 0; i<sample.length; i++)
+	document.getElementById('out').innerHTML+= disp(sample[i])+'\r\n';
+</script>

Task/Best-shuffle/JavaScript/best-shuffle-3.js

@@ -0,0 +1,6 @@
+abracadabra, raababacdar, (0)
+seesaw, ewaess, (0)
+elk, lke, (0)
+grrrrrr, rrrrrgr, (5)
+up, pu, (0)
+a, a, (1)

Task/Best-shuffle/PHP/best-shuffle.php

@@ -0,0 +1,25 @@
+foreach (split(' ', 'abracadabra seesaw pop grrrrrr up a') as $w)
+    echo bestShuffle($w) . '<br>';
+
+function bestShuffle($s1) {
+    $s2 = str_shuffle($s1);
+    for ($i = 0; $i < strlen($s2); $i++) {
+        if ($s2[$i] != $s1[$i]) continue;
+        for ($j = 0; $j < strlen($s2); $j++)
+            if ($i != $j && $s2[$i] != $s1[$j] && $s2[$j] != $s1[$i]) {
+                $t = $s2[$i];
+                $s2[$i] = $s2[$j];
+                $s2[$j] = $t;
+                break;
+            }
+    }
+    return "$s1 $s2 " . countSame($s1, $s2);
+}
+
+function countSame($s1, $s2) {
+    $cnt = 0;
+    for ($i = 0; $i < strlen($s2); $i++)
+        if ($s1[$i] == $s2[$i])
+            $cnt++;
+    return "($cnt)";
+}

Task/Best-shuffle/Perl/best-shuffle.pl

@@ -0,0 +1,38 @@
+use strict;
+use Algorithm::Permute;
+
+foreach ("abracadabra", "seesaw", "elk", "grrrrrr", "up", "a") {
+    best_shuffle($_);
+}
+
+sub score {
+    my ($original_word,$new_word) = @_;
+    my $result = 0;
+    for (my $i = 0 ; $i < length($original_word) ; $i++) {
+        if (substr($original_word,$i,1) eq substr($new_word,$i,1)) {
+            $result++;
+        }
+    }
+    return $result;
+}
+
+sub best_shuffle {
+    my ($original_word) = @_;
+    my $best_word = $original_word;
+    my $best_score = length($original_word);
+    my @array = split(//,$original_word);
+
+    # The below was adapted from perlfaq4
+
+    my $p_iterator = Algorithm::Permute->new( \@array );
+
+    while (my @array = $p_iterator->next) {
+        if (score($original_word,join("",@array))<$best_score) {
+            $best_score = score($original_word, join("",@array));
+            $best_word = join ("",@array);
+        }
+        last if ($best_score == 0);
+    }
+
+    print "$original_word, $best_word, $best_score\n";
+}

Task/Best-shuffle/PicoLisp/best-shuffle.l

@@ -0,0 +1,14 @@
+(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) ")") ) ) )

Task/Best-shuffle/Prolog/best-shuffle.pro

@@ -0,0 +1,74 @@
+:- dynamic score/2.
+
+best_shuffle :-
+	maplist(best_shuffle, ["abracadabra", "eesaw", "elk", "grrrrrr",
+			       	"up", "a"]).
+
+best_shuffle(Str) :-
+	retractall(score(_,_)),
+	length(Str, Len),
+	assert(score(Str, Len)),
+	calcule_min(Str, Len, Min),
+	repeat,
+	   shuffle(Str, Shuffled),
+	   maplist(comp, Str, Shuffled, Result),
+	   sumlist(Result, V),
+	   retract(score(Cur, VCur)),
+	   (  V < VCur -> assert(score(Shuffled, V)); assert(score(Cur, VCur))),
+	   V = Min,
+	retract(score(Cur, VCur)),
+	writef('%s : %s (%d)\n', [Str, Cur, VCur]).
+
+comp(C, C1, S):-
+	(   C = C1 -> S = 1; S = 0).
+
+% this code was written by P.Caboche and can be found here :
+% http://pcaboche.developpez.com/article/prolog/listes/?page=page_3#Lshuffle
+shuffle(List, Shuffled) :-
+  length(List, Len),
+  shuffle(Len, List, Shuffled).
+
+shuffle(0, [], []) :- !.
+
+shuffle(Len, List, [Elem|Tail]) :-
+  RandInd is random(Len),
+  nth0(RandInd, List, Elem),
+  select(Elem, List, Rest),
+  NewLen is Len - 1,
+  shuffle(NewLen, Rest, Tail).
+
+
+% letters are sorted out then packed
+% If a letter is more numerous than the rest
+% the min is the difference between the quantity of this letter and
+% the sum of the quantity of the other letters
+calcule_min(Str, Len, Min) :-
+	msort(Str, SS),
+	packList(SS, Lst),
+	sort(Lst, Lst1),
+	last(Lst1, [N, _]),
+	(   N * 2 > Len -> Min is 2 * N - Len; Min = 0).
+
+
+
+% almost the same code as in "run_length" page
+packList([],[]).
+
+packList([X],[[1,X]]) :- !.
+
+
+packList([X|Rest],[XRun|Packed]):-
+    run(X,Rest, XRun,RRest),
+    packList(RRest,Packed).
+
+
+run(Var,[],[1,Var],[]).
+
+run(Var,[Var|LRest],[N1, Var],RRest):-
+    run(Var,LRest,[N, Var],RRest),
+    N > 0,
+    N1 is N + 1.
+
+
+run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
+     dif(Var,Other).

Task/Best-shuffle/Python/best-shuffle-1.py

@@ -0,0 +1,28 @@
+from collections import Counter
+import random
+
+def count(w1,wnew):
+    return sum(c1==c2 for c1,c2 in zip(w1, wnew))
+
+def best_shuffle(w):
+    wnew = list(w)
+    n = len(w)
+    rangelists = (list(range(n)), list(range(n)))
+    for r in rangelists:
+        random.shuffle(r)
+    rangei, rangej = rangelists
+    for i in rangei:
+        for j in rangej:
+            if i != j and wnew[j] != wnew[i] and w[i] != wnew[j] and w[j] != wnew[i]:
+                wnew[j], wnew[i] = wnew[i], wnew[j]
+    wnew = ''.join(wnew)
+    return wnew, count(w, wnew)
+
+
+if __name__ == '__main__':
+    test_words = ('tree abracadabra seesaw elk grrrrrr up a '
+                  + 'antidisestablishmentarianism hounddogs').split()
+    test_words += ['aardvarks are ant eaters', 'immediately', 'abba']
+    for w in test_words:
+        wnew, c = best_shuffle(w)
+        print("%29s, %-29s ,(%i)" % (w, wnew, c))

Task/Best-shuffle/Python/best-shuffle-2.py

@@ -0,0 +1,50 @@
+#!/usr/bin/env python
+
+def best_shuffle(s):
+    # Count the supply of characters.
+    from collections import defaultdict
+    count = defaultdict(int)
+    for c in s:
+        count[c] += 1
+
+    # Shuffle the characters.
+    r = []
+    for x in s:
+        # Find the best character to replace x.
+        best = None
+        rankb = -2
+        for c, rankc in count.items():
+            # Prefer characters with more supply.
+            # (Save characters with less supply.)
+            # Avoid identical characters.
+            if c == x: rankc = -1
+            if rankc > rankb:
+                best = c
+                rankb = rankc
+
+        # Add character to list. Remove it from supply.
+        r.append(best)
+        count[best] -= 1
+        if count[best] == 0: del count[best]
+
+    # If the final letter became stuck (as "ababcd" became "bacabd",
+    # and the final "d" became stuck), then fix it.
+    i = len(s) - 1
+    if r[i] == s[i]:
+        for j in range(i):
+            if r[i] != s[j] and r[j] != s[i]:
+                r[i], r[j] = r[j], r[i]
+                break
+
+    # Convert list to string. PEP 8, "Style Guide for Python Code",
+    # suggests that ''.join() is faster than + when concatenating
+    # many strings. See http://www.python.org/dev/peps/pep-0008/
+    r = ''.join(r)
+
+    score = sum(x == y for x, y in zip(r, s))
+
+    return (r, score)
+
+for s in "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a":
+    shuffled, score = best_shuffle(s)
+    print("%s, %s, (%d)" % (s, shuffled, score))

Task/Best-shuffle/REXX/best-shuffle-1.rexx

@@ -0,0 +1,42 @@
+/*REXX program to find the best shuffle  (for a character string).      */
+parse arg list                         /*get words from the command line*/
+if list='' then list='tree abracadabra seesaw elk grrrrrr up a'  /*def.?*/
+w=0                                    /*widest word , for prettifing.  */
+        do i=1  for words(list)
+        w=max(w,length(word(list,i)))  /*the maximum word width so far. */
+        end   /*i*/
+w=w+5                                  /*add five spaces to widest word.*/
+        do n=1  for words(list)        /*process the words in the list. */
+        $=word(list,n)                 /*the original word in the list. */
+        new=bestShuffle($)             /*shufflized version of the word.*/
+        say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)
+        end   /*n*/
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────BESTSHUFFLE subroutine──────────────*/
+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    /*j*/
+
+           do k=1  for Lx              /*take care of same o'-same o's. */
+           a=substr(x, k,1)
+           b=substr(ox,k,1);   if a\==b then iterate
+           if k==Lx then x=left(x,k-2)a || substr(x,k-1,1)   /*last case*/
+                    else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2)
+           end   /*k*/
+return x
+/*──────────────────────────────────KSAME procedure─────────────────────*/
+kSame: procedure;    parse arg x,y;    k=0
+                  do m=1  for min(length(x),length(y))
+                  k=k + (substr(x,m,1) == substr(y,m,1))
+                  end   /*m*/
+return k

Task/Best-shuffle/REXX/best-shuffle-2.rexx

@@ -0,0 +1,37 @@
+def best_shuffle(s)
+  # Fill _pos_ with positions in the order
+  # that we want to fill them.
+  pos = []
+  # g["a"] = [2, 4] implies that s[2] == s[4] == "a"
+  g = (0...s.length).group_by { |i| s[i] }
+
+  # k sorts letters from low to high count
+  k = g.sort_by { |k, v| v.length }.map! { |k, v| k }
+
+  until g.empty?
+    k.each { |letter|
+      g[letter] or next
+      pos.push(g[letter].pop)
+      g[letter].empty? and g.delete letter
+    }
+  end
+  pos.reverse!
+
+  # Now fill in _new_ with _letters_ according to each position
+  # in _pos_, but skip ahead in _letters_ if we can avoid
+  # matching characters that way.
+  letters = s.dup
+  new = "?" * s.length
+  until letters.empty?
+    i, p = 0, pos.shift
+    i += 1 while letters[i] == s[p] and i < (letters.length - 1)
+    new[p] = letters.slice! i
+  end
+
+  score = new.chars.zip(s.chars).count { |c, d| c == d }
+  [new, score]
+end
+
+%w(abracadabra seesaw elk grrrrrr up a).each { |word|
+  printf "%s, %s, (%d)\n", word, *best_shuffle(word)
+}

Task/Best-shuffle/REXX/best-shuffle-3.rexx

@@ -0,0 +1,25 @@
+list$ = "abracadabra seesaw pop grrrrrr up a"
+
+while word$(list$,ii + 1," ") <> ""
+ ii    = ii + 1
+ w$    = word$(list$,ii," ")
+ bs$   = bestShuffle$(w$)
+ count = 0
+ for i = 1 to len(w$)
+  if mid$(w$,i,1) = mid$(bs$,i,1) then count = count + 1
+ next i
+ print  w$;" ";bs$;" ";count
+wend
+
+function bestShuffle$(s1$)
+   s2$   = s1$
+   for i = 1 to len(s2$)
+        for j =  1 to len(s2$)
+            if (i <> j) and (mid$(s2$,i,1) <> mid$(s1$,j,1)) and (mid$(s2$,j,1) <> mid$(s1$,i,1)) then
+            if j < i then i1 = j:j1 = i else i1 = i:j1 = j
+            s2$ = left$(s2$,i1-1) + mid$(s2$,j1,1) + mid$(s2$,i1+1,(j1-i1)-1) + mid$(s2$,i1,1) + mid$(s2$,j1+1)
+            end if
+        next j
+   next i
+bestShuffle$ = s2$
+end function

Task/Best-shuffle/Racket/best-shuffle.rkt

@@ -0,0 +1,20 @@
+#lang racket
+
+(define (best-shuffle s)
+  (define len (string-length s))
+  (define @ string-ref)
+  (define r (list->string (shuffle (string->list s))))
+  (for* ([i (in-range len)] [j (in-range len)])
+    (when (not (or (= i j) (eq? (@ s i) (@ r j)) (eq? (@ s j) (@ r i))))
+      (define t (@ r i))
+      (string-set! r i (@ r j))
+      (string-set! r j t)))
+  r)
+
+(define (count-same s1 s2)
+  (for/sum ([c1 (in-string s1)] [c2 (in-string s2)])
+    (if (eq? c1 c2) 1 0)))
+
+(for ([s (in-list '("tree" "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))])
+  (define sh (best-shuffle s))
+  (printf " ~a, ~a, (~a)\n" s sh (count-same s sh)))

Task/Best-shuffle/Scheme/best-shuffle.ss

@@ -0,0 +1,65 @@
+(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"))

Task/Best-shuffle/Tcl/best-shuffle-1.tcl

@@ -0,0 +1,21 @@
+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)"
+}

Task/Best-shuffle/Tcl/best-shuffle-2.tcl

@@ -0,0 +1,3 @@
+foreach sample {abracadabra seesaw elk grrrrrr up a} {
+    puts [bestshuffle $sample]
+}