如何解决如何基于选定的日期迭代训练预测模型GAM、MARS、...并计算该时间段内的变量重要性
我有一个数据表,它总是有不同数量的列和列名以及一个名为 days
的数字变量(这个变量也不同;现在/这里:50):
library(data.table)
library(caret)
days -> 50
## Create random data table: ##
dt.train <- data.table(date = seq(as.Date('2020-01-01'),by = '1 day',length.out = 366),"DE" = rnorm(366,35,1),"Wind" = rnorm(366,5000,2),"Solar" = rnorm(366,3,"Nuclear" = rnorm(366,100,5),"ResLoad" = rnorm(366,200,3),check.names = FALSE)
我正在建模/训练一个线性模型 (= LM),我想在其中预测 DE 列并计算相对于 days
变量的变量重要性。请参阅以下代码片段:
## MODEL FITTING: ##
## Linear Model: ##
## Function that calculates the iteratively prediction: ##
calcPred <- function(data){
## Model fitting: ##
xgbModel <- stats::lm(DE ~ .-1-date,data = data)
## Model training: ##
stats::predict.lm(xgbModel,data)
}
## Function that calculates the iteratively variable importance: ##
varImportance <- function(data){
## Model fitting: ##
xgbModel <- stats::lm(DE ~ .-1-date,data = data)
terms <- attr(xgbModel$terms,"term.labels")
varimp <- caret::varImp(xgbModel)
importance <- data[,.(date,imp = t(varimp))]
}
## Train Data PREDICTION with iteratively xgbModel: ##
dt.train <- dt.train[,c('prediction') := calcPred(.SD),by = seq_len(nrow(dt.train)) %/% days]
## Iteratively variable importance:##
dt.importance <- data.table::copy(dt.train[,c("prediction") := NULL])
dt.importance <- dt.importance[,varImportance(.SD),by = seq_len(nrow(dt.train)) %/% days]
这里发生了什么:我的模型总是训练 50 天,然后正是在这个时间段内,对这些训练 50 天进行了预测。这一直持续到我的表的结束日期。此外,varImportance()
函数给出了训练区间l(此处为每 50 天)中预测变量(所有列,不包括 date
和 DE
)的可变重要性。
最初我认为我也可以将函数 calcPred()
和 varImportance()
用于广义加性模型 (= GAM) 和多元自适应回归样条 (= MARS) 或梯度提升 (= GB),但不幸的是,这个版本只适用于 LM。
现在我想简要描述一下其他三个模型的模型拟合一般情况,但在这里我还需要您的帮助,以便最终计算 GAM、MARS 和 GB 模型以及 LM。
GAM:
## Create data-vector with dates of dt.train: ##
v.trainDate <- dt.train$date
## Delete column "date" of train data for model fitting: ##
dt.train <- dt.train[,c("date") := NULL]
## Preparation for GAM: ##
trainDataNames <- names(dt.train)
responseVar <- trainDataNames[1]
trainDataNames <- trainDataNames[trainDataNames != responseVar]
## Create right-hand side of GAM model in string/character format: ##
formulaRight <- paste('s(',trainDataNames,')',sep = '',collapse = ' + ')
## Create the whole formula for GAM model in string/character format: ##
formulaGAM <- paste(responseVar,'~',formulaRight,collapse = ' ')
## Coerce to a formula object: ##
formulaGAM <- as.formula(formulaGAM)
## MODEL FITTING: ##
## Generalized Additive Model: ##
xgbModel <- mgcv::gam(formulaGAM,data = dt.train)
## Train and Test Data PREDICTION with xgbModel: ##
dt.train$prediction <- mgcv::predict.gam(xgbModel,dt.train)
## Add date columns to dt.train and dt.test: ##
dt.train <- data.table(date = v.trainDate,dt.train)
火星:
## Create vectors with all DE values of train data set: ##
v.trainY <- dt.train$DE
## Save dates of train data in an extra vector: ##
v.trainDate <- dt.train$date
## Create train matrices for GB model fitting: ##
m.trainData <- as.matrix(dt.train[,c("date","DE") := list(NULL,NULL)])
## Model fitting with grid-search: ##: ##
hyper_grid <- expand.grid(degree = 1:3,nprune = seq(2,length.out = 10) %>% floor()
)
## MODEL FITTING: ##
## Multivariate Adaptive Regression Spline: ##
xgbModel <- caret::train(x = m.trainData,y = v.trainY,method = "earth",metric = "RMSE",trControl = trainControl(method = "cv",number = 10),tuneGrid = hyper_grid
)
## Train Data PREDICTION with xgbModel: ##
dt.train$prediction <- stats::predict(xgbModel,dt.train)
GB:
## Create vectors with all DE values of train data set: ##
v.trainY <- dt.train$DE
## Save dates of train data in an extra vector: ##
v.trainDate <- dt.train$date
## Create train matrices for GB model fitting: ##
m.trainData <- as.matrix(dt.train[,NULL)])
## Gradient Boosting with hyper parameter tuning: ##
xgb_trcontrol <- caret::trainControl(method = "cv",number = 3,allowParallel = TRUE,verboseIter = TRUE,returnData = FALSE
)
xgbgrid <- base::expand.grid(nrounds = c(15000),# 15000
max_depth = c(2),eta = c(0.01),gamma = c(1),colsample_bytree = c(1),min_child_weight = c(2),subsample = c(0.6)
)
## MODEL FITTING: ##
## Gradient Boosting: ##
xgbModel <- caret::train(x = m.trainData,trControl = xgb_trcontrol,tuneGrid = xgbgrid,method = "xgbTree"
)
## Train data PREDICTION with xgbModel: ##
dt.train$prediction <- stats::predict(xgbModel,m.trainData)
## Add DE and date columns to dt.train: ##
dt.train <- data.table(DE = v.trainY,dt.train)
dt.train <- data.table(date = v.trainDate,dt.train)
我如何计算其他三个模型和 LM 的相同?我希望有人可以帮助我。 很抱歉问题拖了这么久。
解决方法
您可以将模型定义为作为参数传递给 calcPred
和 varImportance
的函数。
例如带有 LM
model <- function(data) {stats::lm(DE ~ .-1-date,data = data)}
用GAM
model <- function(data) {mgcv::gam(formulaGAM,data = data)}
带有MARS
:
model <- function(data) {
hyper_grid <- expand.grid(degree = 1:3,nprune = seq(2,100,length.out = 10) %>% floor())
caret::train(x = subset(data,select = -DE),y = data$DE,method = "earth",metric = "RMSE",trControl = trainControl(method = "cv",number = 10),tuneGrid = hyper_grid)
}
我更新了代码以考虑到这个新参数:
library(data.table)
library(caret)
library(magrittr)
days <- 50
## Create random data table: ##
dt.train <- data.table(date = seq(as.Date('2020-01-01'),by = '1 day',length.out = 366),"DE" = rnorm(366,35,1),"Wind" = rnorm(366,5000,2),"Solar" = rnorm(366,3,"Nuclear" = rnorm(366,5),"ResLoad" = rnorm(366,200,3),check.names = FALSE)
dt.importance <- data.table::copy(dt.train)
## Define model & prediction functions ##
model <- function(data) {stats::lm(DE ~ .-1-date,data = data)}
predict <- function(data,model) {stats::predict(model,data)}
calcPred <- function(data,model){
if (nrow(data)==days) {
stats::predict(model,data) } else {
NULL }
}
## Function that calculates the iteratively variable importance: ##
varImportance <- function(data,model){
cat(nrow(data),'\n')
if (nrow(data)==days) {
terms <- attr(model$terms,"term.labels")
varimp <- caret::varImp(model)
importance <- data[,.(date,imp = t(varimp))]} else
{ NULL }
}
## Train Data PREDICTION with iteratively xgbModel: ##
dt.train <- dt.train[,c('prediction') := calcPred(.SD,model(.SD)),by = (seq_len(nrow(dt.train))-1) %/% days]
## Iteratively variable importance:##
dt.importance <- dt.importance[,varImportance(.SD,by = (seq_len(nrow(dt.train))-1) %/% days]
要使用其他模型,只需在上面的代码中使用您想要的模型函数。
这适用于您提供的数据集上的 LM
或 GAM
。
不幸的是,varImp
似乎不适用于带有 MARS
的数据集,尽管这 seems feasible。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。