I didn't consider the end effects carefully, but given your initial example,
I didn't worry about it. Here is a modified version:
f <- function(x, n) {
r <- rle(x)
# Sequence of start indices for zero replacement
t1 <- cumsum(r$lengths)[r$values == 0L] + 1
# Get rid of last element if sequence ends in zero
t1 <- t1[t1 <= length(x)]
# run lengths of ones
nOnes <- with(r, lengths[values == 1L])
# remove the first if the sequence starts with 1
if(r$values[1] == 1L) nOnes <- nOnes[-1]
# second term in sum takes the parallel minimum
# of run lengths of ones and the value 2
t2 <- t1 + pmin(nOnes - 1, 2)
# create vector of indices for zero replacement
repl <- as.vector(mapply(seq, t1, t1 + n - 1))
replace(x, repl, 0)
}
A test:
x <- rbinom(50, 1, 0.7)
rle(x)
Run Length Encoding
lengths: int [1:27] 2 1 3 2 2 1 2 1 4 1 ...
values : num [1:27] 1 0 1 0 1 0 1 0 1 0 ...
> rle(x)$lengths
[1] 2 1 3 2 2 1 2 1 4 1 2 2 2 2 1 1 1 1 8 1 2 1 2 1 1 1 2
rle(x)$lengths[rle(x)$values == 1L]
[1] 2 3 2 2 4 2 2 1 1 8 2 2 1 2
# I assume that no leading ones are replaced because there is no preceding
zero
> f(x, 3)
[1] 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1
1 1
[39] 1 0 0 0 0 0 0 0 0 0 0 0 0
> x
[1] 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1
1 1
[39] 1 0 1 1 0 1 1 0 1 0 1 1
Since only two run lengths of 1 after the initial one have a length greater
than three, this is fairly easy to verify. It seems to work.
system.time(f(sample(0:1, 1000000, replace = TRUE) , 3))
user system elapsed
6.59 0.03 6.63
shows that it is not as fast as the regex method from stackoverflow that you
cited, which makes sense since it entails more overhead in checking the
propriety of the indices to replace. regex has more efficent ways of
handling text replacement.
Dennis
On Fri, Sep 10, 2010 at 12:43 PM, skan <juanp...@gmail.com> wrote:
>
> Hello, Dennis
>
> Do you prefer your way or this one?
>
> http://stackoverflow.com/questions/3686982/r-adding-zeroes-after-old-zeroes-in-a-vector
> stackoverflow, Jonathan
> <quote rr <- rle(tmp)
> ## Pad so that it always begins with 1 and ends with 1
> if (rr$values[1] == 0) {
> rr$values <- c(1, rr$values)
> rr$lengths <- c(0, rr$lengths)
> }
> if (rr$values[length(rr$values)] == 0) {
> rr$values <- c(rr$values, 1)
> rr$lengths <- c(rr$lengths, 0)
> }
> zero.indices <- seq(from=2, to=length(rr$values), by=2)
> one.indices <- seq(from=3, to=length(rr$values), by=2)
> rr$lengths[zero.indices] <- rr$lengths[zero.indices] +
> pmin(rr$lengths[one.indices], n)
> rr$lengths[one.indices] <- pmax(0, rr$lengths[one.indices] - n)
> inverse.rle(rr)
>
>
>
> --
> View this message in context:
> http://r.789695.n4.nabble.com/adding-zeroes-after-old-zeroes-in-a-vector-tp2534824p2534995.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> R-help@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
