# Set a repeating number to 0 within a list

Apologies for the simple nature but can't quite grasp a nice way of doing this.

take a list ~ m0 = Table[RandomInteger[], 20]

{1,1,0,1,0,1,0,0,0,0,1,1,1,1,1,1,1,0,1,1}

I want to send any 1 followed by a 1 to 0 such that the example would go to:

{0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,1}

I'm sure there is a quick and elegant way of doing this but it escapes me without a clunky method using ReplaceRepeated[].

Thanks if anyone has a go.

Edit*

Just for reference of timing:

In[27]:= m0
ReplaceRepeated[m0,{s___,1,1,e___} :>  {s,0,1,e}]//AbsoluteTiming
Out[27]= {1,1,0,1,0,1,0,0,0,0,1,1,1,1,1,1,1,0,1,1}
Out[28]= {0.0000940839,{0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,1}}


Edit*

Thanks for all the Interesting attempts! Here is the timings when scaled to a bigger list

In[205]:= m0//Length
ReplaceRepeated[m0,{s___,1,1,e___} :>  {s,0,1,e}];//RepeatedTiming
Flatten[Split[m0]/.{x__,1}:>{0{x},1}];//RepeatedTiming
Differences[Append[m0,0]]/.{-1->1,1->0};//RepeatedTiming
First/@(Partition[Append[m0,0],2,1]/.{1,1}->{0,0});//RepeatedTiming
Append[BitShiftRight@@@Partition[m0,2,1],Last@m0];//RepeatedTiming

Out[205]= 500
Out[206]= {0.0020,Null}
Out[207]= {0.0004,Null}
Out[208]= {0.000097,Null}
Out[209]= {0.00036,Null}
Out[210]= {0.00020,Null}


f1 = Flatten[Split[#] /. {x__, 1} :> {0{x} , 1}]&;
f1 @ m0


{0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1}

Also

f2 = Differences[Append[#, 0]] /. {-1 -> 1, 1 -> 0}&;
f2 @ m0


{0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1}

Update: Inspired by Mr.Wizard's post, an alternative way to use Differences:

f3 = 1 - UnitStep @ Differences @ Append[#, 0]&
f3 @ m0


{0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1}

f4 = 1 - UnitStep @ Subtract[Rest @ Append[#, 0] , #]&
f4 @ m0


{0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1}

Timings:

f5 = First /@ (Partition[Append[#, 0], 2, 1] /. {1, 1} -> {0, 0}) &; (* Fred Simons *)
f6 = Append[BitShiftRight @@@ Partition[#, 2, 1], Last @ #] &; (* march *)
f7 = Ramp @ ListCorrelate[{1, -1}, #, 1, 0] &; (* Mr. Wizard *)
f8 = Ramp @ Differences[-Append[#, 0]] &; (* Mr. Wizard *)
f9 = FixedPoint[SequenceReplace[{1, 1} -> Sequence[0, 1]], #] &; (* Pillsy*)
f10 = Append[BitShiftRight[Most[#], Rest[#]], Last[#]] &; (*march*)

SeedRandom[1]
m0 = RandomInteger[1, 5*^5];
functions = {f1, f2, f3, f4, f5, f6, f7, f8, f9, f10};
labels = {"f1", "f2", "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10"};
{timings, results} = ConstantArray[1, {2, 10}];

Table[timings[[i]] = First[RepeatedTiming[results[[i]] = functions[[i]][m0];]], {i, 10}];

Grid[Prepend[SortBy[Transpose[{labels, functions, timings}], Last],
{"function", SpanFromLeft, "timing"}], Dividers -> All]


All except f9 produce the same result:

Equal @@ results


False

 Equal @@ results[[{1,2,3,4,5,6,7,8,10}]]


True

• Nice work. I didn't expect Subtract to be faster than Differences; that didn't use to be the case I believe. – Mr.Wizard Jul 6 '18 at 13:02
• "Your approach took too long to benchmark," is always a bad sign. – Pillsy Jul 6 '18 at 20:15
• @Mr.Wizard, there was a recent post where timing comparisons of several functions were quite different in v9 vs v11 (can't find the link now). – kglr Jul 6 '18 at 21:43
• @Pillsy, I have had quite a few of those:) – kglr Jul 6 '18 at 22:38
• It's worth adding the version of mine that @lasenH made faster, if you want! – march Jul 7 '18 at 20:18

Another one, not as nice as those of @kglr:

First /@ (Partition[Append[m0, 0], 2,1] /. {1,1}->{0,0})

(* {0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,1} *)


Since it appears you are interested in performance I think you'll want to avoid replacements like /. {-1 -> 1, 1 -> 0} and use fast numeric functions instead.

Ramp @ ListCorrelate[{1, -1}, m0, 1, 0]

Ramp @ Differences[-Append[m0, 0]]      (* based on kglr's answer *)


Please also use a larger set like m0 = RandomInteger[1, 5*^5] so differences are not lost in noise.

If you are using a version before 11.0 when Ramp was introduced you can use:

Ramp = # * UnitStep@# &;

• Thanks, Nice! Interesting method but what is the variable big? Apologies if I've missed something. – Awkward Panda Jul 5 '18 at 23:52
• @AwkwardPanda sorry, mistake from my own testing. – Mr.Wizard Jul 6 '18 at 0:40

This should work.

Append[BitShiftRight @@@ Partition[m0, 2, 1], Last@m0]


Edit: a faster version based on a comment by lasenH:

Append[BitShiftRight[Most[m0], Rest[m0]], Last[m0]]

• Append[BitShiftRight[Most[m0], Rest[m0]], Last[m0]] is an order of magnitude faster – lasen H Jul 5 '18 at 14:53
• @lasenH. Thanks for that. That's great! I'll edit the post. – march Jul 7 '18 at 20:14

There's a slightly clunky way to do it with the new SequenceReplace function:

SequenceReplace[m0,
seq : {1 .., 1} :> Apply[Sequence, PadLeft[{1}, Length[seq]]]]
(* {0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1} *)


This one isn't going to run any races either (it's twice as slow as @kglr's f5 above, on my machine) but at least it's not too slow to benchmark:

f9 = FixedPoint[SequenceReplace[{1, 1} -> Sequence[0, 1]], #1] &;
f9[m0]
(* {0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0} *)

• (+1) i tried almost everything else with SequenceReplace:) – kglr Jul 4 '18 at 22:47