14
$\begingroup$

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}]
Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ Something like : list //. {b__, PatternSequence[1, 0, 0], a__} -> {b, Sequence @@ (Style[#, Red] & /@ {1, 0, 0}), a} ? $\endgroup$
    – b.gates.you.know.what
    Commented Aug 24, 2014 at 21:31
  • 1
    $\begingroup$ @b.gatessucks very nice +1 but i'd put a___ and b___ - BlankNullSequence - to include boundary cases for more general situations. $\endgroup$
    – Vitaliy Kaurov
    Commented Aug 24, 2014 at 21:36
  • $\begingroup$ @VitaliyKaurov Thanks Vitaly. $\endgroup$
    – b.gates.you.know.what
    Commented Aug 24, 2014 at 21:37
  • $\begingroup$ 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 $\endgroup$
    – holistic
    Commented Aug 24, 2014 at 21:58
  • 1
    $\begingroup$ @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. $\endgroup$
    – khanhnguyendata
    Commented Aug 24, 2014 at 22:16

7 Answers 7

Reset to default
8
$\begingroup$

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} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ After having verified your answer I deleted mine. Very very nice! $\endgroup$
    – eldo
    Commented Aug 24, 2014 at 23:38
  • $\begingroup$ 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. $\endgroup$
    – khanhnguyendata
    Commented Aug 24, 2014 at 23:47
14
$\begingroup$

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
Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Very nice! But why so verbose? f[1, 0, 0] = Style[#, Red] & /@ f[1, 0, 0]; :-) $\endgroup$
    – Mr.Wizard
    Commented Aug 27, 2014 at 9:34
  • $\begingroup$ @Mr.Wizard, ooh that's clever! I like it. $\endgroup$
    – Simon Woods
    Commented Aug 27, 2014 at 10:52
  • 2
    $\begingroup$ Flat has some very interesting effects. I need to learn to use it more, but it is rather counter-intuitive. +1 $\endgroup$
    – rcollyer
    Commented Aug 27, 2014 at 12:31
9
$\begingroup$

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

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

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

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]
Improve this answer
$\endgroup$
0
3
$\begingroup$

enter image description here enter image description here

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

enter image description here

Another variation could be:

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

enter image description here

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.

Improve this answer
$\endgroup$
2
$\begingroup$

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

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

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

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.