# List manipulation: Find duplicates with respect to symmetry in sublists

I have the following list

list = {
{{"-", "-"}, {"+", "-"}, {"+", "-"}},
{{"-", "-"}, {"+", "-"}, {"+", "+"}},
{{"-", "-"}, {"+", "+"}, {"-", "-"}},
{{"-", "-"}, {"+", "+"}, {"-", "+"}},
{{"-", "+"}, {"-", "-"}, {"+", "-"}},
{{"-", "+"}, {"-", "-"}, {"+", "+"}},
{{"-", "+"}, {"-", "+"}, {"-", "-"}},
{{"-", "+"}, {"-", "+"}, {"-", "+"}},
{{"+", "-"}, {"+", "-"}, {"+", "-"}},
{{"+", "-"}, {"+", "-"}, {"+", "+"}},
{{"+", "-"}, {"+", "+"}, {"-", "-"}},
{{"+", "-"}, {"+", "+"}, {"-", "+"}},
{{"+", "+"}, {"-", "-"}, {"+", "-"}},
{{"+", "+"}, {"-", "-"}, {"+", "+"}},
{{"+", "+"}, {"-", "+"}, {"-", "-"}},
{{"+", "+"}, {"-", "+"}, {"-", "+"}}
};


I wish to perform the following manipulations on this list:

1. Replace first and last subelement in sublist. for example: the sublist {{"-","-"},{"+","-"},{"+","-"}} should be replace with the sublist {{0,"-"},{"+","-"},{"+",0}}.

2. The new list produces duplicates if considering the symmetry which I would like to eliminate. For example: the sublists {{0,"-"},{"+","-"},{"+",0}} and {{0,"+"},{"-","+"},{"-",0}} are considered as duplicates.

Can anyone advise on how to perform these list manipulations?

list[[All, 1, 1]] = 0;
list[[All, -1, -1]] = 0;
DeleteDuplicates[list, Reverse[Reverse /@ #1] == #2 &]

(* Out:
{
{{0, "-"}, {"+", "-"}, {"+", 0}},
{{0, "-"}, {"+", "-"}, {"+", 0}},
{{0, "-"}, {"+", "+"}, {"-", 0}},
{{0, "+"}, {"-", "-"}, {"+", 0}},
{{0, "-"}, {"+", "-"}, {"+", 0}},
{{0, "-"}, {"+", "-"}, {"+", 0}}
}
*)


This is my original answer, in which I misunderstood the requirements:

replaced = MapAt[If[# == "+", 1, 0] &, list, {{All, 1, 1}, {All, -1, -1}}]
DeleteDuplicates[replaced, Reverse[Reverse /@ #1] == #2 &]

(* Out:
{{{0, "-"}, {"+", "-"}, {"+", 0}},
{{0, "-"}, {"+", "-"}, {"+", 1}},
{{0, "-"}, {"+", "+"}, {"-", 0}},
{{0, "-"}, {"+", "+"}, {"-", 1}},
{{0, "+"}, {"-", "-"}, {"+", 0}},
{{0, "+"}, {"-", "-"}, {"+", 1}},
{{0, "+"}, {"-", "+"}, {"-", 1}},
{{1, "-"}, {"+", "-"}, {"+", 1}},
{{1, "-"}, {"+", "+"}, {"-", 1}},
{{1, "+"}, {"-", "-"}, {"+", 1}}}
*)

• why did you replace 0 and 1 and not just 0? Jan 22, 2021 at 18:47
• @jarhead Maybe I misunderstood. So you want the first and last element to become 0, independently of their original value? Jan 22, 2021 at 18:50
• yes. for this case I wish both edges to be with 0 Jan 22, 2021 at 18:53
• @jarhead OK sorry, I think I fixed it. Jan 22, 2021 at 19:04
• Is this answer correct? The first and last rows in the revised output are identical. Jan 22, 2021 at 19:46

A functional approach:

list // RightComposition[

(* Replace the extreme elements with 0 *)
MapAt[Replace[_ -> 0], {{All, 1, 1}, {All, -1, -1}}],

(* Delete duplicates after the appropriate considerations *)
DeleteDuplicatesBy[
(* Disregard the order of the pairs *)
Map[Apply[OrderlessPatternSequence]] /*
(* Disregard the overall order *)
Apply[OrderlessPatternSequence]
]

]

(*
{
{{0, "-"}, {"+", "-"}, {"+", 0}},
{{0, "-"}, {"+", "+"}, {"-", 0}},
{{0, "+"}, {"-", "-"}, {"+", 0}}
}
*)


Notice that this gives fewer elements than the accepted answer.

Notice also that the composite function of DeleteDuplicatesBy can be replaced with a more elegant function (i.e. one that does not require the application of OrderlessPatternSequence twice):

DeleteDuplicatesBy[
OperatorApplied[Apply, {1, 3, 2}][OrderlessPatternSequence, {0, 1}]
]


But that makes it harder to insert the explanatory comments.

EDIT

Corrected a misunderstanding on my part after @kglr pointed it out.

• The last one is a duplicate of the first, b/c OP says: "the sublists {{0,"-"},{"+","-"},{"+",0}} and {{0,"+"},{"-","+"},{"-",0}} are considered as duplicates."
– kglr
Jan 22, 2021 at 20:20
• Thanks for pointing that out. I thought the order of the middle elements was important. Otherwise, the solution is a bit simpler. Please see the edit. Jan 22, 2021 at 20:29

This, like @Shredderoy's method, eliminates duplicates

rubeGoldberg = MapAt[0 &, {{;; , 1, 1}, {;; , -1, -1}}] @*
DeleteDuplicatesBy[Sort @* ({#, Reverse @ #} &) @* Most @* Rest @* Flatten]

rubeGoldberg @ list // Column