У меня есть таблица данных, в которой всегда разное количество столбцов и имен столбцов, а также числовая переменная с именем 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, 2),
"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() дает переменные значения предикторов (все столбцы, кроме date и DE) в интервале обучения (здесь для каждых 50 дней).
Первоначально я думал, что могу использовать функции 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, 100, 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)
ГБ:
## 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)])
## 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,
y = v.trainY,
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? Надеюсь, кто-нибудь сможет мне помочь. Извините, что вопрос получился таким длинным.
