2
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Ruud3.1415 Jan 25 '18 at 14:47
  • $\begingroup$ @Ruud3.1415 The list is designed in this form for a specific purpose to be used later on. So it should not be flattened. $\endgroup$ – Majis Jan 25 '18 at 15:07
3
$\begingroup$

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

$\endgroup$
2
$\begingroup$

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}}
   } 
*)
$\endgroup$
1
$\begingroup$

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}}}}}} *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.