Find 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} ? –  b.gatessucks Aug 24 '14 at 21:31
@b.gatessucks very nice +1 but i'd put a___ and b___ - BlankNullSequence - to include boundary cases for more general situations. –  Vitaliy Kaurov Aug 24 '14 at 21:36
@VitaliyKaurov Thanks Vitaly. –  b.gatessucks Aug 24 '14 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 –  holistic Aug 24 '14 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. –  seismatica Aug 24 '14 at 22:16

5 Answers

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 '14 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. –  seismatica Aug 24 '14 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]; :-) –  Mr.Wizard Aug 27 '14 at 9:34
@Mr.Wizard, ooh that's clever! I like it. –  Simon Woods Aug 27 '14 at 10:52
Flat has some very interesting effects. I need to learn to use it more, but it is rather counter-intuitive. +1 –  rcollyer Aug 27 '14 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]

-

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:

-