10
$\begingroup$

How is it better to substitute list of random combination of 1 and 0 (binary image) so that only first (or central) instance of 1 left in each group.

list = {0,1,1,0,0,1,0,1,1,1,0} should be {0,1,0,0,0,1,0,1,0,0,0}

There should be a kind of Erosion but keeping 1s. I'm thinking about replacement rule.

Improve this question
$\endgroup$
4
  • 2
    $\begingroup$ list//. {a___, 1, 1, Shortest[b___]} :> {a, 1, 0, b} $\endgroup$ Commented Jun 11, 2017 at 20:32
  • 4
    $\begingroup$ Cases[Prepend[Differences[list], First[list]], x_ :> Boole[x == 1]] $\endgroup$ Commented Jun 11, 2017 at 20:34
  • 1
    $\begingroup$ @LouisB, you could use Ramp to get a really cool solution. $\endgroup$ Commented Jun 11, 2017 at 22:06
  • $\begingroup$ @garej Thanks for the Ramp suggestion. It's fast, too. I used it an answer. $\endgroup$ Commented Jun 12, 2017 at 0:43

6 Answers 6

Reset to default
10
$\begingroup$

Updated to include suggestions from comments

My original idea, using BitAnd, switching $0\leftrightarrow1$, and multiplying. This idea uses 3 vectorized binary operations:

erode1[list_] := Times[ list, Subtract[ 1, BitAnd[list, PadRight[list, Length@list, 0, 1]] ] ]

Here is @Shadowray's improvement, which uses 2 vectorized binary operations. In addition, ArrayPad is slightly faster than PadRight:

erode2[list_] := Times[ list, BitXor[list, ArrayPad[list, {1, -1}]] ]

Finally, here is an approach inspired by @garej and @LouisB, which uses 1 vectorized binary operation and 1 vectorized unary operation:

erode3[list_] := Ramp @ Subtract[ list, ArrayPad[list, {1, -1}] ]

Here is a comparison of there timings:

data = RandomInteger[1, 10^7]; r1 = erode1[data]; //RepeatedTiming r2 = erode2[data]; //RepeatedTiming r3 = erode3[data]; //RepeatedTiming r1 === r2 === r3

{0.101, Null}

{0.082, Null}

{0.078, Null}

True

vectorized unary vs binary operators

@io_tuta ask about vectorized unary vs binary operators. This answer (3496) provides a very nice description of vectorized (i.e. packed array) operations. As for the particular difference between unary and binary operators, I expect that unary operators ought to be faster than binary operators. Here is an example demonstrating this:

d1 = RandomReal[1, 10^7]; d2 = RandomReal[1, 10^7]; d1+d2; //RepeatedTiming UnitStep[d1]; //RepeatedTiming

{0.024, Null}

{0.019, Null}

The unary UnitStep operation is significantly faster than the binary Plus operation

Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ BitXor is a bit faster: erode[list_]:=BitXor[ArrayPad[list,{1,-1}], list]*list $\endgroup$ Commented Jun 11, 2017 at 21:46
  • $\begingroup$ @Shadowray Thanks, I included your suggestion. $\endgroup$ Commented Jun 11, 2017 at 22:27
  • $\begingroup$ @CarlWoll, congratulations with 10k )) Can you explain about vectorized unary vs ectoized binary operations? $\endgroup$ Commented Jun 12, 2017 at 3:02
8
$\begingroup$

The following function is based on the Ramp and Differences functions, as suggested in a comment by @garej . Its speed and low memory are surprising.

rampDiff[list_] := Ramp@Prepend[Differences[list], First[list]]

It was tested against the following functions from previous answers and comments:

