12
$\begingroup$

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}
$\endgroup$
10
$\begingroup$
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] 

enter image description here

All except f9 produce the same result:

Equal @@ results

False

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

True

$\endgroup$
  • $\begingroup$ Nice work. I didn't expect Subtract to be faster than Differences; that didn't use to be the case I believe. $\endgroup$ – Mr.Wizard Jul 6 '18 at 13:02
  • $\begingroup$ "Your approach took too long to benchmark," is always a bad sign. $\endgroup$ – Pillsy Jul 6 '18 at 20:15
  • $\begingroup$ @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). $\endgroup$ – kglr Jul 6 '18 at 21:43
  • 1
    $\begingroup$ @Pillsy, I have had quite a few of those:) $\endgroup$ – kglr Jul 6 '18 at 22:38
  • $\begingroup$ It's worth adding the version of mine that @lasenH made faster, if you want! $\endgroup$ – march Jul 7 '18 at 20:18
6
$\begingroup$

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} *)
$\endgroup$
6
$\begingroup$

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.

Please add these to your performance test:

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@# &;
$\endgroup$
  • 1
    $\begingroup$ Thanks, Nice! Interesting method but what is the variable big? Apologies if I've missed something. $\endgroup$ – Awkward Panda Jul 5 '18 at 23:52
  • $\begingroup$ @AwkwardPanda sorry, mistake from my own testing. $\endgroup$ – Mr.Wizard Jul 6 '18 at 0:40
6
$\begingroup$

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

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} *)
$\endgroup$
  • 1
    $\begingroup$ (+1) i tried almost everything else with SequenceReplace:) $\endgroup$ – kglr Jul 4 '18 at 22:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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