Duplicate Permutations with Tuples
I recommend not generating more tuples than you need, then filtering output, as that method "blows up" very easily.
Instead I would draw your attention to the similarity between this problem and a shuffle product:
- Shuffle product of two lists
Using the f
function from my answer there:
f[u : {a_, x___}, v : {b_, y___}, c___] := f[{x}, v, c, a] ~Join~ f[u, {y}, c, b]
f[{x___}, {y___}, c___] := {{c, x, y}}
Compare the outputs of:
f[{1}, {2, 2, 2}]
Permutations[{1, 2, 2, 2}]
{{1, 2, 2, 2}, {2, 1, 2, 2}, {2, 2, 1, 2}, {2, 2, 2, 1}} {{1, 2, 2, 2}, {2, 1, 2, 2}, {2, 2, 1, 2}, {2, 2, 2, 1}}
So we can implement a duplicate-aware permutation function using f
as follows:
f2[a_, b_] := Join @@ (f[#, b] & /@ a)
perms[a_List] := Fold[f2, {{}}, Gather[a]]
Test:
Sort @ perms[{1, 2, 2, 2, 3, 3}] === Sort @ Permutations[{1, 2, 2, 2, 3, 3}]
True
A simplification(?) to making f
work on multiple lists using f2
and Fold
is to write a multiple-list shuffle product directly using ReplaceList
.
f3[in_, out___] :=
Join @@ ReplaceList[in, {x___, {a_, b___}, y___} :> f3[{x, {b}, y}, out, a]]
f3[{{} ..}, out__] := {{out}}
Example:
Sort @ f3 @ Gather @ {1, 2, 3, 2, 3, 2} === Sort @ Permutations @ {1, 2, 3, 2, 3, 2}
True
f3
is not nearly as efficient as perms
however,
x = {1, 1, 1, 1, 2, 2, 3, 4, 4, 5};
perms[x] // Length // RepeatedTiming
f3[Gather @ x] // Length // RepeatedTiming
{0.131, 37800} {1.03, 37800}