Smarter Shuffle of a List

Question

I have a 2D matrix representing a keyboard:

{{"Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P"}, 
 {"A", "S", "D", "F", "G", "H", "J", "K", "L"}, 
 {"Z", "X", "C", "V", "B", "N", "M"}}

I want to 'shuffle' the list, such that the length of all the sub-lists stay the same, but the actual letters within them are randomly re-distributed (between all the lists, not just within their sub-list).

I thought of initializing a list with the same structure but all 0's instead of letters and then randomly pulling letters for a ReplacePart, but that means some letters would repeat, which I don't want (a shuffle).

How can this be accomplished in Mathematica?

Answer 1

You may Flatten the list and then take a RandomSample before partitioning to the original dimensions with Length and TakeList.

With keys the list in the OP then

TakeList[RandomSample @ Flatten @ keys, Length /@ keys]

Hope this helps.

Answer 2

Here is another approach that is applicable to all shapes of nested lists. It is a minor modification of halirutan's unflatten from "Unflattening" a list.

deepShuffle[l_] :=
  Module[{i = 1, l1 = RandomSample @ Flatten[l]},
    Function[, l1[[i++]], Listable][l]
  ]

Test:

in = {{"Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P"},
      {"A", "S", "D", "F", "G", "H", "J", "K", "L"},
      {"Z", "X", "C", "V", "B", "N", "M"}};

SeedRandom[1]

deepShuffle[in]
deepShuffle[in]

{{"Y", "Q", "I", "N", "E", "R", "V", "Z", "J", "G"},
 {"W", "H", "K", "X", "C", "A", "F", "U", "L"},
 {"B", "T", "S", "P", "D", "M", "O"}}

{{"A", "Z", "K", "J", "E", "H", "G", "M", "D", "W"},
 {"P", "Y", "X", "T", "L", "O", "V", "I", "B"},
 {"F", "Q", "S", "N", "U", "R", "C"}}

See also:

• UnFlatten an array into a ragged matrix

Answer 3

Here's a different approach:

keyboard = 
 {{"Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P"},
  {"A", "S", "D", "F", "G", "H", "J", "K", "L"},
  {"Z", "X", "C", "V", "B", "N", "M"}}

