langs a-z

Task/Best-shuffle/OCaml/best-shuffle.ocaml

@@ -0,0 +1,37 @@
+let best_shuffle s =
+  let len = String.length s in
+  let r = String.copy s in
+  for i = 0 to pred len do
+    for j = 0 to pred len do
+      if i <> j && s.[i] <> r.[j] && s.[j] <> r.[i] then
+        begin
+          let tmp = r.[i] in
+          r.[i] <- r.[j];
+          r.[j] <- tmp;
+        end
+    done;
+  done;
+  (r)
+
+let count_same s1 s2 =
+  let len1 = String.length s1
+  and len2 = String.length s2 in
+  let n = ref 0 in
+  for i = 0 to pred (min len1 len2) do
+    if s1.[i] = s2.[i] then incr n
+  done;
+  !n
+
+let () =
+  let test s =
+    let s2 = best_shuffle s in
+    Printf.printf " '%s', '%s' -> %d\n" s s2 (count_same s s2);
+  in
+  test "tree";
+  test "abracadabra";
+  test "seesaw";
+  test "elk";
+  test "grrrrrr";
+  test "up";
+  test "a";
+;;

Task/Best-shuffle/PL-I/best-shuffle.pli

@@ -0,0 +1,67 @@
+shuffle: procedure options (main);                  /* 14/1/2011 */
+   declare (s, saves) character (20) varying, c character (1);
+   declare t(length(s)) bit (1);
+   declare (i, k, moves initial (0)) fixed binary;
+
+   get edit (s) (L);
+   put skip list (s);
+   saves = s;
+   t = '0'b;
+   do i = 1 to length (s);
+      if t(i) then iterate; /* This character has already been moved. */
+      c = substr(s, i, 1);
+      k = search (s, c, i+1);
+      if k > 0 then
+         do;
+            substr(s, i, 1) = substr(s, k, 1);
+            substr(s, k, 1) = c;
+            t(k), t(i) = '1'b;
+         end;
+   end;
+
+   do k = length(s) to 2 by -1;
+      if ^t(k) then /* this character wasn't moved. */
+all:     do;
+            c = substr(s, k, 1);
+            do i = k-1 to 1 by -1;
+               if c ^= substr(s, i, 1) then
+                  if substr(saves, i, 1) ^= c then
+                     do;
+                        substr(s, k, 1) = substr(s, i, 1);
+                        substr(s, i, 1) = c;
+                        t(k) = '1'b;
+                        leave all;
+                     end;
+            end;
+         end;
+   end;
+   moves = length(s) - sum(t);
+   put skip edit (s, trim(moves))(a, x(1));
+
+search: procedure (s, c, k) returns (fixed binary);
+   declare s character (*) varying;
+   declare c character (1);
+   declare k fixed binary;
+   declare i fixed binary;
+
+   do i = k to length(s);
+      if ^t(i) then if c ^= substr(s, i, 1) then return (i);
+   end;
+   return (0); /* No eligible character. */
+end search;
+
+end shuffle;
+
+OUTPUT:
+
+abracadabra
+baaracadrab 0
+
+prrrrrr
+rprrrrr 5
+
+tree
+eert 0
+
+A
+A 1

Task/Best-shuffle/Pascal/best-shuffle.pascal

@@ -0,0 +1,40 @@
+program BestShuffleDemo(output);
+
+function BestShuffle(s: string): string;
+
+  var
+    tmp: char;
+    i, j: integer;
+    t: string;
+  begin
+    t := s;
+    for i := 1 to length(t) do
+      for j := 1 to length(t) do
+        if (i <> j) and (s[i] <> t[j]) and (s[j] <> t[i]) then
+        begin
+          tmp  := t[i];
+          t[i] := t[j];
+          t[j] := tmp;
+        end;
+    BestShuffle := t;
+  end;
+
+const
+  original: array[1..6] of string =
+    ('abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a');
+
+var
+  shuffle: string;
+  i, j, score: integer;
+
+begin
+ for i := low(original) to high(original) do
+ begin
+   shuffle := BestShuffle(original[i]);
+   score := 0;
+   for j := 1 to length(shuffle) do
+     if original[i][j] = shuffle[j] then
+       inc(score);
+    writeln(original[i], ', ', shuffle, ', (', score, ')');
+  end;
+end.

