Equality of expressions with different variable names

Question

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?

Answer 1

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

Answer 2

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}