Best shuffle: Difference between revisions
(→{{header|Common Lisp}}: DEFUN is not there to define self recursive local functions. Use LABELS.) |
(→{{header|Common Lisp}}: new version using simple loops) |
||
| Line 1,011: | Line 1,011: | ||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
<lang 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) |
|||
(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))))) |
|||
result)) |
|||
(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"))</lang> |
|||
Output: |
|||
abracadabra caadrbabaar (0) |
|||
seesaw ewaess (0) |
|||
elk kel (0) |
|||
grrrrrr rgrrrrr (5) |
|||
up pu (0) |
|||
a a (1) |
|||
===Version 2=== |
|||
<lang lisp>(defun all-best-shuffles (str) |
<lang lisp>(defun all-best-shuffles (str) |
||
(let (tbl out (shortest (length str)) (s str)) |
(let (tbl out (shortest (length str)) (s str)) |
||
| Line 1,057: | Line 1,091: | ||
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a")) |
(dolist (s (list "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a")) |
||
(format t "~A: ~A~%" s (best-shuffle s))) |
(format t "~A: ~A~%" s (best-shuffle s))) |
||
</lang> |
</lang> |
||
Output: |
Output: |
||
Revision as of 21:25, 11 January 2013
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 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: tree, eetr, (0)
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: abracadabra, seesaw, elk, grrrrrr, up, a
- Cf.
Ada
<lang Ada>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;</lang>
AutoHotkey
<lang 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" }</lang> Output:
abracadabra, caadarrbaab, (0) seesaw, easews, (0) elk, kel, (0) grrrrrr, rrrrrrg, (5) up, pu, (0) a, a, (1)
AWK
The Icon and Unicon program uses a simple algorithm of swapping. This is relatively easy to translate to Awk.
<lang 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 }</lang>
This program has the same output as the Icon and Unicon program.
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.
<lang awk># 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"] } }</lang>
Output:
<lang bash>$ awk -f best-shuffle.awk abracadabra, baarrcadaab, (0) seesaw, essewa, (0) elk, kel, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)</lang>
The output might change if the for (c in set) loop iterates the array in a different order.
BBC BASIC
<lang bbcbasic> 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%) + ")"</lang>
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: <lang bracmat>
( 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
</lang>
Optimized (~100 x faster): <lang bracmat>
( 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
</lang> 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.
<lang c>#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;
}</lang> 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
<lang C>#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; }</lang>Output<lang>abracadebra -> edbcarabaar, overlap 0 grrrrrr -> rrgrrrr, overlap 5 elk -> kel, overlap 0 seesaw -> ewsesa, overlap 0
-> , overlap 0</lang>
Deterministic method
<lang 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; }</lang>
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.: <lang csharp>ShuffledString[] array = {"cat", "dog", "mouse"};</lang> Which will immediately shuffle each word.
A sequential solution, which always produces the same output for the same input. <lang csharp> 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();
}
}
} </lang>
And a randomized solution, which will produce a more or less different result on every run: <lang csharp> 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();
}
}
} </lang>
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
<lang Clojure>(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]]</lang>
Common Lisp
<lang 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)
(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)))))
result))
(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"))</lang> Output:
abracadabra caadrbabaar (0) seesaw ewaess (0) elk kel (0) grrrrrr rgrrrrr (5) up pu (0) a a (1)
Version 2
<lang lisp>(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)
"brilliant 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)))
</lang> Output:
abracadabra aaababarrcd (1) seesaw easwes (0) elk lke (0) grrrrrr rrrrgrr (5) up pu (0) a a (1)
D
Version with random result
Translation of Icon via AWK <lang d>import std.stdio, std.random, std.algorithm, std.conv, std.range, std.traits, std.typecons;
auto bestShuffle(S)(in S orig) if (isSomeString!S) {
static if (isNarrowString!S)
auto o = to!dstring(orig);
else alias orig o;
auto s = o.dup;
randomShuffle(s);
foreach (i, ref ci; s) {
if (ci != o[i])
continue;
foreach (j, ref cj; s)
if (ci != cj && ci != o[j] && cj != o[i]) {
swap(ci, cj);
break;
}
}
return tuple(s, count!"a[0] == a[1]"(zip(s, o)));
}
unittest {
assert(bestShuffle("abracadabra"d)[1] == 0);
assert(bestShuffle("immediately"d)[1] == 0);
assert(bestShuffle("grrrrrr"d)[1] == 5);
assert(bestShuffle("seesaw"d)[1] == 0);
assert(bestShuffle("pop"d)[1] == 1);
assert(bestShuffle("up"d)[1] == 0);
assert(bestShuffle("a"d)[1] == 1);
assert(bestShuffle(""d)[1] == 0);
}
void main(string[] args) {
if (args.length > 1) {
string entry = join(args[1 .. $], " ");
auto res = bestShuffle(entry);
writefln("%s : %s (%s)", entry, res[0], res[1]);
}
}</lang>
Deterministic approach
<lang d>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 = cast(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 (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 (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 (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 (size_t i; 0 .. fmax) {
immutable size_t first = ndx2[j];
immutable size_t glen = grp - (i < lng ? 0 : 1);
foreach (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 (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);
}
}</lang>
- 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)
Go
<lang go>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)
}
}</lang>
- 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
<lang 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})"
}</lang> Output:
abracadabra, baaracadabr, (0) seesaw, esswea, (0) elk, lke, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)
Haskell
<lang haskell>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</lang>
Here's a version of bestShuffle that's much simpler, but too wasteful of memory for inputs like "abracadabra":
<lang haskell>bestShuffle :: Eq a => [a] -> [a] bestShuffle s = minimumBy (compare `on` score s) $ permutations s</lang>
Icon and 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 <lang icon># every !t :=: ?t # Uncomment to get a random best shuffling</lang> in bestShuffle. <lang icon>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</lang>
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 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>
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:
<lang j> 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)</lang>
Java
Translation of Icon via AWK <lang java>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;
}
}</lang>
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):
<lang javascript>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+')';
}</lang>
Example:
<lang html><html><head><title></title></head><body>
</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></lang>
Produced:
<lang>abracadabra, raababacdar, (0) seesaw, ewaess, (0) elk, lke, (0) grrrrrr, rrrrrgr, (5) up, pu, (0) a, a, (1)</lang>
Liberty BASIC
<lang lb> 'see Run BASIC solution 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 </lang> output
abracadabra caadrbabaar 0 seesaw ewaess 0 pop opp 1 grrrrrr rgrrrrr 5 up pu 0 a a 1
Mathematica
<lang Mathematica>BestShuffle[data_] :=
Flatten[{data,First[SortBy[
List[#, StringLength[data]-HammingDistance[#,data]] & /@ StringJoin /@ Permutations[StringSplit[data, ""]], Last]]}]
Print[#1, "," #2, ",(", #3, ")"] & /@ BestShuffle /@ {"abracadabra","seesaw","elk","grrrrrr","up","a"} </lang>
Output :
abracadabra, baabacadrar,(0) seesaw, assewe,(0) elk, kel,(0) grrrrrr, rgrrrrr,(5) up, pu,(0) a, a,(1)
OCaml
Deterministic
<lang ocaml>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";
- </lang>
Run:
$ ocaml best_shuffle_string.ml 'tree', 'eert' -> 0 'abracadabra', 'caadrbabaar' -> 0 'seesaw', 'ewaess' -> 0 'elk', 'kel' -> 0 'grrrrrr', 'rgrrrrr' -> 5 'up', 'pu' -> 0 'a', 'a' -> 1
Pascal
<lang pascal>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.</lang> Output:
% ./BestShuffle abracadabra, caadrbabaar, (0) seesaw, ewaess, (0) elk, kel, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)
Perl
Deterministic
<lang perl>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";
}
</lang>
Perl 6
<lang perl6>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>;</lang>
PHP
Translation of Icon via AWK <lang php>foreach (split(' ', 'abracadabra seesaw pop grrrrrr up a') as $w)
echo bestShuffle($w) . '
';
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)";
}</lang>
Output:
abracadabra drabacabaar (0) seesaw esswea (0) pop ppo (1) grrrrrr rrgrrrr (5) up pu (0) a a (1)
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)
PL/I
<lang PL/I> 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 </lang>
PowerShell
<lang PowerShell> 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" </lang>
Output:
arbcardaaba aesesw opp rrgrrrr pu a
Prolog
Works with SWI-Prolog <lang Prolog>:- 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).
</lang>
output :
?- test. abracadabra : brabaracaad (0) eesaw : sweea (0) elk : kel (0) grrrrrr : rrrgrrr (5) up : pu (0) a : a (1) true .
PureBasic
This solution creates cycles of letters of letters that are then rotated to produce the final maximal shuffle. It includes an extra sort step that ensures the original string to be returned if it is repeatedly shuffled. <lang PureBasic>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</lang> Sample output:
abracadabra, daabarbraac, (0) seesaw, eawess, (0) elk, lke, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)
Python
Swap if it is locally better algorithm
With added randomization of swaps! <lang python>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))</lang>
- Sample output
Two runs showing variability in shuffled results
>>> ================================ RESTART ================================
>>>
tree, eetr ,(0)
abracadabra, daaracbraab ,(0)
seesaw, asswee ,(0)
elk, kel ,(0)
grrrrrr, rrgrrrr ,(5)
up, pu ,(0)
a, a ,(1)
antidisestablishmentarianism, sintmdnirhimasibtnasetaisael ,(0)
hounddogs, ohodgnsud ,(0)
aardvarks are ant eaters, sesanretatva kra errada ,(0)
immediately, tedlyaeiimm ,(0)
abba, baab ,(0)
>>> ================================ RESTART ================================
>>>
tree, eert ,(0)
abracadabra, bdacararaab ,(0)
seesaw, ewsase ,(0)
elk, kel ,(0)
grrrrrr, rrrrrrg ,(5)
up, pu ,(0)
a, a ,(1)
antidisestablishmentarianism, rtitiainnnshtmdesibalassemai ,(0)
hounddogs, ddousngoh ,(0)
aardvarks are ant eaters, sretrnat a edseavra akar ,(0)
immediately, litiaemmyed ,(0)
abba, baab ,(0)
>>>
Alternative algorithm #1
<lang python>#!/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))</lang>
Output:
abracadabra, raabarabacd, (0) seesaw, wsaese, (0) elk, kel, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)
Rascal
<lang Rascal>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]);
}</lang>
REXX
<lang rexx>/*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</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
Ruby
<lang ruby>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)
}</lang>
Output:
abracadabra, baarrcadaab, (0) seesaw, essewa, (0) elk, lke, (0) grrrrrr, rgrrrrr, (5) up, pu, (0) a, a, (1)
Run BASIC
<lang runbasic>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</lang>
Output:
abracadabra raabadacabr 0 seesaw eswaes 0 pop opp 1 grrrrrr rgrrrrr 5 up pu 0 a a 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
<lang tcl>package require Tcl 8.5 package require struct::list
- Simple metric function; assumes non-empty lists
proc count {l1 l2} {
foreach a $l1 b $l2 {incr total [string equal $a $b]}
return $total
}
- Find the best shuffling of the string
proc bestshuffle {str} {
set origin [split $str ""]
set best $origin
set score [llength $origin]
struct::list foreachperm p $origin {
if {$score > [set score [tcl::mathfunc::min $score [count $origin $p]]]} { set best $p }
} set best [join $best ""] return "$str,$best,($score)"
}</lang> Demonstration: <lang tcl>foreach sample {abracadabra seesaw elk grrrrrr up a} {
puts [bestshuffle $sample]
}</lang> Output:
abracadabra,baabacadrar,(0) seesaw,assewe,(0) elk,kel,(0) grrrrrr,rgrrrrr,(5) up,pu,(0) a,a,(1)
Ursala
An implementation based on the J solution looks like this. <lang Ursala>#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</lang>
A solution based on exponential search would use this definition of shuffle (cf. Haskell and Tcl).
<lang Ursala>shuffle = ~&r+ length@plrEZF$^^D/~& permutations</lang>
output:
abracadabra caarrbabaad (0) seesaw wssaee (0) elk lke (0) grrrrrr rgrrrrr (5) up pu (0) a a (1)
XPL0
<lang XPL0>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)); ]</lang>
Output:
abracadabra, drababaraac, (0) seesaw, easwes, (0) elk, lke, (0) grrrrrr, rrrrrrg, (5) up, pu, (0) a, a, (1)
- Programming Tasks
- Solutions by Programming Task
- Ada
- AutoHotkey
- AWK
- BBC BASIC
- Bracmat
- C
- C sharp
- Clojure
- Common Lisp
- D
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Liberty BASIC
- Mathematica
- OCaml
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- PL/I
- PowerShell
- Prolog
- PureBasic
- Python
- Python examples needing attention
- Examples needing attention
- Rascal
- REXX
- Ruby
- Run BASIC
- Scheme
- Tcl
- Tcllib
- Ursala
- XPL0
- Bc/Omit
- Dc/Omit