# How to remove duplicate elements from a nested list?

Consider a list as

list = Table[{{i, j}, {k, l}}, {i, 1, 2, 1}, {j, 1, 2, 1}, {k, 1, 2,
1}, {l, 1, 2, 1}];


The outcome of this is:

{{{{{{1, 1}, {1, 1}}, {{1, 1}, {1, 2}}}, {{{1, 1}, {2, 1}}, {{1,
1}, {2, 2}}}}, {{{{1, 2}, {1, 1}}, {{1, 2}, {1, 2}}}, {{{1,
2}, {2, 1}}, {{1, 2}, {2, 2}}}}}, {{{{{2, 1}, {1, 1}}, {{2,
1}, {1, 2}}}, {{{2, 1}, {2, 1}}, {{2, 1}, {2, 2}}}}, {{{{2,
2}, {1, 1}}, {{2, 2}, {1, 2}}}, {{{2, 2}, {2, 1}}, {{2, 2}, {2,
2}}}}}}


I consider, {{a, b}, {c, d}}} and {{c, d}, {a, b}}} as duplicate and I want to remove the duplicates from the list.

I further wish to remove elements of the form {{a, b}, {a, b}}} (This is answered here. However, I don't know how to accomplish the first task and do both the operations together using Pick or DeleteCases).

It would be more appreciable if some conditioning can be imposed while constructing the list itself to accomplish the above-mentioned tasks.

• I do not get what your question is. Your lis has Dimensions {2, 2, 2, 2, 2, 2}, it seems to me that you are talking about a 2x2xn list, if that is right can you flatten it down in the right way for us first? – Ruud3.1415 Jan 25 '18 at 14:47
• @Ruud3.1415 The list is designed in this form for a specific purpose to be used later on. So it should not be flattened. – Majis Jan 25 '18 at 15:07

The list ... should not be flattened.

ClearAll[orderlessDeDupe]
orderlessDeDupe = Module[{g},
g[{r_, r_}] := Sequence[];
g[{r_, s_}] := (g[{r, s}] = g[{s, r}] = Sequence[]; {r, s});
Map[g, #, {-3}]]&;

orderlessDeDupe @ list


{{{{{{1, 1}, {1, 2}}}, {{{1, 1}, {2, 1}}, {{1, 1}, {2, 2}}}},
{{}, {{{1, 2}, {2, 1}}, {{1, 2}, {2, 2}}}}},
{{{}, {{{2, 1}, {2, 2}}}}, {{}, {}}}}

If you want to delete the empty sets, use ReplaceRepeated:

% //. {} -> Sequence[]


{{{{{{1, 1}, {1, 2}}},
{{{1, 1}, {2, 1}}, {{1, 1}, {2, 2}}}},
{{{{1, 2}, {2, 1}}, {{1, 2}, {2, 2}}}}},
{{{{{2, 1}, {2, 2}}}}}}

Note: If it weren't for the requirement to keep the structure intact, we could have simply done

Subsets[Tuples[{1, 2}, {2}], {2}]


{{{1, 1}, {1, 2}}, {{1, 1}, {2, 1}}, {{1, 1}, {2, 2}}, {{1, 2}, {2, 1}}, {{1, 2}, {2, 2}}, {{2, 1}, {2, 2}}}

Update: An alternative method deleting the positions of unwanted pairs:

ClearAll[orderlessDeDupe2]
orderlessDeDupe2[list_] := Module[{level3pos = Position[list, _, {-3}],
pos = Position[list, Alternatives @@ Subsets[Tuples[{1, 2}, {2}], {2}]]},
Delete[list, Complement[level3pos, pos]]]

orderlessDeDupe2[list] == orderlessDeDupe[list]


True

Or:

Cases[Union[Tuples[{1, 2}, {2, 2}], SameTest -> ((Reverse[#1] == #2) &)],
{a_, b_} /; a != b
]

(* {
{{1, 1}, {1, 2}}, {{1, 1}, {2, 1}}, {{1, 1}, {2, 2}},
{{1, 2}, {2, 1}}, {{1, 2}, {2, 2}}, {{2, 1}, {2, 2}}
}
*)


Here is a solution that uses built-in functions only:

list =
Table[{{i, j}, {k, l}}, {i, 1, 2, 1}, {j, 1, 2, 1}, {k, 1, 2,
1}, {l, 1, 2, 1}];

pos =
Map[Position[list, # | Reverse[#], Infinity] &, Flatten[list, 3]];
Length /@ pos
(* {1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 1} *)

list2 =
Fold[If[Length[#2] == 1, #1,
ReplacePart[#1, Rest[#2] -> Nothing]] &, list, pos];

res = DeleteCases[list2, {{a_, b_}, {a_, b_}}, Infinity] //. {} -> Nothing

(* {{{{{{1, 1}, {1, 2}}}, {{{1, 1}, {2, 1}}, {{1, 1}, {2,
2}}}}, {{{{1, 2}, {2, 1}}, {{1, 2}, {2, 2}}}}}, {{{{{2, 1}, {2,
2}}}}}} *)