Find and highlight sequence patterns in a list

Question

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.gates.you.know.what, 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
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

Simon Woods · Answer 1 · 2014-08-27T10:55:21.700

14

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

edited Aug 27 '14 at 10:55

answered Aug 25 '14 at 16:33

Simon Woods

84,945
8
175
324

1

Very nice! But why so verbose? f[1, 0, 0] = Style[#, Red] & /@ f[1, 0, 0]; :-) – Mr.Wizard Aug 27 '14 at 09:34
@Mr.Wizard, ooh that's clever! I like it. – Simon Woods Aug 27 '14 at 10:52
2

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

score 9 · Answer 2 · edited Apr 13 '17 at 12:55

9

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

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

enter image description here

edited Apr 13 '17 at 12:55

Community

1

answered Aug 25 '14 at 07:54

Mr.Wizard

271,378
34
587
1,371

score 8 · Accepted Answer · answered Aug 24 '14 at 22:49

8

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} *)

answered Aug 24 '14 at 22:49

seismatica

5,101
1
22
33

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

score 5 · Answer 4 · edited Apr 13 '17 at 12:55

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]

enter image description here

---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]

score 3 · Answer 5 · answered Apr 17 '23 at 04:33

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.

score 2 · Answer 6 · answered Aug 27 '14 at 12:07

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:

enter image description here

kglr · Answer 7 · 2023-04-17T22:17:36.053

1

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

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

edited Apr 17 '23 at 22:17

answered Aug 24 '14 at 21:36

kglr

394,356
18
477
896

Find and highlight sequence patterns in a list

7 Answers7

Linked