按组在插入符号中训练时间序列模型

Posted

技术标签:

【中文标题】按组在插入符号中训练时间序列模型【英文标题】:Train time series models in caret by group 【发布时间】:2019-08-30 20:32:49 【问题描述】:

我有如下数据集

set.seed(503)
foo <- data.table(group = rep(LETTERS[1:6], 150),
                  y  = rnorm(n = 6 * 150, mean = 5, sd = 2),
                  x1 = rnorm(n = 6 * 150, mean = 5, sd = 10),
                  x2 = rnorm(n = 6 * 150, mean = 25, sd = 10),
                  x3 = rnorm(n = 6 * 150, mean = 50, sd = 10),
                  x4 = rnorm(n = 6 * 150, mean = 0.5, sd = 10),
                  x5 = sample(c(1, 0), size = 6 * 150, replace = T))

foo[, period := 1:.N, by = group]

问题:我想预测y 提前一步,对于每个group,使用变量x1, ..., x5

我想在caret 中运行几个模型来决定我将使用哪个。

到目前为止,我正在使用时间片循环运行它

window.length <- 115
timecontrol   <- trainControl(method          = 'timeslice',
                            initialWindow     = window.length,
                            horizon           = 1, 
                            selectionFunction = "best",
                            fixedWindow       = TRUE, 
                            savePredictions   = 'final')

model_list <- list()
for(g in unique(foo$group))
  for(model in c("xgbTree", "earth", "cubist"))
    dat <- foo[group == g][, c('group', 'period') := NULL]
    model_list[[g]][[model]] <- train(y ~ . - 1,
                                      data = dat,
                                      method = model, 
                                      trControl = timecontrol)

  

但是,我想同时运行所有组,使用虚拟变量来识别每个组,例如

dat <- cbind(foo,  model.matrix(~ group- 1, foo))
            y         x1       x2       x3            x4 x5 period groupA groupB groupC groupD groupE groupF
  1: 5.710250 11.9615460 22.62916 31.04790 -4.821331e-04  1      1      1      0      0      0      0      0
  2: 3.442213  8.6558983 32.41881 45.70801  3.255423e-01  1      1      0      1      0      0      0      0
  3: 3.485286  7.7295448 21.99022 56.42133  8.668391e+00  1      1      0      0      1      0      0      0
  4: 9.659601  0.9166456 30.34609 55.72661 -7.666063e+00  1      1      0      0      0      1      0      0
  5: 5.567950  3.0306864 22.07813 52.21099  5.377153e-01  1      1      0      0      0      0      1      0

但仍使用 timeslice 以正确的时间顺序运行时间序列。

有没有办法在trainControl 中声明time 变量,所以我的one step ahead 预测在这种情况下使用每轮多6 个观察值并删除前6 个观察值?

我可以通过对数据进行排序并弄乱horizon 参数来做到这一点(给定n 组,按时间变量排序并放入horizon = n),但如果组数发生变化,这必须改变。 initial.window 必须是 time * n_groups

timecontrol   <- trainControl(method          = 'timeslice',
                            initialWindow     = window.length * length(unique(foo$group)),
                            horizon           = length(unique(foo$group)), 
                            selectionFunction = "best",
                            fixedWindow       = TRUE, 
                            savePredictions   = 'final')

还有其他方法吗?

【问题讨论】:

【参考方案1】:

我会使用tidyr::nest() 来嵌套组,然后使用purrr::map() 迭代数据。这种方法更加灵活,因为它可以适应不同的组大小、不同数量的组,以及传递给caret::train() 的变量模型或其他参数。此外,您可以使用 furrr 轻松并行运行所有内容。

加载包并创建数据

我使用tibble 而不是data.table。我还减少了数据的大小。

library(caret)
library(tidyverse)

set.seed(503)

foo <- tibble(
  group = rep(LETTERS[1:6], 10),
  y  = rnorm(n = 6 * 10, mean = 5, sd = 2),
  x1 = rnorm(n = 6 * 10, mean = 5, sd = 10),
  x2 = rnorm(n = 6 * 10, mean = 25, sd = 10),
  x3 = rnorm(n = 6 * 10, mean = 50, sd = 10),
  x4 = rnorm(n = 6 * 10, mean = 0.5, sd = 10),
  x5 = sample(c(1, 0), size = 6 * 10, replace = T)
) %>%
  group_by(group) %>%
  mutate(period = row_number()) %>%
  ungroup()

减小initialWindow 的大小

