# Equality of expressions with different variable names

I have some multivariate systems of expressions that I want to check for equality up to allowing relabelling of the variables. For example the two expressions below would be the same:

ex1={x*y*z, x*y/v, v, y, y/v}
ex2={a*b*z, z*b/u, u, b, b/u}


Ideally I also want to allow for setting a variable to 0 as well:

ex1={x*y*z, x*y/v, v, y, y/v, p}
ex2={a*b*z, z*b/u, u, b, b/u, 0}


But these two would not be equal

ex1={x*y*z, x*y/v, v, y, y/v, p,0}
ex2={a*b*z, z*b/u, u, b, b/u, 0,q}


How can I recognize this kind of equality up to variable relabeling and zeroing?

• This is the textbook use of Function if I understood what you mean. For example: ex1={#1*#2*#3, #1*#2/#4, #4, #2, #2/#4}& Commented Nov 21, 2021 at 17:47
• How do I then check for equality of that kind of expression? For example: ex1 = {#1*#2*#3, #1*#2/#4, #4, #2, #2/#4} &; ex2 = {#4*#3*#2, #4*#3/#1, #1, #3, #3/#1} &; SameQ[ex1, ex2] (*False*) But I want this to evaluate True Commented Nov 21, 2021 at 18:08
• Simply define a function as ex={#1*#2*#3, #1*#2/#4, #4, #2, #2/#4, #5}& and check if ex1==ex@@{x,y,z,v,p} && ex2==ex@@{a,b,z,u,0} Commented Nov 21, 2021 at 18:18
• Those evaluate as false for me Commented Nov 21, 2021 at 22:04

This is a very naive approach by generating all possible relabelings. Function findIsomorphism returns one of the possible relabelings or False if none is found.

getSymbols[m_] := DeleteDuplicates@Cases[m, _Symbol, Infinity];

findIsomorphism[ex1_, ex2_] := Module[{sym1, sym2, perms, eq},
sym1 = getSymbols[ex1];
sym2 = getSymbols[ex2];

If[Length@sym1 != Length@sym2, Return[False]];

perms = MapThread[#1 -> #2 &, {sym1, #}] & /@ Permutations[sym2];

eq = ((ex1 /. #) === ex2) & /@ perms;

If[NoneTrue[eq, TrueQ], False, First@perms[[FirstPosition[eq, True]]]]
]

findIsomorphism[{x, y}, {a, b}]
(* {x -> a, y -> b} *)

findIsomorphism[{x + y, z}, {a - b, c}]
(* False *)

findIsomorphism[{x*y*z, x*y/v, v, y, y/v}, {a*b*z, z*b/u, u, b, b/u}]
(* {x -> z, y -> b, z -> a, v -> u} *)


To allow for the variables being 0, we can include 0 as a "dummy" variable.

findIsomorphismAllowZero[ex1_, ex2_] :=
Module[{sym1, sym2, perms, eq, exx1, exx2},
sym1 = getSymbols[ex1];
sym2 = getSymbols[ex2];

If[Length@sym1 < Length@sym2,
{sym1, sym2} = {sym2, sym1}; {exx1, exx2} = {ex2, ex1},
{exx1, exx2} = {ex1, ex2}
];

perms =
MapThread[#1 -> #2 &, {sym1, #}] & /@
Permutations[
sym2~Join~ConstantArray[0, Length@sym1], {Length@sym1}];

eq = ((exx1 /. #) === exx2) & /@ perms;

If[NoneTrue[eq, TrueQ], False, First@perms[[FirstPosition[eq, True]]]]
]

findIsomorphismAllowZero[{x, y}, {a, 0}]
(* {x -> a, y -> 0} *)

findIsomorphismAllowZero[{0, x}, {a, b}]
(* {a -> 0, b -> x} *)

findIsomorphismAllowZero[{x, y}, {a + b, c}]
(* {a -> x, b -> 0, c -> y} *)

Quiet@findIsomorphismAllowZero[{x*y*z, x*y/v, v, y, y/v, p}, {a*b*z,
z*b/u, u, b, b/u, 0}]
(* {x -> z, y -> b, z -> a, v -> u, p -> 0} *)

• This is probably too computationally intensive for my purposes as I am going to repeat this many times Commented Nov 21, 2021 at 22:04
• Have you tried it and measure the timing? It takes 30 ms for the last case on my laptop. What is the performance goal you want to reach? Commented Nov 22, 2021 at 11:25
• I just did some testing and it's more efficient than I thought it would be Commented Nov 22, 2021 at 17:18
• This does work however when the number of variables grows the number permutations grows too fast for this to be practical in my case (~20 variables in each expression) Commented Nov 22, 2021 at 18:12
• @David, you are absolutely right. You had four variables in your initial question, so I did not think you needed a solution for up to 20 (or even more?). I guess the code could be optimized to generate permutations on each of the term in a list separately. This would help if not all 20 of them appear in the same element. Commented Nov 22, 2021 at 19:01

We can Replace the leaves of an expression with Patterns and use the resulting patterns with MatchQ:

ClearAll[exprToPattern, isomorphicExpressionsQ]

exprToPattern = Replace[
Replace[#, $$s_Symbol :> pattern[$$s, Blank[]], {-1}],
{p : pattern[_, Blank[]] :> (p | _?NumericQ),
p_?NumericQ :> (p | _)}, 1] /. pattern -> Pattern &;

isomorphicExpressionsQ = MatchQ[exprToPattern@#] @ #2 && MatchQ[exprToPattern@#2] @ #1 &;


Examples:

exa1 = {x*y*z, x*y/v, v, y, y/v}
exa2 = {a*b*z, z*b/u, u, b, b/u}

isomorphicExpressionsQ[exa1, exa2]

True

exb1 = {x*y*z, x*y/v, v, y, y/v, p}
exb2 = {a*b*z, z*b/u, u, b, b/u, 0}
exb3 = {a*b*z, z*b/u, u, b, b/u, q + 3}

isomorphicExpressionsQ @@@ Subsets[{exb1, exb2, exb3}, {2}]

{True, False, False}

exc1 = {x*y*z, x*y/v, v, y, y/v, p, 0}
exc2 = {a*b*z, z*b/u, u, b, b/u, 0, q}
exc3 = {a*b*z, z*b/u, u, b, b/u, 0, q + 3}

isomorphicExpressionsQ @@@ Subsets[{exc1, exc2, exc3}, {2}]

{True, False, False}