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 *) `