4
$\begingroup$

I have a list:

lis = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}}

I would like to remove elements from this list if the following condition is met.

Compare adjacent members of the list. If they are identical except for the third sub-element being "x", then delete the element that contains the "x"

This gives:

res = {{"a","b","c"},{"d","e","f"},{"g","h","i}}

Thanks for ideas.

$\endgroup$
5
$\begingroup$
DeleteDuplicates[SortBy[Last@# == "x" &] @ lis, 
   Most[#] == Most[#2] && MemberQ[Last /@ {##}, "x"] &]
{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}

Update: A more flexible approach using SequenceReplace + OrderlessPatternSequence:

ClearAll[f]
f = SequenceReplace[{OrderlessPatternSequence[
      p1 : {a___, _, b___}, {a___, "x", b___}]} :> p1];

Examples:

lis = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}};
lis2 = {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, {"d", "e", "x", "z"}, 
   {"g", "h", "i", "z"}, {"w", "x", "y", "z"}, {"w", "x", "x", "z"}};
lis3 = {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, {"d", "e", "x", "z"}, 
   {"g", "h", "i", "z"}, {"q", "r", "s", "t"}, {"q", "r", "x",  "t"}};

f @ lis
{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}
f @ lis2
 {{"a", "b", "c", "z"}, {"d", "e", "f", "z"},
  {"g", "h", "i", "z"}, {"w", "x", "y", "z"}}
f @ lis3
 {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, 
  {"g", "h", "i", "z"}, {"q", "r", "s", "t"}}
$\endgroup$
4
  • $\begingroup$ Generalization: how would this work with a slightly different data set, where the marker for deletion isn't the last member of the list element: say, lis =lis = {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, {"d", "e", "x", "z"}, {"g", "h", "i", "z"}, {"w", "x", "y", "z"}, {"w", "x", "x", "z"}} $\endgroup$
    – Suite401
    Sep 19 at 3:33
  • $\begingroup$ please ignore the above comment, the comment edit timed out before I finished my question.. Here is the correct comment: Generalization : how would this work with a slightly different data set, where the \ marker for deletion isn' t the last member of the list element : say, {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, {"d", "e", "x", "z"}, {"g", "h", "i", "z"}, {"q", "r", "s", "t"}, {"q", "r", "x", "t"}} with the desired res to be : {{"a", "b", "c", "z"}, {"d", "e", "f", "z"}, {"g", "h", "i", "z"}, {"q", "r", "s", "t"}} $\endgroup$
    – Suite401
    Sep 19 at 3:44
  • $\begingroup$ @Suite401, maybe something like: ClearAll[f]; f[p_] := DeleteDuplicates[SortBy[#[[p]] == "x" &]@#, Drop[#, {p}] == Drop[#2, {p}] && MemberQ[{##}[[All, p]], "x"] &] &; f[3]@lis2? $\endgroup$
    – kglr
    Sep 19 at 3:53
  • $\begingroup$ OK will give it a try. $\endgroup$
    – Suite401
    Sep 19 at 3:56
5
$\begingroup$

To do this via a rule substitution:

lis /. {a___, {b_, c_, d_}, {b_, c_, "x"}, e___} :> {a, {b, c, d}, e}

{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}

This can fail if the {b_, c_, "x"} pattern occurs before its identical match, however. We can fix this by including the alternative, though it is a bit verbose to do so:

lis /. {a___, 
   Alternatives[PatternSequence[{b_, c_, d_}, {b_, c_, "x"}], 
    PatternSequence[{b_, c_, "x"}, {b_, c_, d_}]], 
   e___} :> {a, {b, c, d}, e}

{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}

Also in the case that multiple matches are possible, ReplaceRepeated may be necessary:

lis = {{"a", "b", "c"}, {"d", "e", "x"}, {"d", "e", "f"}, {"d", "e", 
   "x"}, {"g", "h", "i"}};
lis //. {a___, 
   Alternatives[PatternSequence[{b_, c_, d_}, {b_, c_, "x"}], 
    PatternSequence[{b_, c_, "x"}, {b_, c_, d_}]], 
   e___} :> {a, {b, c, d}, e}

{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}

$\endgroup$
0

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.