13
$\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$
1

7 Answers 7

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$
6
  • $\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, 2018 at 13:02
  • $\begingroup$ "Your approach took too long to benchmark," is always a bad sign. $\endgroup$
    – Pillsy
    Jul 6, 2018 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, 2018 at 21:43
  • 1
    $\begingroup$ @Pillsy, I have had quite a few of those:) $\endgroup$
    – kglr
    Jul 6, 2018 at 22:38
  • $\begingroup$ It's worth adding the version of mine that @lasenH made faster, if you want! $\endgroup$
    – march
    Jul 7, 2018 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$
2
  • 1
    $\begingroup$ Thanks, Nice! Interesting method but what is the variable big? Apologies if I've missed something. $\endgroup$
    – Teabelly
    Jul 5, 2018 at 23:52
  • $\begingroup$ @AwkwardPanda sorry, mistake from my own testing. $\endgroup$
    – Mr.Wizard
    Jul 6, 2018 at 0:40
6
$\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
  • 2
    $\begingroup$ (+1) i tried almost everything else with SequenceReplace:) $\endgroup$
    – kglr
    Jul 4, 2018 at 22:47
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$
2
  • $\begingroup$ Append[BitShiftRight[Most[m0], Rest[m0]], Last[m0]] is an order of magnitude faster $\endgroup$
    – lasen H
    Jul 5, 2018 at 14:53
  • $\begingroup$ @lasenH. Thanks for that. That's great! I'll edit the post. $\endgroup$
    – march
    Jul 7, 2018 at 20:14
3
$\begingroup$
list = {1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1};

Using SequenceSplit (new in 11.3)

Flatten @ SequenceSplit[list, x : {1 ..} :> {Table[0, Length[x] - 1], 1}]

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

$\endgroup$
1
$\begingroup$
list = {1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1};

Using SequenceCases:

patts = {s : {1 ..} :> PadLeft[{1}, Length[s]], s : {0 ..} :> s};

Flatten[Riffle @@ Map[SequenceCases[list, #] &, patts]]

(*{0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1}*)
$\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.