4
$\begingroup$

I have this Table that gives all elements of $S_n$, I would like to know how to improve efficiency.

Table[i -> Part[Permutations[Table[n, {n, k}]], j, i], {j, k!}, {i, k}]
$\endgroup$
0
7
$\begingroup$

Already at k==7, this version is 85 times faster:

With[{k = 7}, Thread[Range[k] -> #] & /@ Permutations[Range[k]]]

enter image description here

To make sure:

With[{k = 5}, Table[i -> Part[Permutations[Table[n, {n, k}]], j, i], {j, k!}, {i, k}]]
  === 
 With[{k = 5}, Thread[Range[k] -> #] & /@ Permutations[Range[k]]]
(* True *)
$\endgroup$
3
$\begingroup$

The best I found so far is the following f3 (indeed very similar to the one of garej)

f1[k_] := Thread[Range[k] -> #] & /@ Permutations[Range[k]]
f2[k_] := With[{r = Range@k}, Thread[r -> #] & /@ Permutations@r]
f3[k_] := With[{r = Range@k}, 
  Transpose@MapThread[Thread@*Rule, {r, Transpose@Permutations@r}]]
f4[k_] := Transpose[Thread[# -> Permutations[Range[k]][[All, #]]] & /@ Range[k]];

Comparison:

data = Table[First@RepeatedTiming@f[k], {f, {f1, f2, f3, f4}}, {k, 7}]
ListPlot[data, PlotLegends -> {"march", 2, 3, "garej"}, 
 PlotRange -> All, Joined -> True, PlotTheme -> "Detailed"]

{{9.5*10^-6, 0.000014, 0.000034, 0.00012, 0.00066, 0.0042, 0.033}, {9.3*10^-6, 0.0000126, 0.00002718, 0.00010, 0.00054, 0.0035, 0.028}, {0.000013, 0.000017, 0.000026, 0.0000614, 0.00030, 0.0022, 0.018}, {0.0000112, 0.0000188, 0.0000316, 0.000080, 0.00033, 0.0023, 0.02}}

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ why didn't you add my version to comparison? $\endgroup$
    – garej
    Mar 6 '16 at 11:43
  • $\begingroup$ @garej sorry, I started improving the one of march; now added $\endgroup$
    – unlikely
    Mar 6 '16 at 12:05
  • $\begingroup$ no problem - I've also made a shorter one with Inner $\endgroup$
    – garej
    Mar 6 '16 at 12:05
2
$\begingroup$

My favourite one is:

foo[k_]:= Inner[Rule, Range[k], Transpose @ Permutations[Range[k]], List]

This is also a fast option conceptually close to OP approach:

Transpose[Thread[# -> Permutations[Range[k]][[All, #]]] & /@ Range[k]];

Timing with Unlikely's comparison method for k = {7,8,9} on (i5, Win10, V10.30) Inner is a bit faster. :

enter image description here

Edit Just for diversity:

MapIndexed[Last[#2] -> #1 &, Permutations[Range[5]], {2}]
$\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.