ClearAll["Global`*"] erode1[list_] := Times[list, Subtract[1, BitAnd[list, PadRight[list, Length@list, 0, 1]]]] erode2[list_] := BitXor[ArrayPad[list, {1, -1}], list]*list fcn = Function[{list}, Replace[Split[list], l : {1, __} :> {1, ConstantArray[0, Length@l - 1]}, 1] // Flatten]; bruteForce[list_] := Join[{list[[1]]}, Table[If[list[[i - 1]] == list[[i]] == 1, 0, list[[i]]], {i, 2, Length[list]}]]; rep[a_] := a rep[{1, a___}] := {1, {a} - 1} repSplit[list_] := rep /@ Split@list // Flatten shortest[list_] := (list //. {a___, 1, 1, Shortest[b___]} :> {a, 1, 0, b}) caseDiff[list_] := Cases[Prepend[Differences[list], First[list]], x_ :> Boole[x == 1]]

The first test was to see that all of the functions give the same results. 

functions = { shortest, bruteForce, repSplit, fcn, caseDiff, erode2, erode1, rampDiff}; data = RandomChoice[{0, 1}, 10^4]; results = Through[functions[data]]; 1 == Length@Union@results (* True *)

The execution time and memory usage tests were conducted as follows.

Through[(Composition[AbsoluteTiming, MaxMemoryUsed, #] & /@ functions)[data]]; μsecs = Round[Transpose[{1000000, 1} Transpose[%]], 1]; Grid[Prepend[μsecs, {"μ-secs", "Bytes"}], Alignment -> {Right, Baseline}] (* μ-secs Bytes 600599 321656 7894 169720 6166 813704 4284 848216 5789 1291216 2737 720384 344 320856 230 160408 *)

In this test the rampDiff function edged out erode1 in speed and bruteForce in low memory usage. Thanks to @garej for suggesting it.

Improve this answer
$\endgroup$
1
  • $\begingroup$ The difference between your testing and mine is that your data is not packed, while my data was packed. If you were to repeat your tests with packed data, you would find that your solution is slower than both erode1 and erode2. $\endgroup$ Commented Jun 12, 2017 at 1:05
6
$\begingroup$

First Split the list into runs of zeros and ones:

split = Split[list] 
{{0}, {1, 1}, {0, 0}, {1}, {0}, {1, 1, 1}, {0}}

Then process the lists of ones with length greater than one. One method is with a replacement rule, though a functional approach might be a bit faster:

Replace[split, l : {1, ___} :> {1, ConstantArray[0, Length@l - 1]}, 1] 
{{0}, {1, {0}}, {0, 0}, {1}, {0}, {1, {0, 0}}, {0}}

and finally Flatten to get the desired output:

Flatten @ % 
{0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0}

Putting it all together:

fcn = Function[{list}, Replace[Split[list], l : {1, __} :> {1, ConstantArray[0, Length@l - 1]}, 1] // Flatten ] fcn @ list 
{0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0}

Note: We could have used Sequence@@ConstantArray[...] in the second step, but I didn't bother since we were planning to flatten the list anyway.

Improve this answer
$\endgroup$
5
$\begingroup$ 
rep[a_] := a rep[{1, a___}] := {1, {a} - 1} rep /@ Split@list // Flatten

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

Improve this answer
$\endgroup$
4
$\begingroup$

Here's an approach using Table that is mid-way in terms of speed:

bruteForce[list_] := Join[{list[[1]]}, Table[If[list[[i - 1]] == list[[i]] == 1, 0, list[[i]]], {i, 2, Length[list]}]]; data = RandomInteger[1, 10^6]; r1 = erode[data]; // MaxMemoryUsed // AbsoluteTiming r2 = fcn[data]; // MaxMemoryUsed // AbsoluteTiming r3 = bruteForce[data]; // MaxMemoryUsed // AbsoluteTiming r1 === r2 r1 === r3

{0.0101832, 16000656}

{0.395556, 84964056}

{0.0529076, 16000760}

True

True

Improve this answer
$\endgroup$
1
$\begingroup$

Using SequenceReplace:

list = {0, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0}; SequenceReplace[list, k : {1 .., 0} :> Sequence[1, Sequence @@ ConstantArray[0, Length@k - 1]]] (* or *) FixedPoint[ SequenceReplace[#, {1, 1, 0} -> Sequence @@ {1, 0, 0}] &, list]

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

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.