Постоянно обновлять функции в R - PullRequest
Новая
       8

Постоянно обновлять функции в R

2 голосов
/ 29 февраля 2020

Я строю классификатор на потоке данных и пытаюсь разработать эффективный способ обновления возможностей модели. Ситуация такова:

  1. Я обучаю модель на исторических данных компании.
  2. Для этого мне нужно получить некоторые неотъемлемо зависящие от времени функции.
  3. Затем поступают новые данные, и я хочу классифицировать, скажем, 1 или 0.
  4. Мое текущее решение состоит в том, чтобы загрузить все данные, получить характеристики всего набора данных и затем классифицировать новые точки данных.

Вот пример кода: 

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")]

В идеале, я ищу общую структуру для адаптации ко многим функциям, чтобы я мог минимизировать время обновления функций и оптимизировать прогнозы.

1 Ответ

1 голос
/ 01 марта 2020

Обратите внимание, что ваш код не воспроизводится, он имеет синтаксическую ошибку, выдает предупреждения и ошибку. Я исправил синтаксис и ошибку, и я сделал некоторые улучшения, теперь должно быть быстрее. Чтобы получить общую структуру, просто оберните ее в функцию.

  • используйте векторизованный аргумент frollmean (используйте несколько ядер)
  • упростите roll_scale (вам нужно только последнее окно, не так ли это?) 
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
...