Task/Best-shuffle/Perl-6/best-shuffle.pl6

@@ -0,0 +1,38 @@
+sub best-shuffle (Str $s) {
+    my @orig = $s.comb;
+
+    my @pos;
+    # Fill @pos with positions in the order that we want to fill
+    # them. (Once Rakudo has &roundrobin, this will be doable in
+    # one statement.)
+    {
+        my %pos = classify { @orig[$^i] }, keys @orig;
+        my @k = map *.key, sort *.value.elems, %pos;
+        while %pos {
+            for @k -> $letter {
+                %pos{$letter} or next;
+                push @pos, %pos{$letter}.pop;
+                %pos{$letter}.elems or %pos.delete: $letter;
+            }
+        }
+        @pos .= reverse;
+    }
+
+    my @letters = @orig;
+    my @new = Any xx $s.chars;
+    # 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.
+    while @letters {
+        my ($i, $p) = 0, shift @pos;
+        ++$i while @letters[$i] eq @orig[$p] and $i < @letters.end;
+        @new[$p] = splice @letters, $i, 1;
+    }
+
+    my $score = elems grep ?*, map * eq *, do @new Z @orig;
+
+    @new.join, $score;
+}
+
+printf "%s, %s, (%d)\n", $_, best-shuffle $_
+    for <abracadabra seesaw elk grrrrrr up a>;

Task/Best-shuffle/PowerShell/best-shuffle.psh

@@ -0,0 +1,10 @@
+function Best-Shuffle($strings){
+	foreach($string in $strings){
+		$sa1 = $string.ToCharArray()
+		$sa2 = Get-Random -InputObject $sa1 -Count ([int]::MaxValue)
+		$string = [String]::Join("",$sa2)
+		echo $string
+	}
+}
+
+Best-Shuffle "abracadabra", "seesaw", "pop", "grrrrrr", "up", "a"

Task/Best-shuffle/PureBasic/best-shuffle.purebasic

