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} *)
Function
if I understood what you mean. For example:ex1={#1*#2*#3, #1*#2/#4, #4, #2, #2/#4}&
$\endgroup$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 $\endgroup$ex={#1*#2*#3, #1*#2/#4, #4, #2, #2/#4, #5}&
and check ifex1==ex@@{x,y,z,v,p} && ex2==ex@@{a,b,z,u,0}
$\endgroup$