14
$\begingroup$

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?

$\endgroup$
19
$\begingroup$

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.

$\endgroup$
4
  • $\begingroup$ Yep... simple... elegant (+1). $\endgroup$ Jun 29 '18 at 2:42
  • 3
    $\begingroup$ No need All in RandomSample (+1) $\endgroup$ Jun 29 '18 at 4:12
  • 4
    $\begingroup$ For pre-TakeList versions of MMA: Internal`PartitionRagged instead of TakeList. $\endgroup$
    – corey979
    Jun 29 '18 at 6:13
  • $\begingroup$ @OkkesDulgerci Good suggestion. May update later today. (+1) $\endgroup$
    – Edmund
    Jun 29 '18 at 11:42
8
$\begingroup$

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:

$\endgroup$
1
  • 2
    $\begingroup$ The linked unflatten and your subsequent deepShuffle are very elegant. (+1) $\endgroup$
    – Edmund
    Jun 29 '18 at 11:38
2
$\begingroup$

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"}}
$\endgroup$
2
$\begingroup$
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}$

$\endgroup$
1
$\begingroup$

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).

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.