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.
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"}}
ClearAll[f]; f[p_] := DeleteDuplicates[SortBy[#[[p]] == "x" &]@#, Drop[#, {p}] == Drop[#2, {p}] && MemberQ[{##}[[All, p]], "x"] &] &; f[3]@lis2? $\endgroup$ 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"}}
Using SequencePosition
Case 1: The x-pattern only occurs after
list = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}, {"p", "q", "f"}, {"p", "q", "x"}}; p = List @* Last /@ SequencePosition[list, {{a_, b_, _}, {a_, b_, "x"}}] {{3}, {6}}
Delete[p] @ list {{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}, {"p", "q", "f"}}
Case 2: The x-pattern can occur before or after
list = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}, {"p", "q", "x"}, {"p", "q", "f"}}; p = SequencePosition[list, {OrderlessPatternSequence[{a_, b_, _}, {a_, b_, "x"}]}] {{2, 3}, {5, 6}}
q = Intersection @@@ Transpose[{p, Position[list, "x"]}] {{3}, {5}}
Delete[q] @ list {{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}, {"p", "q", "f"}}
l1 = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}, {"p", "q", "f"}, {"p", "q", "x"}}; l2 = {{"a", "b", "c"}, {"d", "e", "f"}, {"d", "e", "x"}, {"g", "h", "i"}, {"p", "q", "x"}, {"p", "q", "f"}}; Grabbing the @eldo's examples and using GroupBy and DeleteCases:
Flatten[Values@GroupBy[l1, #[[1]] &, DeleteCases[#, {a__, "x"}] &], 1] (*{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}, {"p", "q", "f"}}*) Flatten[Values@GroupBy[l2, #[[1]] &, DeleteCases[#, {a__, "x"}] &], 1] (*{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}, {"p", "q", "f"}}*) 