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$
  • 2
    $\begingroup$ list//. {a___, 1, 1, Shortest[b___]} :> {a, 1, 0, b} $\endgroup$ – wxffles Jun 11 '17 at 20:32
  • 4
    $\begingroup$ Cases[Prepend[Differences[list], First[list]], x_ :> Boole[x == 1]] $\endgroup$ – LouisB Jun 11 '17 at 20:34
  • 1
    $\begingroup$ @LouisB, you could use Ramp to get a really cool solution. $\endgroup$ – garej Jun 11 '17 at 22:06
  • $\begingroup$ @garej Thanks for the Ramp suggestion. It's fast, too. I used it an answer. $\endgroup$ – LouisB Jun 12 '17 at 0:43
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$
  • 2
    $\begingroup$ BitXor is a bit faster: erode[list_]:=BitXor[ArrayPad[list,{1,-1}], list]*list $\endgroup$ – Shadowray Jun 11 '17 at 21:46
  • $\begingroup$ @Shadowray Thanks, I included your suggestion. $\endgroup$ – Carl Woll Jun 11 '17 at 22:27
  • $\begingroup$ @CarlWoll, congratulations with 10k )) Can you explain about vectorized unary vs ectoized binary operations? $\endgroup$ – iot Jun 12 '17 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$
  • $\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 '17 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, privacy policy and cookie policy

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