# Extraction of sublists containing certain sequence pairs

 list =
{{a, b, c, d, a},
{e, f, a, b, c, d},
{a, b, p, q, c, d, g, h},
{c, d, p, q, a, b},
{a, c, b, d}};


I want to filter sublists of list based upon two conditions:

(1) sublist must contain (a, b) AND (c, d)

y = {a, b} | {c, d};


(2) AND sublist must NOT contain (e, f) OR (g, h)

n = {e, f} | {g, h};


Duplicated pairs within a sublist like {a,b,c,d,a,b} don't occur.

I came up with the following solution:

Extract[#, Position[SequenceCases[#, y] & /@ #, {_, _}, 1]]& @
Delete[list, Position[SequenceCases[#, n] & /@ list, {{_, _}}, 1]]


{{a, b, c, d, a}, {c, d, p, q, a, b}}

I am, of course, not happy with the serial Extract / Delete. Which alternative solutions would you suggest?

• Why is {a,b,c,d} i.e., the last entry not part of the desired answer? It has {a,b,c,d} and none of {e,f,g,h}. Never mind you are talking about sequence pairs. Sorry about that.
– Syed
Commented Jan 19 at 10:11
• The last entry is {a, c, b, d} and not {a, b, c, d} as you suggest. The latter would qualify, the first not.
– eldo
Commented Jan 19 at 10:16

list = {{a, b, c, d, a}, {e, f, a, b, c, d}, {a, b, p, q, c, d, g,
h}, {c, d, p, q, a, b}, {a, c, b, d}};

delpatt = {a, Except[b]} | {c, Except[d]} | {e, f} | {g, h};


The idea is to mark any unwanted pattern as "X" and then delete any sublists containing "X".

SequenceReplace[#, delpatt :> "X" ] & /@ list //
DeleteCases[_?(ContainsAny[{"X"}])]


{{a, b, c, d, a}, {c, d, p, q, a, b}}

• Slightly shorter: // Select[FreeQ @ "X"]
– eldo
Commented Jan 20 at 13:24
• Thanks for the tip and the accept. SequenceReplace can take an additional argument which is the number of replacements. To be discarded, the sublist needs to have one "X" only. This option may become useful if sublists have a longer length.
– Syed
Commented Jan 20 at 13:29
selectBySequenceCounts[seqs_List, counts_List] :=
Select[$$x |-> counts == Map[SequenceCount[$$x, #] &]@seqs]


Examples:

y = {a, b} | {c, d};

n = {e, f} | {g, h};

list = {{a, b, c, d, a},
{e, f, a, b, c, d},
{a, b, p, q, c, d, g, h},
{c, d, p, q, a, b},
{a, c, b, d},
{a, b, c, d, a, b}};

selectBySequenceCounts[{## & @@ y, n}, {1, 1, 0}] @ list

 {{a, b, c, d, a}, {c, d, p, q, a, b}}


"Duplicated pairs within a sublist like {a,b,c,d,a,b} don't occur."

list2 = {{a, b, c, d, a, b}};

selectBySequenceCounts[{## & @@ y, n}, {1, 1, 0}] @ list2

{}

list = {{a, b, c, d, a}, {e, f, a, b, c, d}, {a, b, p, q, c, d, g, h},
{c, d, p, q, a, b}, {a, c, b, d}};

y = {a, b} | {c, d};

n = {e, f} | {g, h};


Using Select:

test = (FreeQ[#, n] && ! FreeQ[#, y]) &;

part = Partition[#, 2, 1] & /@ list;

Function[s, {Splice@s[[All, 1]], s[[-1, 2]]}] /@ Select[part, test]

(*{{a, b, c, d, a}, {c, d, p, q, a, b}}*)


Or using Pick:

Pick[list, test /@ part]

(*{{a, b, c, d, a}, {c, d, p, q, a, b}}*)


Another way using SequenceSplit and Pick:

Pick[#, test@Cases[{_, _}]@SequenceSplit[#, s : y :> s] & /@ #] &@list

(*{{a, b, c, d, a}, {c, d, p, q, a, b}}*)