performance tuning – 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 *)