window.length <- 9
timecontrol   <- trainControl(
  method          = 'timeslice',
  initialWindow     = window.length,
  horizon           = 1,
  selectionFunction = "best",
  fixedWindow       = TRUE,
  savePredictions   = 'final'
)

创建一个返回拟合模型对象列表的函数

# To fit each model in model_list to data and return model fits as a list.
fit_models <- function(data, model_list, timecontrol) 
  map(model_list,
      ~ train(
        y ~ . - 1,
        data = data,
        method = .x,
        trControl = timecontrol
      )) %>%
    set_names(model_list)

适合模特

model_list <- c("xgbTree", "earth", "cubist")
mods <- foo %>% 
  nest(-group) 

mods <- mods %>%
  mutate(fits = map(
    data,
    ~ fit_models(
      data = .x,
      model_list = model_list,
      timecontrol = timecontrol
    )
  ))

如果您想查看特定组/模型的结果,您可以这样做:

mods[which(mods$group == "A"), ]$fits[[1]]$xgbTree

使用furrr进行并行处理

只需使用plan(multiprocess) 初始化worker 并将map 更改为future_map。请注意,如果您的计算机的处理核心少于 6 个,您可能希望将工作人员的数量更改为少于 6 个。

library(furrr)
plan(multiprocess, workers = 6)

mods <- foo %>% 
  nest(-group) 

mods <- mods %>%
  mutate(fits = future_map(
    data,
    ~ fit_models(
      data = .x,
      model_list = model_list,
      timecontrol = timecontrol
    )
  ))

【讨论】:

据我了解,您为每个组运行不同的模型,对吧?关键是运行一个模型,通过虚拟模型来区分组。 所以您只是想要一种更优雅的方式来制作initialWindowhorizon 取决于组大小?您在问题末尾提供的代码是否已经为您提供了所需的结果? 你想在训练期间只预测每个组/周期一次吗? 以上都不是。我想用组假人运行 1 个模型,而不是为每个组运行单独的模型。这是两个非常不同的东西。最后我的代码执行了第二个选项,我已经可以这样做了。我需要一种方法来做第一个,所有组的单一模型,考虑时间依赖性 我了解您不想按组独立训练单独的模型,这就是我在回答中所做的。你在最后定义的timecontrol 有什么问题?【参考方案2】:

我认为您正在寻找的答案实际上很简单。您可以使用trainControl()skip 参数在每个训练/测试集之后跳过所需的观察次数。这样,每个组周期只预测一次,训练组和测试组之间永远不会分割相同的周期,并且不会出现信息泄漏。

使用您提供的示例,如果您设置skip = 6horizon = 6(组数)和initialWindow = 115,那么第一个测试集将包括第 116 期的所有组,下一个测试集将包括周期 117 的所有组,依此类推。

library(caret)
library(tidyverse)

set.seed(503)
foo <- tibble(group = rep(LETTERS[1:6], 150),
                  y  = rnorm(n = 6 * 150, mean = 5, sd = 2),
                  x1 = rnorm(n = 6 * 150, mean = 5, sd = 10),
                  x2 = rnorm(n = 6 * 150, mean = 25, sd = 10),
                  x3 = rnorm(n = 6 * 150, mean = 50, sd = 10),
                  x4 = rnorm(n = 6 * 150, mean = 0.5, sd = 10),
                  x5 = sample(c(1, 0), size = 6 * 150, replace = T)) %>% 
  group_by(group) %>% 
  mutate(period = row_number()) %>% 
  ungroup() 

dat <- cbind(foo,  model.matrix(~ group- 1, foo)) %>% 
  select(-group)

window.length <- 115

timecontrol   <- trainControl(
  method            = 'timeslice',
  initialWindow     = window.length * length(unique(foo$group)),
  horizon           = length(unique(foo$group)),
  skip              = length(unique(foo$group)),
  selectionFunction = "best",
  fixedWindow       = TRUE,
  savePredictions   = 'final'
)

model_names <- c("xgbTree", "earth", "cubist")
fits <- map(model_names,
            ~ train(
              y ~ . - 1,
              data = dat,
              method = .x,
              trControl = timecontrol
            )) %>% 
  set_names(model_names)

【讨论】:

以上是关于按组在插入符号中训练时间序列模型的主要内容,如果未能解决你的问题,请参考以下文章

在许多单行数据中按组在 R 中进行相关测试 [关闭]

R(插入符号)-在循环中训练“mlpML”模型时出错

提高插入符号 (R) 中的模型训练速度

按组迭代回归 ML 模型

在 R 的插入符号训练函数中使用“ROC”度量的问题

在插入符号交叉验证期间计算模型校准?