3
$\begingroup$

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?

Improve this question
$\endgroup$

3 Answers 3

Reset to default
2
$\begingroup$

New answer, with proper requirements:

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}}}
*)
Improve this answer
$\endgroup$
5
  • $\begingroup$ why did you replace 0 and 1 and not just 0? $\endgroup$
    – jarhead
    Jan 22, 2021 at 18:47
  • $\begingroup$ @jarhead Maybe I misunderstood. So you want the first and last element to become 0, independently of their original value? $\endgroup$
    – MarcoB
    Jan 22, 2021 at 18:50
  • $\begingroup$ yes. for this case I wish both edges to be with 0 $\endgroup$
    – jarhead
    Jan 22, 2021 at 18:53
  • $\begingroup$ @jarhead OK sorry, I think I fixed it. $\endgroup$
    – MarcoB
    Jan 22, 2021 at 19:04
  • 1
    $\begingroup$ Is this answer correct? The first and last rows in the revised output are identical. $\endgroup$
    – Shredderroy
    Jan 22, 2021 at 19:46
3
$\begingroup$

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.

Improve this answer
$\endgroup$
2
  • $\begingroup$ The last one is a duplicate of the first, b/c OP says: "the sublists {{0,"-"},{"+","-"},{"+",0}} and {{0,"+"},{"-","+"},{"-",0}} are considered as duplicates." $\endgroup$
    – kglr
    Jan 22, 2021 at 20:20
  • $\begingroup$ 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. $\endgroup$
    – Shredderroy
    Jan 22, 2021 at 20:29
2
$\begingroup$

This, like @Shredderoy's method, eliminates duplicates

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

rubeGoldberg @ list // Column

enter image description here

Improve this answer
$\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.