在 r 中使用不同的时间序列预测模型将 for 循环转换为 foreach 循环

编程问答 2022-05-02

问题描述

我正在研究需要并行计算的时间序列问题。 我需要生成超过 10k id 的预测。数据结构如下：

ID 期间 Targetvar
A 01012017 100
A 01022017 200
A 01032017 300
.... ........ .........
A 01042020 400
B 01022017 1000
B 01032017 950
.... ........ .........
B 01042020 800

目前我正在为每个 ID 使用一个顺序的“for 循环”，但这需要大量的时间。我需要帮助在 foreach 循环中转换我的 for 循环以利用并行计算。 我的 R 代码是这样的：

 d <- mydataframe
 train_end_date <- as.Date(01022020,format = "%d-%m-%Y")
 test_end_date <- seq.Date(01042020,format = "%d-%m-%Y")
 UID <- unique(d$ID)

 #### Model no transformation####
 final_pred_std <- data.frame()
 MAPE_std <- data.frame()
 for (i in 1:length(UID)) {
 temp <- subset(d,d$ID== UID[i] & d$Period <= test_end_date & d$Total_Volume>1)

if (nrow(temp)==0) {next}
if (max(temp$Period)<test_end_date) {next}
if (nrow(temp)<6) {next}

### Defining the start and end period ####
start_year <- lubridate::year(unique(temp$Period)[1])
start_month <- lubridate::month(unique(temp$Period)[1])

end_year <- lubridate::year(unique(temp$Period)[length(temp$Period)])
end_month <- lubridate::month(unique(temp$Period)[length(temp$Period)])
#temp <- temp %>% 
  #pad(start_val = min(temp$Period),#end_val =   max(temp$Period),#group = c("district")) %>% fill_by_value(Total_Volume,value = 0.001)

end_train_period <- which(temp$Period == train_end_date)

## Converting the data into time series data ##
temp_ts <- ts(temp$Total_Volume,start = c(start_year,start_month),end = c(end_year,end_month),frequency = 12)

#####spliting the time series into Train and Test####
train_period <- end_train_period
test_period <- 2

train_data <- head(temp_ts,train_period)
test_data <- tail(temp_ts,test_period)


temp$Train_Test <- c(rep("Train",train_period),rep("Test",test_period))
options(warn=2)
##### Models  ######

######## Lewandowski algorithm demand forecasting - Exponential Smoothing ###

### Simple Exponential Smoothing - Single Exponential Smoothing - Constant model ###
tryCatch({
  Model_simple_smooth_l <- HoltWinters(train_data,beta = F,gamma = F)
  
  
  temp_train <- cbind(train_data,Model_simple_smooth_l$fitted[,1])
  temp_test <- cbind(test_data,predict(Model_simple_smooth_l,n.ahead = test_period))
  temp_train_test <- cbind(temp$district,temp$Period,temp$Train_Test,as.data.frame(rbind(temp_train,temp_test)),rep("Model_simple_smooth_l",nrow(temp)))
  colnames(temp_train_test)[1] <- "ID"
  colnames(temp_train_test)[2] <- "Period"
  colnames(temp_train_test)[3] <- "Train_Test"
  colnames(temp_train_test)[5] <- "Forecast"
  colnames(temp_train_test)[6] <- "Model"
  colnames(temp_train_test)[4] <- "Total_Volume"
  
  temp_train_test$Forecast <- ifelse(is.na(temp_train_test$Forecast),temp_train_test$Total_Volume,temp_train_test$Forecast)
  
  temp_train_test$Total_Volume <- as.numeric(temp_train_test$Total_Volume)
  temp_train_test$Forecast <- as.numeric(temp_train_test$Forecast)
  
  temp_train_test$APE <- abs(temp_train_test$Forecast/temp_train_test$Total_Volume-1)
  temp_MAPE <- as.data.frame(t(c(UID[i],mean(temp_train_test$APE[1:train_period]),"Model_simple_smooth_l")))
  
  colnames(temp_MAPE)[1] <- "district"
  colnames(temp_MAPE)[2] <- "MAPE"
  colnames(temp_MAPE)[3] <- "Model"
  MAPE_std <- rbind(MAPE_std,temp_MAPE)
  
  final_pred_std <- rbind(final_pred_std,temp_train_test)
},error=function(e){})

### Simple Exponential Smoothing - Single Exponential Smoothing - Constant model ###
tryCatch({
  Model_simple_smooth_sadj_l <- HoltWinters(train_data,gamma = F,seasonal = "additive")
  
  temp_train <- cbind(train_data,Model_simple_smooth_sadj_l$fitted[,predict(Model_simple_smooth_sadj_l,rep("Model_simple_smooth_sadj_l",nrow(temp)))
  colnames(temp_train_test)[1] <- "district"
  colnames(temp_train_test)[2] <- "Period"
  colnames(temp_train_test)[3] <- "Train_Test"
  colnames(temp_train_test)[5] <- "Forecast"
  colnames(temp_train_test)[6] <- "Model"
  colnames(temp_train_test)[4] <- "Total_Volume"
  
  temp_train_test$Forecast <- ifelse(is.na(temp_train_test$Forecast),"Model_simple_smooth_sadj_l")))
  
  colnames(temp_MAPE)[1] <- "district"
  colnames(temp_MAPE)[2] <- "MAPE"
  colnames(temp_MAPE)[3] <- "Model"
  MAPE_std <- rbind(MAPE_std,error=function(e){})
}

请注意，系列的长度可能因 id 而异。

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

foreachloopsparallel-processingrr