Permutations[Range[12]] produces an error instead of a list
Since Mathematica 8 it is possible generate the elements of any group one by one with GroupElements
. Here's for example a randomly chosen element of the permutation group on 20 elements:
GroupElements[SymmetricGroup[20], {10^6 + 1}]
{Cycles[{{11, 13, 19}, {12, 18, 17, 16}, {15, 20}}]}
The result is immediately; there's no need to build up the full group of $20! \approx 2.4 \cdot 10^{18}$ elements. We can use this to scan over the permutations of a given list without generating them all at once:
ScanPermutations[function_, list_] /; Length[list] <= 8 :=
Scan[function, Permutations @ list];
ScanPermutations[function_, list_] :=
Do[
Scan[
function @ Permute[list, #] &,
GroupElements[
SymmetricGroup @ Length @ list,
Range[8! * (i - 1) + 1, 8! * i]
]
],
{i, Length[list]! / 8!}
];
The code splits up the permutations in blocks of $8! = 40320$ whenever the given list has more than 8 elements. This is about ten times faster than calling GroupElements
to generate just one permutation at a time.
Printing e.g. the permutations of {1,2,3}
can now be done as follows:
ScanPermutations[Print, {1,2,3}]
{1,2,3} {1,3,2} {2,1,3} {3,1,2} {2,3,1} {3,2,1}
Going one step further, we may use Reap
and Sow
to select permutations that match a given criterion:
SelectPermutations[list_, crit_] :=
First @ Last @ Reap @ ScanPermutations[
If[crit @ #, Sow @ #] &,
list
];
And finally, here's a small example that puts the above in action. It selects the even permutations of {1,2,3}
:
SelectPermutations[{1, 2, 3}, Signature[#] === 1 &]
{{1, 2, 3}, {2, 3, 1}, {3, 1, 2}}
Combinatorica`
has the function NextPermutation
which allows you to iterate over the permutations. There may be ways of generating a smaller subset if you have more information about what you are looking for.
Consider than the permutations of {1, 2, 3, 4, 5}
are each of the permutations of {1, 2, 3, 4}
with 5
inserted at each possible place. One can therefore examine the permutations of {1, 2, 3, 4, 5}
in blocks like this:
p4 = Permutations@Range@4;
Table[
ReplaceList[x, {h___, t___} :> {h, 5, t}],
{x, p4}
]
For example, making a certain selection:
Table[
Select[
ReplaceList[x, {h___, t___} :> {h, 5, t}],
# + #2 - #3*#4/#5 > 7 & @@ # &
],
{x, p4}
]
The same can be applied to the permutations of Range@12
.