With[{rule = CharacterRange["A", "Z"] // 
        # -> RandomSample[#] & // Thread},
     keyboard /. rule]

{{"P", "X", "B", "G", "K", "U", "L", "O", "Z", "Q"},
 {"F", "M", "W", "J", "V", "R", "T", "Y", "S"},
 {"I", "E", "N", "A", "D", "C", "H"}}

Answer 4

ClearAll[f1, f2, f3]
f1 = Module[{l = #, i = Position[#, _, {-1}, Heads -> False]},
    ReplacePart[l, Thread[RandomSample[i] -> Extract[l, i]]]] &;

and a modification of Ray Koopman's copyPartition

f2 = Module[{i = 1, l = RandomSample @ Flatten @ #}, Map[l[[i++]] &, #, {-1}]] &;

Examples:

lst = {{"Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P"}, {"A", "S", 
    "D", "F", "G", "H", "J", "K", "L"}, {"Z", "X", "C", "V", "B", "N", "M"}};
lst2 = {{"Q", "W", "E", "R", {"T", "Y", "U", "I"}, "O", "P"}, 
  {"A",  "S", "D", "F", {"G", {"H", "J"}}, "K", "L"},
  {"Z", "X", "C", "V",  "B", "N", "M"}};

f1 @ lst

{{"C", "H", "X", "I", "P", "Q", "O", "V", "D", "U"},
{"S", "E", "L", "R", "A", "F", "W", "T", "K"},
{"Z", "G", "J", "Y", "B", "M", "N"}}

f2 @ lst

{{"U", "A", "D", "Z", "E", "R", "N", "L", "S", "O"},
{"X", "V", "J", "B", "H", "P", "I", "K", "T"},
{"M", "C", "F", "G", "Q", "W", "Y"}}

f1 @ lst2

{{"O", "B", "P", "D", {"E", "A", "J", "Q"}, "I", "H"},
{"T", "R", "Y", "C", {"N", {"L", "S"}}, "U", "W"},
{"V", "Z", "K", "M", "G", "X", "F"}}

f2 @ lst2

{"F", "J", "K", "Y", {"Z", "D", "W", "A"}, "P", "R"},
{"L", "T", "G", "H", {"I", {"U", "S"}}, "V", "E"},
{"N", "C", "B", "Q", "O", "M", "X"}}

Table[f1[lst], {3}] // Grid // TeXForm

$\small\begin{array}{ccc} \{\text{Q},\text{Z},\text{P},\text{B},\text{J},\text{U},\text{I},\text{S},\text{E},\text{M}\} & \{\text{T},\text{H},\text{F},\text{D},\text{W},\text{Y},\text{K},\text{O},\text{R}\} & \{\text{X},\text{C},\text{V},\text{G},\text{L},\text{A},\text{N}\} \\ \{\text{Q},\text{S},\text{I},\text{V},\text{T},\text{R},\text{Z},\text{X},\text{N},\text{F}\} & \{\text{U},\text{H},\text{E},\text{B},\text{G},\text{W},\text{O},\text{K},\text{C}\} & \{\text{Y},\text{D},\text{M},\text{A},\text{P},\text{L},\text{J}\} \\ \{\text{X},\text{V},\text{B},\text{M},\text{L},\text{K},\text{F},\text{H},\text{E},\text{T}\} & \{\text{I},\text{R},\text{U},\text{O},\text{N},\text{Q},\text{S},\text{C},\text{J}\} & \{\text{A},\text{Z},\text{G},\text{Y},\text{D},\text{P},\text{W}\} \\ \end{array}$

Table[f1[lst2], {3}] // Grid // TeXForm

$\small\begin{array}{ccc} \{\text{Y},\text{Q},\text{J},\text{P},\{\text{W},\text{T},\text{I},\text{L}\},\text{K},\text{O}\} & \{\text{G},\text{A},\text{S},\text{N},\{\text{M},\{\text{C},\text{H}\}\},\text{F},\text{V}\} & \{\text{D},\text{B},\text{R},\text{Z},\text{U},\text{X},\text{E}\} \\ \{\text{A},\text{E},\text{L},\text{M},\{\text{H},\text{T},\text{U},\text{Z}\},\text{F},\text{I}\} & \{\text{N},\text{D},\text{X},\text{O},\{\text{S},\{\text{B},\text{J}\}\},\text{V},\text{C}\} & \{\text{G},\text{Y},\text{W},\text{R},\text{P},\text{K},\text{Q}\} \\ \{\text{H},\text{T},\text{N},\text{A},\{\text{E},\text{G},\text{K},\text{U}\},\text{B},\text{P}\} & \{\text{Y},\text{V},\text{W},\text{L},\{\text{D},\{\text{S},\text{Z}\}\},\text{F},\text{X}\} & \{\text{Q},\text{R},\text{J},\text{M},\text{O},\text{C},\text{I}\} \\ \end{array}$

Answer 5

This is a solution using Fold

                   (* Join result *)
shuffleKeyboard[]:=Apply[Join][Fold[
  (* #1 = available chars, #2 = list length *)
  With[{rsmpl = RandomSample[#1[[-1, -1]], #2]},
    {Join[#1[[1]], {rsmpl}], {Complement[#1[[-1, -1]], rsmpl]}}
   ] &, {{}, {CharacterRange["A", "Z"]}}, {10, 9}]
 ]

Using it in a reproducible way:

assoc = With[{seed = RandomInteger[{10^5, 10^6}]},
  BlockRandom[
    Association["seed" -> seed, "layout" -> shuffleKeyboard[]],
    RandomSeeding -> seed
   ]
 ]

evaluates to

<|"seed" -> 953127, 
    "layout" -> {
      {"U", "Q", "N", "Z", "V", "M", "J", "I", "B", "A"}, 
      {"L", "X", "T", "H", "F", "C", "D", "P", "R"}, 
      {"E", "G", "K", "O", "S", "W", "Y"}}|>

As a sanity check I added

Sort[Flatten[assoc["layout"]]] == CharacterRange["A", "Z"]

which hopefully evaluates to True (it does).