⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
{{task}}
;Task: Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible.
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.
Display the result as follows:
original string, shuffled string, (score)
The score gives the number of positions whose character value did ''not'' change.
;Example: tree, eetr, (0)
;Test cases: abracadabra seesaw elk grrrrrr up a
;Related tasks
- [[Anagrams/Deranged anagrams]]
- [[Permutations/Derangements]]
Ada
{{trans|AWK}}
with Ada.Text_IO;
with Ada.Strings.Unbounded;
procedure Best_Shuffle is
function Best_Shuffle (S : String) return String;
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;
Test_Cases : constant array (1 .. 6)
of Ada.Strings.Unbounded.Unbounded_String :=
(Ada.Strings.Unbounded.To_Unbounded_String ("abracadabra"),
Ada.Strings.Unbounded.To_Unbounded_String ("seesaw"),
Ada.Strings.Unbounded.To_Unbounded_String ("elk"),
Ada.Strings.Unbounded.To_Unbounded_String ("grrrrrr"),
Ada.Strings.Unbounded.To_Unbounded_String ("up"),
Ada.Strings.Unbounded.To_Unbounded_String ("a"));
begin -- main procedure
for Test_Case in Test_Cases'Range loop
declare
Original : constant String := Ada.Strings.Unbounded.To_String
(Test_Cases (Test_Case));
Shuffle : constant 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) & " )");
end;
end loop;
end Best_Shuffle;
Output:
abracadabra, caadrbabaar, ( 0 )
seesaw, ewaess, ( 0 )
elk, kel, ( 0 )
grrrrrr, rgrrrrr, ( 5 )
up, pu, ( 0 )
a, a, ( 1 )
AutoHotkey
words := "abracadabra,seesaw,elk,grrrrrr,up,a"
Loop Parse, Words,`,
out .= Score(A_LoopField, Shuffle(A_LoopField))
MsgBox % clipboard := out
Shuffle(String)
{
Cord := String
Length := StrLen(String)
CharType := A_IsUnicode ? "UShort" : "UChar"
Loop, Parse, String ; For each old character in String...
{
Char1 := SubStr(Cord, A_Index, 1)
If (Char1 <> A_LoopField) ; If new character already differs,
Continue ; do nothing.
Index1 := A_Index
OldChar1 := A_LoopField
Random, Index2, 1, Length ; Starting at some random index,
Loop, %Length% ; for each index...
{
If (Index1 <> Index2) ; Swap requires two different indexes.
{
Char2 := SubStr(Cord, Index2, 1)
OldChar2 := SubStr(String, Index2, 1)
; If after the swap, the two new characters would differ from
; the two old characters, then do the swap.
If (Char1 <> OldChar2) and (Char2 <> OldChar1)
{
; Swap Char1 and Char2 inside Cord.
NumPut(Asc(Char1), Cord, (Index2 - 1) << !!A_IsUnicode, CharType)
NumPut(Asc(Char2), Cord, (Index1 - 1) << !!A_IsUnicode, CharType)
Break
}
}
Index2 += 1 ; Get next index.
If (Index2 > Length) ; If after last index,
Index2 := 1 ; use first index.
}
}
Return Cord
}
Score(a, b){
r := 0
Loop Parse, a
If (A_LoopField = SubStr(b, A_Index, 1))
r++
return a ", " b ", (" r ")`n"
}
Output:
abracadabra, caadarrbaab, (0)
seesaw, easews, (0)
elk, kel, (0)
grrrrrr, rrrrrrg, (5)
up, pu, (0)
a, a, (1)
AWK
{{trans|Icon}} The Icon and Unicon program uses a simple algorithm of swapping. This is relatively easy to translate to Awk.
{
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
}
This program has the same output as the Icon and Unicon program.
{{trans|Perl 6}} The Perl 6 program (and the equivalent Ruby program) use several built-in array functions. Awk provides no array functions, except for split(). This Awk program, a translation from Perl 6, uses its own code
- to sort an array,
- to insert an element into the middle of an array,
- to remove an element from the middle of an array (and close the gap),
- to pop an element from the end of an array, and
- to join the elements of an array into a string.
If those built-in array functions seem strange to you, and if you can understand these for loops, then you might prefer this Awk program. This algorithm counts the letters in the string, sorts the positions, and fills the positions in order.
# 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"]
}
}
Output:
$ awk -f best-shuffle.awk
abracadabra, baarrcadaab, (0)
seesaw, essewa, (0)
elk, kel, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
The output might change if the for (c in set) loop iterates the array in a different order.
BBC BASIC
{{works with|BBC BASIC for Windows}}
a$ = "abracadabra" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "seesaw" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "elk" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "grrrrrr" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "up" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
a$ = "a" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
END
DEF FNshuffle(s$)
LOCAL i%, j%, l%, s%, t%, t$
t$ = s$ : s% = !^s$ : t% = !^t$ : l% = LEN(t$)
FOR i% = 0 TO l%-1 : SWAP t%?i%,t%?(RND(l%)-1) : NEXT
FOR i% = 0 TO l%-1
FOR j% = 0 TO l%-1
IF i%<>j% THEN
IF t%?i%<>s%?j% IF s%?i%<>t%?j% THEN
SWAP t%?i%,t%?j%
EXIT FOR
ENDIF
ENDIF
NEXT
NEXT i%
= t$
DEF FNsame(s$, t$)
LOCAL i%, n%
FOR i% = 1 TO LEN(s$)
IF MID$(s$,i%,1)=MID$(t$,i%,1) n% += 1
NEXT
= " (" + STR$(n%) + ")"
Output (varies between runs):
abracadabra -> daaracababr (0)
seesaw -> essewa (0)
elk -> lke (0)
grrrrrr -> rgrrrrr (5)
up -> pu (0)
a -> a (1)
Bracmat
Not optimized:
( shuffle
= m car cdr todo a z count string
. !arg:(@(?:%?car ?cdr).?todo)
& !Count:?count
& ( @( !todo
: ?a
(%@:~!car:?m)
( ?z
& shuffle$(!cdr.str$(!a !z))
: (<!count:?count.?string)
& ~
)
)
| !count:<!Count
| @(!todo:%?m ?z)
& shuffle$(!cdr.!z):(?count.?string)
& !count+1
. !m !string
)
| (0.)
)
& abracadabra seesaw elk grrrrrr up a:?words
& whl
' ( !words:%?word ?words
& @(!word:? [?Count)
& out$(!word shuffle$(!word.!word))
)
& Done
Optimized (~100 x faster):
( shuffle
= m car cdr todo a z count M string tried
. !arg:(@(?:%?car ?cdr).?todo)
& !Count:?count
& :?tried
& ( @( !todo
: ?a
( %@?M
& ~(!tried:? !M ?)
& !M !tried:?tried
& !M:~!car
)
( ?z
& shuffle$(!cdr.str$(!a !z))
: (<!count:?count.?string)
& !M:?m
& ~
)
)
| !count:<!Count
| @(!todo:%?m ?z)
& shuffle$(!cdr.!z):(?count.?string)
& !count+1
. !m !string
)
| (0.)
)
& abracadabra seesaw elk grrrrrr up a:?words
& whl
' ( !words:%?word ?words
& @(!word:? [?Count)
& out$(!word shuffle$(!word.!word))
)
& Done
Output:
abracadabra (0.b a a r a c a d r a b)
seesaw (0.e s s e w a)
elk (0.l k e)
grrrrrr (5.r g r r r r r)
up (0.p u)
a (1.a)
{!} Done
C
This approach is totally deterministic, and is based on the final J implementation from the talk page.
In essence: we form cyclic groups of character indices where each cyclic group is guaranteed to represent each character only once (two instances of the letter 'a' must have their indices in separate groups), and then we rotate each of the cyclic groups. We then use the before/after version of these cycles to shuffle the original text. The only way a character can be repeated, here, is when a cyclic group contains only one character index, and this can only happen when more than half of the text uses that character. This is C99 code.
#include <iostream>
#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;
}
Output:
abracadabra, brabacadaar, (0)
seesaw, wssaee, (0)
elk, kel, (0)
grrrrrr, rrrrrrg, (5)
up, pu, (0)
a, a, (1)
aabbbbaa, bbaaaabb, (0)
, , (0)
xxxxx, xxxxx, (5)
Version with random result
#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;
}
Output
### Deterministic method
```c
#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;
}
C++
{{works with|C++|11}} {{trans|Java}}
#include <iostream>
#include <sstream>
#include <algorithm>
using namespace std;
template <class S>
class BestShuffle {
public:
BestShuffle() : rd(), g(rd()) {}
S operator()(const S& s1) {
S s2 = s1;
shuffle(s2.begin(), s2.end(), g);
for (unsigned i = 0; i < s2.length(); i++)
if (s2[i] == s1[i])
for (unsigned j = 0; j < s2.length(); j++)
if (s2[i] != s2[j] && s2[i] != s1[j] && s2[j] != s1[i]) {
swap(s2[i], s2[j]);
break;
}
ostringstream os;
os << s1 << endl << s2 << " [" << count(s2, s1) << ']';
return os.str();
}
private:
static int count(const S& s1, const S& s2) {
auto count = 0;
for (unsigned i = 0; i < s1.length(); i++)
if (s1[i] == s2[i])
count++;
return count;
}
random_device rd;
mt19937 g;
};
int main(int argc, char* arguments[]) {
BestShuffle<basic_string<char>> bs;
for (auto i = 1; i < argc; i++)
cout << bs(basic_string<char>(arguments[i])) << endl;
return 0;
}
{{out}}
abracadabra
raabadabcar (0)
seesaw
wssaee (0)
grrrrrr
rgrrrrr (5)
pop
opp (1)
up
pu (0)
a
a (1)
C#
For both solutions, a class is used to encapsulate the original string and to scrambling. A private function of the class does the actual sorting. An implicit conversion from string is also provided to allow for simple initialization, e.g.:
ShuffledString[] array = {"cat", "dog", "mouse"};
Which will immediately shuffle each word.
A sequential solution, which always produces the same output for the same input.
using System;
using System.Text;
using System.Collections.Generic;
namespace BestShuffle_RC
{
public class ShuffledString
{
private string original;
private StringBuilder shuffled;
private int ignoredChars;
public string Original
{
get { return original; }
}
public string Shuffled
{
get { return shuffled.ToString(); }
}
public int Ignored
{
get { return ignoredChars; }
}
private void Swap(int pos1, int pos2)
{
char temp = shuffled[pos1];
shuffled[pos1] = shuffled[pos2];
shuffled[pos2] = temp;
}
//Determine if a swap between these two would put a letter in a "bad" place
//If true, a swap is OK.
private bool TrySwap(int pos1, int pos2)
{
if (original[pos1] == shuffled[pos2] || original[pos2] == shuffled[pos1])
return false;
else
return true;
}
//Constructor carries out calls Shuffle function.
public ShuffledString(string word)
{
original = word;
shuffled = new StringBuilder(word);
Shuffle();
DetectIgnores();
}
//Does the hard work of shuffling the string.
private void Shuffle()
{
int length = original.Length;
int swaps;
Random rand = new Random();
List<int> used = new List<int>();
for (int i = 0; i < length; i++)
{
swaps = 0;
while(used.Count <= length - i)//Until all possibilities have been tried
{
int j = rand.Next(i, length - 1);
//If swapping would make a difference, and wouldn't put a letter in a "bad" place,
//and hasn't already been tried, then swap
if (original[i] != original[j] && TrySwap(i, j) && !used.Contains(j))
{
Swap(i, j);
swaps++;
break;
}
else
used.Add(j);//If swapping doesn't work, "blacklist" the index
}
if (swaps == 0)
{
//If a letter was ignored (no swap was found), look backward for another change to make
for (int k = i; k >= 0; k--)
{
if (TrySwap(i, k))
Swap(i, k);
}
}
//Clear the used indeces
used.Clear();
}
}
//Count how many letters are still in their original places.
private void DetectIgnores()
{
int ignores = 0;
for (int i = 0; i < original.Length; i++)
{
if (original[i] == shuffled[i])
ignores++;
}
ignoredChars = ignores;
}
//To allow easy conversion of strings.
public static implicit operator ShuffledString(string convert)
{
return new ShuffledString(convert);
}
}
public class Program
{
public static void Main(string[] args)
{
ShuffledString[] words = { "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" };
foreach(ShuffledString word in words)
Console.WriteLine("{0}, {1}, ({2})", word.Original, word.Shuffled, word.Ignored);
Console.ReadKey();
}
}
}
And a randomized solution, which will produce a more or less different result on every run:
using System;
using System.Text;
using System.Collections.Generic;
namespace BestShuffle_RC
{
public class ShuffledString
{
private string original;
private StringBuilder shuffled;
private int ignoredChars;
public string Original
{
get { return original; }
}
public string Shuffled
{
get { return shuffled.ToString(); }
}
public int Ignored
{
get { return ignoredChars; }
}
private void Swap(int pos1, int pos2)
{
char temp = shuffled[pos1];
shuffled[pos1] = shuffled[pos2];
shuffled[pos2] = temp;
}
//Determine if a swap between these two would put a letter in a "bad" place
//If true, a swap is OK.
private bool TrySwap(int pos1, int pos2)
{
if (original[pos1] == shuffled[pos2] || original[pos2] == shuffled[pos1])
return false;
else
return true;
}
//Constructor carries out calls Shuffle function.
public ShuffledString(string word)
{
original = word;
shuffled = new StringBuilder(word);
Shuffle();
DetectIgnores();
}
//Does the hard work of shuffling the string.
private void Shuffle()
{
int length = original.Length;
int swaps;
Random rand = new Random();
List<int> used = new List<int>();
for (int i = 0; i < length; i++)
{
swaps = 0;
while(used.Count <= length - i)//Until all possibilities have been tried
{
int j = rand.Next(i, length - 1);
//If swapping would make a difference, and wouldn't put a letter in a "bad" place,
//and hasn't already been tried, then swap
if (original[i] != original[j] && TrySwap(i, j) && !used.Contains(j))
{
Swap(i, j);
swaps++;
break;
}
else
used.Add(j);//If swapping doesn't work, "blacklist" the index
}
if (swaps == 0)
{
//If a letter was ignored (no swap was found), look backward for another change to make
for (int k = i; k >= 0; k--)
{
if (TrySwap(i, k))
Swap(i, k);
}
}
//Clear the used indeces
used.Clear();
}
}
//Count how many letters are still in their original places.
private void DetectIgnores()
{
int ignores = 0;
for (int i = 0; i < original.Length; i++)
{
if (original[i] == shuffled[i])
ignores++;
}
ignoredChars = ignores;
}
//To allow easy conversion of strings.
public static implicit operator ShuffledString(string convert)
{
return new ShuffledString(convert);
}
}
public class Program
{
public static void Main(string[] args)
{
ShuffledString[] words = { "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" };
foreach(ShuffledString word in words)
Console.WriteLine("{0}, {1}, ({2})", word.Original, word.Shuffled, word.Ignored);
Console.ReadKey();
}
}
}
A sample output for the sequential shuffle:
abracadabra, rdabarabaac, (0)
seesaw, easwse, (0)
elk, lke, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
hounddog, unddohgo, (0)
A sample of the randomized shuffle:
abracadabra, raacarbdaab, (0)
seesaw, essewa, (0)
elk, lke, (0)
grrrrrr, rrrgrrr, (5)
up, pu, (0)
a, a, (1)
Clojure
Uses same method as J
(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]]
Common Lisp
(defun count-equal-chars (string1 string2)
(loop for c1 across string1 and c2 across string2
count (char= c1 c2)))
(defun shuffle (string)
(let ((length (length string))
(result (copy-seq string)))
(dotimes (i length result)
(dotimes (j length)
(when (and (/= i j)
(char/= (aref string i) (aref result j))
(char/= (aref string j) (aref result i)))
(rotatef (aref result i) (aref result j)))))))
(defun best-shuffle (list)
(dolist (string list)
(let ((shuffled (shuffle string)))
(format t "~%~a ~a (~a)"
string
shuffled
(count-equal-chars string shuffled)))))
(best-shuffle '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))
Output: abracadabra caadrbabaar (0) seesaw ewaess (0) elk kel (0) grrrrrr rgrrrrr (5) up pu (0) a a (1)
Version 2
(defun all-best-shuffles (str)
(let (tbl out (shortest (length str)) (s str))
(labels ((perm (ar l tmpl res overlap)
(when (> overlap shortest)
(return-from perm))
(when (zerop l) ; max depth of perm
(when (< overlap shortest)
(setf shortest overlap out '()))
(when (= overlap shortest)
(setf res (reverse (format nil "~{~c~^~}" res)))
(push (list res overlap) out)
(return-from perm)))
(decf l)
(dolist (x ar)
(when (plusp (cdr x))
(when (char= (car x) (char tmpl l))
(incf overlap))
(decf (cdr x))
(push (car x) res)
(perm ar l tmpl res overlap)
(pop res)
(incf (cdr x))
(when (char= (car x) (char tmpl l))
(decf overlap))))))
(loop while (plusp (length s)) do
(let* ((c (char s 0))
(l (count c s)))
(push (cons c l) tbl)
(setf s (remove c s))))
(perm tbl (length str) (reverse str) '() 0))
out))
(defun best-shuffle (str)
"Algorithm: list all best shuffles, then pick one"
(let ((c (all-best-shuffles str)))
(elt c (random (length c)))))
(format t "All best shuffles:")
(print (all-best-shuffles "seesaw"))
(format t "~%~%Random best shuffles:~%")
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))
(format t "~A: ~A~%" s (best-shuffle s)))
The output is:
abracadabra: (caardrabaab 0)
seesaw: (ewsase 0)
elk: (kel 0)
grrrrrr: (rrrgrrr 5)
up: (pu 0)
a: (a 1)
== {{header|Crystal}} == {{trans|Ruby}}
def best_shuffle(s)
# Fill _pos_ with positions in the order
# that we want to fill them.
pos = [] of Int32
# g["a"] = [2, 4] implies that s[2] == s[4] == "a"
g = s.size.times.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 } # in Ruby
# k = g.to_a.sort_by { |(k, v)| v.size }.map { |(k, v)| k } # Crystal direct
k = g.to_a.sort_by { |h| h[1].size }.map { |h| h[0] } # Crystal shorter
until g.empty?
k.each do |letter|
g.has_key?(letter) || next # next unless g.has_key? letter
pos << g[letter].pop
g[letter].empty? && g.delete letter # g.delete(letter) if g[letter].empty?
end
end
# 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.size
until letters.empty?
i, p = 0, pos.pop
while letters[i] == s[p] && i < (letters.size - 1); i += 1 end
# new[p] = letters.slice! i # in Ruby
new = new.sub(p, letters[i]); letters = letters.sub(i, "")
end
score = new.chars.zip(s.chars).count { |c, d| c == d }
{new, score}
end
%w(abracadabra seesaw elk grrrrrr up a).each do |word|
# puts "%s, %s, (%d)" % [word, *best_shuffle(word)] # in Ruby
new, score = best_shuffle(word)
puts "%s, %s, (%d)" % [word, new, score]
end
{{out}}
abracadabra, baarrcadaab, (0)
seesaw, essewa, (0)
elk, lke, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
D
Version with random result
Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]
import std.stdio, std.random, std.algorithm, std.conv, std.range,
std.traits, std.typecons;
auto bestShuffle(S)(in S orig) @safe if (isSomeString!S) {
static if (isNarrowString!S)
immutable o = orig.dtext;
else
alias o = orig;
auto s = o.dup;
s.randomShuffle;
foreach (immutable i, ref ci; s) {
if (ci != o[i])
continue;
foreach (immutable j, ref cj; s)
if (ci != cj && ci != o[j] && cj != o[i]) {
swap(ci, cj);
break;
}
}
return tuple(s, s.zip(o).count!q{ a[0] == a[1] });
} unittest {
assert("abracadabra".bestShuffle[1] == 0);
assert("immediately".bestShuffle[1] == 0);
assert("grrrrrr".bestShuffle[1] == 5);
assert("seesaw".bestShuffle[1] == 0);
assert("pop".bestShuffle[1] == 1);
assert("up".bestShuffle[1] == 0);
assert("a".bestShuffle[1] == 1);
assert("".bestShuffle[1] == 0);
}
void main(in string[] args) @safe {
if (args.length > 1) {
immutable entry = args.dropOne.join(' ');
const res = entry.bestShuffle;
writefln("%s : %s (%d)", entry, res[]);
}
}
Deterministic approach
import std.stdio, std.algorithm, std.range;
extern(C) pure nothrow void* alloca(in size_t size);
void bestShuffle(in char[] txt, ref char[] result) pure nothrow {
// Assume alloca to be pure.
//extern(C) pure nothrow void* alloca(in size_t size);
enum size_t NCHAR = size_t(char.max + 1);
enum size_t MAX_VLA_SIZE = 1024;
immutable size_t len = txt.length;
if (len == 0)
return;
// txt and result must have the same length
// allocate only when necessary
if (result.length != len)
result.length = len;
// how many of each character?
size_t[NCHAR] counts;
size_t fmax = 0;
foreach (immutable char c; txt) {
counts[c]++;
if (fmax < counts[c])
fmax = counts[c];
}
assert(fmax > 0 && fmax <= len);
// all character positions, grouped by character
size_t[] ndx1;
{
size_t* ptr1;
if ((len * size_t.sizeof) < MAX_VLA_SIZE)
ptr1 = cast(size_t*)alloca(len * size_t.sizeof);
// If alloca() has failed, or the memory needed is too much
// large, then allocate from the heap.
ndx1 = (ptr1 == null) ? new size_t[len] : ptr1[0 .. len];
}
{
int pos = 0;
foreach (immutable size_t ch; 0 .. NCHAR)
if (counts[ch])
foreach (j, char c; txt)
if (c == ch) {
ndx1[pos] = j;
pos++;
}
}
// regroup them for cycles
size_t[] ndx2;
{
size_t* ptr2;
if ((len * size_t.sizeof) < MAX_VLA_SIZE)
ptr2 = cast(size_t*)alloca(len * size_t.sizeof);
ndx2 = (ptr2 == null) ? new size_t[len] : ptr2[0 .. len];
}
{
size_t n, m;
foreach (immutable size_t i; 0 .. len) {
ndx2[i] = ndx1[n];
n += fmax;
if (n >= len) {
m++;
n = m;
}
}
}
// How long can our cyclic groups be?
immutable size_t grp = 1 + (len - 1) / fmax;
// How many of them are full length?
immutable size_t lng = 1 + (len - 1) % fmax;
// Rotate each group.
{
size_t j;
foreach (immutable size_t i; 0 .. fmax) {
immutable size_t first = ndx2[j];
immutable size_t glen = grp - (i < lng ? 0 : 1);
foreach (immutable size_t k; 1 .. glen)
ndx1[j + k - 1] = ndx2[j + k];
ndx1[j + glen - 1] = first;
j += glen;
}
}
// Result is original permuted according to our cyclic groups.
foreach (immutable size_t i; 0 .. len)
result[ndx2[i]] = txt[ndx1[i]];
}
void main() {
auto data = ["abracadabra", "seesaw", "elk", "grrrrrr",
"up", "a", "aabbbbaa", "", "xxxxx"];
foreach (txt; data) {
auto result = txt.dup;
bestShuffle(txt, result);
immutable nEqual = zip(txt, result).count!q{ a[0] == a[1] };
writefln("%s, %s, (%d)", txt, result, nEqual);
}
}
{{out}}
abracadabra, brabacadaar, (0)
seesaw, wssaee, (0)
elk, kel, (0)
grrrrrr, rrrrrrg, (5)
up, pu, (0)
a, a, (1)
aabbbbaa, bbaaaabb, (0)
, , (0)
xxxxx, xxxxx, (5)
Elena
ELENA 4.1 :
import system'routines;
import extensions;
import extensions'text;
extension op
{
get Shuffled()
{
var original := self.toArray();
var shuffled := self.toArray();
for (int i := 0, i < original.Length, i += 1) {
for (int j := 0, j < original.Length, j += 1) {
if (i != j && original[i] != shuffled[j] && original[j] != shuffled[i])
{
shuffled.exchange(i,j)
}
}
};
^ shuffled.summarize(new StringWriter()).toString()
}
score(originalText)
{
var shuffled := self.toArray();
var original := originalText.toArray();
int score := 0;
for (int i := 0, i < original.Length, i += 1) {
if (original[i] == shuffled[i]) { score += 1 }
};
^ score
}
}
public program()
{
new::("abracadabra", "seesaw", "grrrrrr", "pop", "up", "a").forEach:(s)
{
var shuffled_s := s.Shuffled;
console.printLine("The best shuffle of ",s," is ",shuffled_s,"(",shuffled_s.score(s),")")
};
console.readChar()
}
{{out}}
The best shuffle of abracadabra is caadrbabaar(0)
The best shuffle of seesaw is ewaess(0)
The best shuffle of grrrrrr is rgrrrrr(5)
The best shuffle of pop is opp(1)
The best shuffle of up is pu(0)
The best shuffle of a is a(1)
Erlang
Deterministic version.
-module( best_shuffle ).
-export( [sameness/2, string/1, task/0] ).
sameness( String1, String2 ) -> lists:sum( [1 || {X, X} <- lists:zip(String1, String2)] ).
string( String ) ->
{"", String, Acc} = lists:foldl( fun different/2, {lists:reverse(String), String, []}, String ),
lists:reverse( Acc ).
task() ->
Strings = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"],
Shuffleds = [string(X) || X <- Strings],
[io:fwrite("~p ~p ~p~n", [X, Y, sameness(X,Y)]) || {X, Y} <- lists:zip(Strings, Shuffleds)].
different( Character, {[Character], Original, Acc} ) ->
try_to_save_last( Character, Original, Acc );
different( Character, {[Character | T]=Not_useds, Original, Acc} ) ->
Different_or_same = different_or_same( [X || X <- T, X =/= Character], Character ),
{lists:delete(Different_or_same, Not_useds), Original, [Different_or_same | Acc]};
different( _Character1, {[Character2 | T], Original, Acc} ) ->
{T, Original, [Character2 | Acc]}.
different_or_same( [Different | _T], _Character ) -> Different;
different_or_same( [], Character ) -> Character.
try_to_save_last( Character, Original_string, Acc ) ->
Fun = fun ({X, Y}) -> (X =:= Y) orelse (X =:= Character) end,
New_acc = try_to_save_last( lists:splitwith(Fun, lists:zip(lists:reverse(Original_string), [Character | Acc])), [Character | Acc] ),
{"", Original_string, New_acc}.
try_to_save_last( {_Not_split, []}, Acc ) -> Acc;
try_to_save_last( {Last_reversed_zip, First_reversed_zip}, _Acc ) ->
{_Last_reversed_original, [Last_character_acc | Last_part_acc]} = lists:unzip( Last_reversed_zip ),
{_First_reversed_original, [Character_acc | First_part_acc]} = lists:unzip( First_reversed_zip ),
[Character_acc | Last_part_acc] ++ [Last_character_acc | First_part_acc].
{{out}}
32> best_shuffle:task().
"abracadabra" "rabdacaraab" 0
"seesaw" "wasees" 0
"elk" "kel" 0
"grrrrrr" "rgrrrrr" 5
"up" "pu" 0
"a" "a" 1
Go
{{trans|Icon and Unicon}}
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 := range t {
for j := range t {
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)
}
}
{{out|Output of two runs}}
abracadabra -> raaracbbaad (0)
seesaw -> asswee (0)
elk -> lke (0)
grrrrrr -> rgrrrrr (5)
up -> pu (0)
a -> a (1)
abracadabra -> raadabaracb (0)
seesaw -> wsseea (0)
elk -> kel (0)
grrrrrr -> rrrrrgr (5)
up -> pu (0)
a -> a (1)
Groovy
def shuffle(text) {
def shuffled = (text as List)
for (sourceIndex in 0..<text.size()) {
for (destinationIndex in 0..<text.size()) {
if (shuffled[sourceIndex] != shuffled[destinationIndex] && shuffled[sourceIndex] != text[destinationIndex] && shuffled[destinationIndex] != text[sourceIndex]) {
char tmp = shuffled[sourceIndex];
shuffled[sourceIndex] = shuffled[destinationIndex];
shuffled[destinationIndex] = tmp;
break;
}
}
}
[original: text, shuffled: shuffled.join(""), score: score(text, shuffled)]
}
def score(original, shuffled) {
int score = 0
original.eachWithIndex { character, index ->
if (character == shuffled[index]) {
score++
}
}
score
}
["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"].each { text ->
def result = shuffle(text)
println "${result.original}, ${result.shuffled}, (${result.score})"
}
Output:
abracadabra, baaracadabr, (0)
seesaw, esswea, (0)
elk, lke, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)
Haskell
We demonstrate several approaches here. In order to test the program we define a testing suite:
shufflingQuality l1 l2 = length $ filter id $ zipWith (==) l1 l2
printTest prog = mapM_ test texts
where
test s = do
x <- prog s
putStrLn $ unwords $ [ show s
, show x
, show $ shufflingQuality s x]
texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr"
, "up", "a", "aaaaa.....bbbbb"
, "Rosetta Code is a programming chrestomathy site." ]
=== Deterministic List-based solution ===
The core of the algorithm is swapping procedure similar to those implemented in AWK and Icon examples. It could be done by a pure program with use of immutable vectors (though it is possible to use mutable vectors living in ST or IO, but it won't make the program more clear).
import Data.Vector ((//), (!))
import qualified Data.Vector as V
import Data.List (delete, find)
swapShuffle :: Eq a => [a] -> [a] -> [a]
swapShuffle lref lst = V.toList $ foldr adjust (V.fromList lst) [0..n-1]
where
vref = V.fromList lref
n = V.length vref
adjust i v = case find alternative [0.. n-1] of
Nothing -> v
Just j -> v // [(j, v!i), (i, v!j)]
where
alternative j = and [ v!i == vref!i
, i /= j
, v!i /= vref!j
, v!j /= vref!i ]
shuffle :: Eq a => [a] -> [a]
shuffle lst = swapShuffle lst lst
{{Out}}
λ> printTest (pure . shuffle)
"abba" "baab" 0
"abracadabra" "daabacarrab" 0
"seesaw" "esaews" 0
"elk" "lke" 0
"grrrrrr" "rrrrrrg" 5
"up" "pu" 0
"a" "a" 1
"aaaaa.....bbbbb" ".....bbbbbaaaaa" 0
"Rosetta Code is a programming chrestomathy site." "stetma Code is a programoing chrestomathy site.R" 0
The program works but shuffling is not good in case of a real text, which was just shifted. We can make it better using [[Perfect shuffle]] (faro shuffle) before the swapping procedure.
perfectShuffle :: [a] -> [a]
perfectShuffle [] = []
perfectShuffle lst | odd n = b : shuffle (zip bs a)
| even n = shuffle (zip (b:bs) a)
where
n = length lst
(a,b:bs) = splitAt (n `div` 2) lst
shuffle = foldMap (\(x,y) -> [x,y])
shuffleP :: Eq a => [a] -> [a]
shuffleP lst = swapShuffle lst $ perfectShuffle lst
{{Out}}
λ> qualityTest (pure . shuffleP)
"abba" "baab" 0
"abracadabra" "baadabrraac" 0
"seesaw" "assewe" 0
"elk" "lke" 0
"grrrrrr" "rrgrrrr" 5
"up" "pu" 0
"a" "a" 1
"aaaaa.....bbbbb" "bbb.baaaaba...." 0
"Rosetta Code is a programming chrestomathy site." " Rmoisnegt tcahmrCeosdteo miast hay psriotger.a" 0
That's much better.
=== Nondeterministic List-based solution ===
Adding randomness is easy: just perform random shuffle before swapping procedure.
Additional import:
import Control.Monad.Random (getRandomR)
randomShuffle :: [a] -> IO [a]
randomShuffle [] = return []
randomShuffle lst = do
i <- getRandomR (0,length lst-1)
let (a, x:b) = splitAt i lst
xs <- randomShuffle $ a ++ b
return (x:xs)
shuffleR :: Eq a => [a] -> IO [a]
shuffleR lst = swapShuffle lst <$> randomShuffle lst
{{Out}}
λ> qualityTest shuffleR
"abba" "baab" 0
"abracadabra" "raacadababr" 0
"seesaw" "wsaese" 0
"elk" "kel" 0
"grrrrrr" "rrrgrrr" 5
"up" "pu" 0
"a" "a" 1
"aaaaa.....bbbbb" "b.b.baababa.a.." 0
"Rosetta Code is a programming chrestomathy site." "esodmnithsrasrmeogReat taoCp gtrty i .mi as ohce" 0
Now everything is Ok except for the efficiency. Both randomization and swapping procedure are O[n^2], moreover the whole text must be kept in memory, so for large data sequences it will take a while to shuffle.
=== Nondeterministic Conduit-based solution ===
Using streaming technique it is possible to shuffle the sequence on the fly, using relatively small moving window (say of length k) for shuffling procedure. In that case the program will consume constant memory amount O[k] and require O[n*k] operations.
{-# LANGUAGE TupleSections, LambdaCase #-}
import Conduit
import Control.Monad.Random (getRandomR)
import Data.List (delete, find)
shuffleC :: Eq a => Int -> Conduit a IO a
shuffleC 0 = awaitForever yield
shuffleC k = takeC k .| sinkList >>= \v -> delay v .| randomReplace v
delay :: Monad m => [a] -> Conduit t m (a, [a])
delay [] = mapC $ \x -> (x,[x])
delay (b:bs) = await >>= \case
Nothing -> yieldMany (b:bs) .| mapC (,[])
Just x -> yield (b, [x]) >> delay (bs ++ [x])
randomReplace :: Eq a => [a] -> Conduit (a, [a]) IO a
randomReplace vars = awaitForever $ \(x,b) -> do
y <- case filter (/= x) vars of
[] -> pure x
vs -> lift $ (vs !!) <$> getRandomR (0, length vs - 1)
yield y
randomReplace $ b ++ delete y vars
shuffleW :: Eq a => Int -> [a] -> IO [a]
shuffleW k lst = yieldMany lst =$= shuffleC k $$ sinkList
Here we define a new conduit shuffleC which uses a moving window of length k and returns shuffled elements of upstream data.
{{Out}}
λ> qualityTest (shuffleW 8)
"abba" "baab" 0
"abracadabra" "daabrcabaar" 0
"seesaw" "eswesa" 0
"elk" "kel" 0
"grrrrrr" "rgrrrrr" 5
"up" "pu" 0
"a" "a" 1
"aaaaa.....bbbbb" "....baabaaa.bbb" 3
"Rosetta Code is a programming chrestomathy site." "sCaoeRei d os pttaogrr nrgshmeaotaichiy .ttmsme" 0
This program is good for real texts with high entropy. In case of homogeneous strings like "aaaaa.....bbbbb" it gives poor results for windows smaller then homogeneous regions.
The main goal of streaming solution is to be able to process data from any resources, so let's use it to shuffle texts being transferred from stdin to stdout.
Additional imports
import Data.ByteString.Builder (charUtf8)
import Data.ByteString.Char8 (ByteString, unpack, pack)
import Data.Conduit.ByteString.Builder (builderToByteString)
import System.IO (stdin, stdout)
shuffleBS :: Int -> ByteString -> IO ByteString
shuffleBS n s =
yieldMany (unpack s)
=$ shuffleC n
=$ mapC charUtf8
=$ builderToByteString
$$ foldC
main :: IO ()
main =
sourceHandle stdin
=$ mapMC (shuffleBS 10)
$$ sinkHandle stdout
{{Out}}
$ ghc --make -O3 ./shuffle
[1 of 1] Compiling Main ( shuffle.hs, shuffle.o )
Linking shuffle ...
$ cat input.txt
Rosetta Code is a programming chrestomathy site. The idea is to present solutions to the same task in as many different languages as possible, to demonstrate how languages are similar and different, and to aid a person with a grounding in one approach to a problem in learning another. Rosetta Code currently has 823 tasks, 193 draft tasks, and is aware of 642 languages, though we do not (and cannot) have solutions to every task in every language.
$ cat input.txt | ./shuffle
aeotdR s aoiCtrpmmgi crn theemaysg srioT the tseo.dih psae re isltn ountstoeo tosmaetia es nssimhn ad kaeeinrlataffauytse g oanbs ,e ol e sio ttngdasmw esphut ro ganeemas g alsi arlaeefn,ranifddoii a drnp det r toi ahowgnutan n rgneanppi raohi d oaop blrcst imeioaer ngohrla.eRotn Cst n dce aenletya th8r3 n2ssout1 3dasktaft,rrk9as,a ss iewarf6 d2l ogu asga te g un oa hn4d enaodho(ctt)n, eha laovnsotusw oeinyetsakvn eo ienlrav ygtnu aer. g
=={{header|Icon}} and {{header|Unicon}}== The approach taken requires 2n memory and will run in O(n^2) time swapping once per final changed character. The algorithm is concise and conceptually simple avoiding the lists of indices, sorting, cycles, groups, and special cases requiring rotation needed by many of the other solutions. It proceeds through the entire string swapping characters ensuring that neither of the two characters are swapped with another instance of themselves in the ''original'' string.
Additionally, this can be trivially modified to randomize the shuffle by uncommenting the line
# every !t :=: ?t # Uncomment to get a random best shuffling
in bestShuffle.
procedure main(args)
while scram := bestShuffle(line := read()) do
write(line," -> ",scram," (",unchanged(line,scram),")")
end
procedure bestShuffle(s)
t := s
# every !t :=: ?t # Uncomment to get a random best shuffling
every i := 1 to *t do
every j := (1 to i-1) | (i+1 to *t) do
if (t[i] ~== s[j]) & (s[i] ~== t[j]) then break t[i] :=: t[j]
return t
end
procedure unchanged(s1,s2) # Number of unchanged elements
every (count := 0) +:= (s1[i := 1 to *s1] == s2[i], 1)
return count
end
The code works in both Icon and Unicon.
Sample output:
->scramble <scramble.data
abracadabra -> raaracababd (0)
seesaw -> wasese (0)
elk -> lke (0)
grrrrrr -> rgrrrrr (5)
up -> pu (0)
a -> a (1)
aardvarks are ant eaters -> sdaaaraaasv rer nt keter (0)
->
J
Based on [http://rosettacode.org/mw/index.php?title=Best_shuffle&oldid=97419#J Dan Bron's approach]:
bestShuf =: verb define
yy=. <@({~ ?~@#)@I.@= y
y C.~ (;yy) </.~ (i.#y) |~ >./#@> yy
)
fmtBest=:3 :0
b=. bestShuf y
y,', ',b,' (',')',~":+/b=y
)
yy is (a list of) boxes of (lists of) indices where all characters selected by indices in a box are the same, and where the first box is the biggest box (contains the most indices). The phrase ({~ ?~@#) shuffles the indices going into each box which makes the (deterministic) rotate which follows produce differing results sometimes (but only when that is possible).
Example:
fmtBest&>;:'abracadabra seesaw elk grrrrrr up a'
abracadabra, bdacararaab (0)
seesaw, eawess (0)
elk, lke (0)
grrrrrr, rrrrrrg (5)
up, pu (0)
a, a (1)
Java
Translation of [[Best_shuffle#Icon_and_Unicon|Icon]] via [[Best_shuffle#AWK|AWK]]
import java.util.Random;
public class BestShuffle {
private final static Random rand = new Random();
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();
shuffle(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) + ")";
}
public static void shuffle(char[] text) {
for (int i = text.length - 1; i > 0; i--) {
int r = rand.nextInt(i + 1);
char tmp = text[i];
text[i] = text[r];
text[r] = tmp;
}
}
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;
}
}
Output:
abracadabra raaracabdab (0)
seesaw eswaes (0)
grrrrrr rgrrrrr (5)
pop ppo (1)
up pu (0)
a a (1)
JavaScript
Based on the J implementation (and this would be a lot more concise if we used something like jQuery):
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+')';
}
Example:
<pre id="out">