Fast implementation of binary (true/false) forward looking flag

1_forwardflag.r

forwardflag <- function(bools, ...) {
  if(typeof(bools) != "boolean") {
    warning("input variable not of boolean type, the only other accepted type is 0 & 1")
  }
  forwardflag_(bools, ...)
}


forwardflag_ <- function(bools, period = 12) {
  stopifnot(period > 0)
  l <- length(bools)
  stopifnot(l > 0)
  
  if(l == 1) {
    return(NA)
  } else if(l <= 12) {
    return(c((cumsum(rev(bools)) >= 1)[-l],NA))
  }
  
  cs <- cumsum(bools[2:l])
  
  c((cs[period:(l-1)] - cs[1:(l-period)]) >= 1, forwardflag2_(bools[(l-period+1):l]))
}

2_example.r

# example usage
library(data.table)
set.seed(1)
ss <- sample(1:100,200000, replace= T)
cust_id <- rep(1:200000,ss)

a <- data.table(cust_id = cust_id, currently_in_default = sample(c(0,1), length(cust_id), replace = T))
system.time(a[,f12m_flag := forwardflag_(currently_in_default == 1), by = cust_id])

3_slow_attempts_DONT_use.r

forwardflag2_ <- function(bools, period = 12) {
  l <- length(bools)
  stopifnot(l > 0)
  
  if(l == 1) {
    return(NA)
  }
  i <- 2:l
  j <- i + period-1
  
  c(mapply(function(i,j) {
    any(bools[i:j], na.rm=T)
  }, i, j),NA)
}

forwardflag3_ <- function(bools, period = 12) {
  l <- length(bools)
  stopifnot(l > 0, period > 0)
  
  if(l == 1) {
    return(NA)
  } 
  
  res <- vector("logical", l)
  res1 <- cumsum(bools[2:(2+period-1)])
  res[1] <- res1 >= 1
  
  for(i in 2:l) {
    res1 <- sum(c(res1, -bools[i], bools[i+period]), na.rm=T)
    res[i] <- res1 >= 1
  }
  res
}