@@ -0,0 +1,110 @@
+Structure charInfo
+  Char.s
+  List Position.i()
+  count.i          ;number of occurrences of Char
+EndStructure
+
+Structure cycleInfo
+  Char.s
+  Position.i
+EndStructure
+
+Structure cycle
+  List cycle.cycleInfo()
+EndStructure
+
+Procedure.s shuffleWordLetters(word.s)
+  Protected i
+  Dim originalLetters.s(len(word) - 1)
+  For i = 1 To Len(word)
+    originalLetters(i - 1) = Mid(word, i, 1)
+  Next
+
+  Dim shuffledLetters.s(0)
+  CopyArray(originalLetters(), shuffledLetters())
+
+  ;record original letters and their positions
+  Protected curChar.s
+  NewList letters.charInfo()
+  NewMap *wordInfo.charInfo()
+  For i = 0 To ArraySize(originalLetters())
+    curChar = originalLetters(i)
+    If FindMapElement(*wordInfo(), curChar)
+      AddElement(*wordInfo()\position())
+      *wordInfo()\position() = i
+    Else
+      *wordInfo(curChar) = AddElement(letters())
+      If *wordInfo()
+        *wordInfo()\Char = curChar
+        AddElement(*wordInfo()\position())
+        *wordInfo()\position() = i
+      EndIf
+    EndIf
+  Next
+
+  ForEach letters()
+    letters()\count = ListSize(letters()\Position())
+  Next
+
+  SortStructuredList(letters(), #PB_Sort_Ascending, OffsetOf(charInfo\Char), #PB_Sort_String) ;extra sort step, not strictly necessary
+  SortStructuredList(letters(), #PB_Sort_Descending, OffsetOf(charInfo\count), #PB_Sort_integer)
+
+  ;construct letter cycles
+  FirstElement(letters())
+  Protected maxLetterCount = letters()\count
+  Dim letterCycles.cycle(maxLetterCount - 1)
+
+  Protected curCycleIndex
+  ForEach letters()
+    ForEach letters()\Position()
+      With letterCycles(curCycleIndex)
+        AddElement(\cycle())
+        \cycle()\Char = letters()\Char
+        \cycle()\Position = letters()\position()
+      EndWith
+      curCycleIndex = (curCycleIndex + 1) % maxLetterCount
+    Next
+  Next
+
+  ;rotate letters in each cycle
+  Protected isFirst, prevChar.s, pos_1
+  For i = 0 To maxLetterCount - 1
+    With letterCycles(i)
+      isFirst = #True
+      ForEach \cycle()
+        If Not isFirst
+          shuffledLetters(\cycle()\Position) = prevChar
+        Else
+          pos_1 = \cycle()\Position
+          isFirst = #False
+        EndIf
+        prevChar = \cycle()\Char
+      Next
+      shuffledLetters(pos_1) = prevChar
+    EndWith
+  Next
+
+  ;score and display shuffle
+  Protected shuffledWord.s, ignored
+  For i = 0 To ArraySize(shuffledLetters())
+    shuffledWord + shuffledLetters(i)
+    If shuffledLetters(i) = originalLetters(i)
+      ignored + 1
+    EndIf
+  Next
+
+  PrintN(word + ", " + shuffledWord + ", (" + Str(ignored) + ")")
+  ProcedureReturn shuffledWord
+EndProcedure
+
+If OpenConsole()
+  shuffleWordLetters("abracadabra")
+  shuffleWordLetters("seesaw")
+  shuffleWordLetters("elk")
+  shuffleWordLetters("grrrrrr")
+  shuffleWordLetters("up")
+  shuffleWordLetters("a")
+
+  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf

Task/Best-shuffle/Rascal/best-shuffle.rascal

@@ -0,0 +1,13 @@
+import Prelude;
+
+public tuple[str, str, int] bestShuffle(str s){
+     characters = chars(s);
+
+     ranking = {<p, countSame(p, characters)> | p <- permutations(characters)};
+     best = {<s, stringChars(p), n> | <p, n> <- ranking, n == min(range(ranking))};
+     return takeOneFrom(best)[0];
+}
+
+public int countSame(list[int] permutations, list[int] characters){
+     return (0 | it + 1 | n <- index(characters), permutations[n] == characters[n]);
+}

Task/Best-shuffle/Ursala/best-shuffle-1.ursala

@@ -0,0 +1,10 @@
+#import std
+#import nat
+
+words = <'abracadabra','seesaw','elk','grrrrrr','up','a'>
+
+shuffle = num; ^H/(*@K24) ^H\~&lS @rK2lSS *+ ^arPfarhPlzPClyPCrtPXPRalPqzyCipSLK24\~&L leql$^NS
+
+#show+
+
+main = ~&LS <.~&l,@r :/` ,' ('--+ --')'+ ~&h+ %nP+ length@plrEF>^(~&,shuffle)* words

Task/Best-shuffle/Ursala/best-shuffle-2.ursala

@@ -0,0 +1 @@
+shuffle = ~&r+ length@plrEZF$^^D/~& permutations

Task/Best-shuffle/XPL0/best-shuffle.xpl0

@@ -0,0 +1,35 @@
+include c:\cxpl\codes;  \'code' declarations
+string 0;               \use zero-terminated string convention
+
+func StrLen(A);         \Return number of characters in an ASCIIZ string
+char A;
+int  I;
+for I:= 0 to -1>>1-1 do
+        if A(I) = 0 then return I;
+
+proc Shuffle(W0);       \Display best shuffle of characters in a word
+char W0;
+char W(20), SW(20);
+int  L, I, S, SS, C, T;
+[L:= StrLen(W0);                        \word length
+for I:= 0 to L do W(I):= W0(I);         \get working copy of word (including 0)
+SS:= 20;                                \initialize best (saved) score
+for C:= 1 to 1_000_000 do               \overkill? XPL0 is fast
+        [I:= Ran(L);                    \shuffle: swap random char with end char
+        T:= W(I);  W(I):= W(L-1);  W(L-1):= T;
+        S:= 0;                          \compute score
+        for I:= 0 to L-1 do
+                if W(I) = W0(I) then S:= S+1;
+        if S < SS then
+                [SS:= S;                \save best score and best shuffle
+                for I:= 0 to L do SW(I):= W(I);
+                ];
+        ];
+Text(0, W0);  Text(0, ", ");            \show original and shuffled words, score
+Text(0, SW);  Text(0, ", (");  IntOut(0, SS);  ChOut(0, ^));  CrLf(0);
+];
+
+int S, I;
+[S:= ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"];
+for I:= 0 to 5 do Shuffle(S(I));
+]