Isomorphic lists

Question

Is there a function that outputs True if lists are isomorphic (there exists a rule that changes the first list into the second one and inverse of the rule changes the second list into the first one) and False otherwise?

If there is no such function implemented in Mathematica, can you provide a shorter code than mine?

I was also considering that IsomorphicGraphQ can be somehow used to do the job but I did not find anything.

a = {1, 2, 2, 3};
b = {3, 7, 7, 8};
c = {3, 7, 7, 3};
d = {5, 3, 3, 1};
And @@ DuplicateFreeQ /@ (Transpose[#] // Union // Transpose) &@{a, b}
And @@ DuplicateFreeQ /@ (Transpose[#] // Union // Transpose) &@{b, c}
And @@ DuplicateFreeQ /@ (Transpose[#] // Union // Transpose) &@{a, d}
And @@ DuplicateFreeQ /@ (Transpose[#] // Union // Transpose) &@{a, b, d}
And @@ DuplicateFreeQ /@ (Transpose[#] // Union // Transpose) &@{a, b, c}

---

True
False
True
True
False

Answer 1

Not fully tested, but works for your examples:

SameStructureQ[a_, b_] := a == (b /. Reverse[DeleteDuplicatesBy[Thread[a -> b], First], 2])

You'd need to generalize if you want to do more than pairwise testing.

Answer 2

Here's another strategy based on "normalizing" a list by structure.

SameStructureQ[a_, b_] := Values[PositionIndex[a]] == Values[PositionIndex[b]]

This assumes that PositionIndex always works in the same deterministic order.

Answer 3

A variation of lericr's first answer

f = #1 == (#2 /. AssociationMap[Reverse] @ AssociationThread[#1 -> #2]) &

Cases 1 - 3

f @@@ {{a, b}, {b, c}, {a, d}}

{True, False, True}

Cases 4 - 5

f[a, b] && f[a, d]

True

f[a, b] && f[a, c]

False

Revision 1

Let it work with more than 2 lists

IsomorphicQ[a_, b_] := 
 Equal[a, b /. AssociationMap[Reverse] @ AssociationThread[a -> b]]
IsomorphicQ[a_, b__] := 
 And @@ Map[IsomorphicQ[a, #] &, {b}]

IsomorphicQ @@@ {{a, b}, {b, c}, {a, d}, {a, b, d}, {a, b, c}}

{True, False, True, True, False}

Answer 4

a = {1, 2, 2, 3};
b = {3, 7, 7, 8};
c = {3, 7, 7, 3};
d = {5, 3, 3, 1};

Using Counts

IsomorphicQ[x__] := Equal @@ Values @* Counts /@ {x}

IsomorphicQ[b, c]

False

IsomorphicQ[a, b, d]

True

IsomorphicQ @@@ {{a, b}, {b, c}, {a, d}, {a, b, d}, {a, b, c}}

{True, False, True, True, False}

Answer 5

isoQ = Apply[SameQ] @* Map[ArrayComponents];

{a, b, c, d} = {{1, 2, 2, 3}, {3, 7, 7, 8}, {3, 7, 7, 3}, {5, 3, 3, 1}};

isoQ /@ {{a, b}, {b, c}, {a, d}, {a, b, d}, {a, b, c}}

{True, False, True, True, False}