How can I more quickly get the interchangeable variables in a function?

Let’s say I have an expression like a b + c d e. This is equal to: a b + c d e, a b + c e d, a b + d c e, a b + d e c, a b + e c d, a b + e d c, b a + c d e, b a + c e d, b a + d c e, b a + d e c, b a + e c d, and b a + e d c

As you can see, swapping a and b will always result in an expression equal to the original expression and swapping c, d, and e will always result in an expression equal to the original expression.


The following code is too slow for more complicated expressions. Is there a speedier way to get Mathematica to give me all equivalence classes of swappable variables such that f[a b + c d e] == {{a, b}, {c, d, e}} for some f?

SwapVariables[expr_, variable1_, variable2_] := expr /. variable1 -> replacedInSwapVariablesFunction /. variable2 -> variable1 /. replacedInSwapVariablesFunction -> variable2;  VariablesIn[expr_] := Integrate`getAllVariables[{expr}, {}];  SwappableVariablesIn[expr_] := (   vars = VariablesIn[expr];   originalVars = vars;   results = {};   While[Length[vars] > 0, (     var = First[vars];     vars = Rest[vars];     swappable = Map[TrueQ[ForAll[originalVars, SwapVariables[expr, var, #] == expr]] &, vars];     results = Append[results, Prepend[Pick[vars, swappable], var]];     vars = Pick[vars, swappable, False];   )];   results );  SwappableVariablesIn[a b + c d e]  (* {{a,b},{c,d,e}} *) 

A function which can be used for a complicated expression to test timing:

DetNByN[n_] := Det[Table[Table[Indexed[x, {i, j}], {j, 1, n}], {i, 1, n}]];  First[Timing[SwappableVariablesIn[DetNByN[6]]]]  (* 10.7118 *)