Continuously update features in R

Viewed 44

I am building a classifier on a stream of data, and I am trying to develop an efficient way to update the features of the model. The situation is like this:

  1. I train the model on the historical data of the company.
  2. For that, I need to derive some inherently time-dependent features.
  3. Then, new data comes in, and I want to classify, say 1 or 0.
  4. My current solution is to load the whole data, derive the features of the entire dataset, and then classify the new data points.

Here is a sample code:

library(data.table)
library(magrittr)

set.seed(9194694859)

# Simulate data
d <- data.table(CLASS = sample(0:1, size = 1000, replace = T),
                DATE = seq.Date(Sys.Date() - 999, to = Sys.Date(), by = 1),
                FEAT_1 = rnorm(1000),
                FEAT_2 = rnorm(1000) %>% cumsum(.),
                FEAT_3 = sample(0:1, size = 1000, replace = T)
                )

d[, Date := as.Date(DATE)]

# Simulate new data arrival

old_data <- d[Date < "2020-02-20"]
new_data <- d[Date >= "2020-02-20"]

# Derive new features

old_data[, DFEAT_1 := frollmean(FEAT_2, n = 10, fill = NA)]
old_data[, DFEAT_2 := frollmean(FEAT_2, n = 20, fill = NA)]
old_data[, DFEAT_3 := frollmean(FEAT_2, n = 50, fill = NA)]
old_data[, c("LAG_1", "LAG_2") := .(lag(CLASS, 1), 
                                lag(CLASS, 2),)]

# Dynamic scaling of some features

roll_scale <- function(x, n) {

  xout <- frollapply(x, n, function(z) {
    out <- last((z - mean(z, na.rm = T))/sd(z, na.rm = T))})
  return(xout)
}

old_data[, scaled := roll_scale(FEAT_2, 50)]

# Train model

simple_model <- glm(CLASS ~ ., data = old_data[, -"Date"], family = "binomial")

# Then new data comes

Final <- rbindlist(list(old_data, new_data), fill = T)

# So I have to calculate new feat again, so because the features are time-dependent, I use the whole data-set so lagged values are accessible for the rolling-functions

Final[, DFEAT_1 := frollmean(FEAT_2, n = 10, fill = NA)]
Final[, DFEAT_2 := frollmean(FEAT_2, n = 20, fill = NA)]
Final[, DFEAT_3 := frollmean(FEAT_2, n = 50, fill = NA)]
Final[, scaled := roll_scale(FEAT_2, 50)]
Final[, c("LAG_1", "LAG_2") := .(lag(CLASS, 1), 
                                lag(CLASS, 2),)]
# Predict class

Final[, PREDICTED := predict(simple_model, newdata = Final, type = "response")]

Ideally, what I am looking for is for a general framework to adapt for many functions so that I can minimise the feature-updating time and stream the predictions.

1 Answers

Note that your code is not reproducible, it has syntax error, raises warnings and an error. I fixed syntax and error, and I made some improvements, should be faster now. To have a general framework just wrap it in a function.

  • use frollmean vectorized argument (use multiple cores)
  • simplify roll_scale (you only need there a last window, isn't it?)
library(data.table)

set.seed(108)

# Simulate data
d = data.table(CLASS = sample(0:1, size = 1000, replace = T),
               DATE = seq.Date(Sys.Date() - 999, to = Sys.Date(), by = 1),
               FEAT_1 = rnorm(1000),
               FEAT_2 = cumsum(rnorm(1000)),
               FEAT_3 = sample(0:1, size = 1000, replace = T)
)

d[, Date := as.Date(DATE)]

# Simulate new data arrival

old_data = [Date < "2020-02-20"]
new_data = d[Date >= "2020-02-20"]

# Derive new features

old_data[, paste("DFEAT",1:3,sep="_") := frollmean(FEAT_2, n = c(10,20,50))]
old_data[, c("LAG_1", "LAG_2") := .(lag(CLASS, 1), lag(CLASS, 2))]

# Dynamic scaling of some features

roll_scale = function(x, n) {
  f = function(z) last((z - mean(z, na.rm = T))/sd(z, na.rm = T))
  frollapply(x, n, f)
}
roll_scale2 = function(x, n) {
  last_window = tail(x, n)
  tmp = last(last_window) - mean(last_window, na.rm=TRUE)
  last(tmp / sd(last_window, na.rm=TRUE))
}

old_data[, scaled := roll_scale(FEAT_2, 50)]
old_data[, scaled2 := roll_scale(FEAT_2, 50)]
stopifnot(nrow(old_data[scaled!=scaled2])==0L) # ensure it is the same

# Train model

simple_model = glm(CLASS ~ ., data = old_data[, -"Date"], family = "binomial")
#Warning message:
# glm.fit: algorithm did not converge

# Then new data comes

Final = rbindlist(list(old_data, new_data), fill=TRUE)

# So I have to calculate new feat again, so because the features are time-dependent, I use the whole data-set so lagged values are accessible for the rolling-functions

Final[, paste("DFEAT",1:3,sep="_") := frollmean(FEAT_2, n = c(10,20,50))]
Final[, c("LAG_1", "LAG_2") := .(lag(CLASS, 1), lag(CLASS, 2))]
Final[, scaled := roll_scale(FEAT_2, 50)]
Final[, scaled2 := roll_scale(FEAT_2, 50)]
stopifnot(nrow(Final[scaled!=scaled2])==0L) # ensure it is the same
Final[, c("LAG_1", "LAG_2") := .(lag(CLASS, 1), lag(CLASS, 2))]

# Predict class

Final[, "PREDICTED" := predict(simple_model, newdata = Final, type = "response")]
#Warning message:
#In predict.lm(object, newdata, se.fit, scale = 1, type = if (type ==  :
#  prediction from a rank-deficient fit may be misleading
Related