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.

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

5 Answers 5

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

$\endgroup$
3
  • 2
    $\begingroup$ BitXor is a bit faster: erode[list_]:=BitXor[ArrayPad[list,{1,-1}], list]*list $\endgroup$
    – Ray Shadow
    Jun 11, 2017 at 21:46
  • $\begingroup$ @Shadowray Thanks, I included your suggestion. $\endgroup$
    – Carl Woll
    Jun 11, 2017 at 22:27
  • $\begingroup$ @CarlWoll, congratulations with 10k )) Can you explain about vectorized unary vs ectoized binary operations? $\endgroup$
    – iot
    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.

$\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$
    – Carl Woll
    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.

$\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}

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

$\endgroup$

Your Answer

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

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