# Find and highlight sequence patterns in a list

Again, I have a list like this:

list={0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, \
0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, \
0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, \
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}


I want to search for the pattern: {1,0,0} and mark all the numbers matching this sequence in Red with the Style option. I tried to use Cases to help me out, which does not work. Checked the help a few times, but no idea so far :/

Cases[list, {1,0,0}]

• Something like : list //. {b__, PatternSequence[1, 0, 0], a__} -> {b, Sequence @@ (Style[#, Red] & /@ {1, 0, 0}), a} ? Aug 24, 2014 at 21:31
• @b.gatessucks very nice +1 but i'd put a___ and b___ - BlankNullSequence - to include boundary cases for more general situations. Aug 24, 2014 at 21:36
• @VitaliyKaurov Thanks Vitaly. Aug 24, 2014 at 21:37
• Thank you! What if I want to change the pattern sequence dynamically e.g. pattern={1,0,0,0};PatternSequence[pattern]. This does not work unfortunately Aug 24, 2014 at 21:58
• @holistic use PatternSequence @@ pattern will strip off the List head i.e. {}, of that pattern and make the pattern the argument of PatternSequence. Also, make sure to change the replacement to (Style[#, Red] & /@ pattern as well. Aug 24, 2014 at 22:16

Using string manipulations seems to speed things up significantly:

randomList = RandomInteger[{0, 1}, 1000];

m1 = randomList //. {b___, PatternSequence[1, 0, 0], a___} -> {b,
Sequence @@ (Style[#, Red] & /@ {1, 0, 0}), a} //
AbsoluteTiming;

m2 = StringSplit[StringJoin @@ (ToString /@ randomList),
"100" -> Sequence @@ (Style[#, Red] & /@ {1, 0, 0})] /.
s_String :> Sequence @@ (ToExpression /@ Characters[s]) //
AbsoluteTiming;

(* Checking answers from both methods *)
Equal @@ (Rest /@ {m1, m2})
(* True *)

(* Timings *)
First /@ {m1, m2}
(* {0.938379, 0.017024} *)

• After having verified your answer I deleted mine. Very very nice!
– eldo
Aug 24, 2014 at 23:38
• Your answer is actually just as fast as mine. The PatternSequence in the question's comment is the culprit of the slowness. Hope you could undelete it. Aug 24, 2014 at 23:47

Another functional approach using the Flat attribute:

(Credit to Mr Wizard for the clever form of the second line)

SetAttributes[f, Flat];
f[1, 0, 0] = Style[#, Red] & /@ f[1, 0, 0];
List @@ f @@ list

• Very nice! But why so verbose? f[1, 0, 0] = Style[#, Red] & /@ f[1, 0, 0]; :-) Aug 27, 2014 at 9:34
• @Mr.Wizard, ooh that's clever! I like it. Aug 27, 2014 at 10:52
• Flat has some very interesting effects. I need to learn to use it more, but it is rather counter-intuitive. +1 Aug 27, 2014 at 12:31

Using highlight from my answer to Formatting text through pattern matching:

ToString[list] /. highlight["1, 0, 0", Style[#, Red] &]


I keep on thinking how ListCorrelate sounds ideal for this but can't find a way. A functional way (but still slower) would be:

g[g[b__], d_] := g[b, d];
g[a___, 1, 0, 0] :=
Sequence[a, Sequence @@ (Style[#, Red] & /@ {1, 0, 0})]


and then using Fold:

List @@ Fold[g, First@list, Rest@list]


---EDIT---

which, after Mr Wizard's recommendation, can be written more compactly using the two-argument, undocumented form of Fold as

List @@ Fold[g, list]


list = {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0};

SequenceReplace[list, k : {1, 0, 0} :> Splice@(Style[#, Red] & /@ k)]


For versions prior to v12.1, use Sequence@@ instead of Splice.

SequenceReplace[list,
k : {1, 0, 0} :> Sequence @@ (Style[#, Red] & /@ k)]


Another variation could be:

SequenceReplace[list, k : {1, 0, 0} :> Splice@(Highlighted[#] & /@ k)]


Unfortunately, Sequence* functions are not as efficient (yet) as some of the other established list manipulation functions. It is a moot point, as this seems to be a visualization task.

A faster variant of Seismatica's answer:

List @@ StringReplace[StringJoin[ToString /@ list],
"100" -> {Style[1, Red], Style[0, Red], Style[0, Red]}] /.
x_String :> Table[0, {StringLength@x}] // Flatten


Here' s a time table running the functions 100 times over a random 0 | 1 list with 1000 members:

{a___, \$X, b_, c_, d___} /; b == c == 0 ^:=
{a, Splice[Style[#, Red] & /@ {1, 0, 0}], d}

list /. 1 -> $$X /.$$X -> 1