[R] updating elements of a vector sequentially - is there a faster way?

[Noia Raindrops]

Hello,

Each block of probs range from p00 to p10 is last value before the block.

Example:
  probs: .1 .1 .5 .5 .5 .9 .9
  vec1 :  0  0  0  0  0  1  1
  
  probs: .9 .9 .5 .5 .5 .1 .1
  vec1 :  1  1  1  1  1  0  0

So you can eliminate a loop.


# modification 
f5 <- function () {
  vec1 <- as.numeric(as.character(cut(probs, breaks = c(0, p00, p10, 1), labels = c(0, 0.5, 1), include.lowest = TRUE, right = FALSE)))
  # = ifelse(probs < p10, ifelse(probs < p00, 0, 0.5), 1)
  vec1 <- replace(vec1, 1, 0)
  vec1 <- rle(vec1)
  vec1 <- within(unclass(vec1), values[values == 0.5] <- values[which(values == 0.5) - 1])
  vec1 <- inverse.rle(vec1)
  vec1
}

# original
f1 <- function() {
  vec1 <- rep(0, length(probs))
  for (i in 2:length(probs)) {
    vec1[i] <- ifelse(vec1[i-1] == 0,
                 ifelse(probs[i] < p10, 0, 1),
                 ifelse(probs[i] < p00, 0, 1))
  }
  vec1
}

f2 <- function(vec1) {
  val.p10 <- ifelse(probs < p10, 0, 1)
  val.p00 <- ifelse(probs < p00, 0, 1)
  vec1 <- rep(0, length(probs))
  for (i in 2:length(probs)) {
    vec1[i] <- if(vec1[i-1] == 0) val.p10[i] else val.p00[i]
  }
  vec1
}

f3 <- function () {
  a10 <- ifelse(probs < p10, 0, 1)
  a00 <- ifelse(probs < p00, 0, 1)
  vec1 <- ifelse(a10 == a00, a10, NA)
  vec1[1] <- 0
  n <- length(vec1)
  while (any(is.na(vec1))) {
    shift <- c(NA, vec1[-n])
    vec1 <- ifelse(is.na(vec1), shift, vec1)
  }
  vec1
}

f4 <- function () {
  a10 <- ifelse(probs < p10, 0, 1)
  a00 <- ifelse(probs < p00, 0, 1)
  vec1 <- ifelse(a10 == a00, a10, NA)
  vec1[1] <- 0
  n <- length(vec1)
  while (1) {
    i <- which(is.na(vec1))
    if (length(i) == 0) break
    vec1[i] <- vec1[i-1]
  }
  vec1
}

set.seed(1)
probs <- runif(10000)
p10 <- 0.6
p00 <- 0.4

identical(f1(), f2())
## [1] TRUE
identical(f1(), f3())
## [1] TRUE
identical(f1(), f4())
## [1] TRUE
identical(f1(), f5())
## [1] TRUE

# with random probs
rbenchmark::benchmark(f1(), f2(), f3(), f4(), f5(), columns = c("test", "replications", "elapsed", "relative"), replications = 100)
##   test replications elapsed  relative
## 1 f1()          100  31.456 42.279570
## 2 f2()          100   4.879  6.557796
## 3 f3()          100   2.503  3.364247
## 4 f4()          100   0.939  1.262097
## 5 f5()          100   0.744  1.000000

# with biased probs
probs <- rep(0.5, 1000)
rbenchmark::benchmark(f1(), f2(), f3(), f4(), f5(), columns = c("test", "replications", "elapsed", "relative"), replications = 100)
##   test replications elapsed   relative
## 1 f1()          100   2.917  30.385417
## 2 f2()          100   0.448   4.666667
## 3 f3()          100  32.439 337.906250
## 4 f4()          100   3.635  37.864583
## 5 f5()          100   0.096   1.000000


-- 
Noia Raindrops
noia.raindrops at gmail.com