首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >如何为R中的HoltWinters添加预测精度?

如何为R中的HoltWinters添加预测精度?
EN

Stack Overflow用户
提问于 2021-07-06 19:09:48
回答 1查看 43关注 0票数 1

一个完全可重现的例子。

代码语言:javascript
运行
AI代码解释
复制
library(forecast)
date = seq(as.Date("2019/01/01"), by = "month", length.out = 48)

productB = rep("B",48)
productB = rep("B",48)
productA = rep("A",48)
productA = rep("A",48)

subproducts1=rep("1",48)
subproducts2=rep("2",48)
subproductsx=rep("x",48)
subproductsy=rep("y",48)

b1 <- c(rnorm(30,5), rep(0,18))
b2 <- c(rnorm(30,5), rep(0,18))
b3 <-c(rnorm(30,5), rep(0,18))
b4 <- c(rnorm(30,5), rep(0,18))

创建了下面的数据帧

代码语言:javascript
运行
AI代码解释
复制
dfone <- data.frame("date"= rep(date,4),
            "product"= c(rep(productB,2),rep(productA,2)),
            "subproduct"= 
c(subproducts1,subproducts2,subproductsx,subproductsy),
            "actuals"= c(b1,b2,b3,b4))

export_df <- split(dfone[1:4], dfone[3])

基于独特的子产品创建数据帧

代码语言:javascript
运行
AI代码解释
复制
dummy_list <- split(dfone[1:4], dfone[3]) %>% lapply( function(x) 
x[(names(x) %in% c("date", "actuals"))])
dummy_list <-  lapply(dummy_list, function(x) { x["date"] <- NULL; x })


list_dfs <- list()
for (i in 1:length(unique(dfone$subproduct))) {
  #assign(paste0("df", i), as.data.frame(dummy_list[[i]]))
  list_dfs <-append(list_dfs,dummy_list[[i]])
}

combined_dfs <- Reduce(function(x, y) merge(x, y, all = TRUE,  
by='date'), list(list_dfs))

创建时间序列

代码语言:javascript
运行
AI代码解释
复制
list_ts <- lapply(list_dfs, function(t) 
ts(t,start=c(2019,1),end=c(2021,6), frequency = 12)) %>%
  lapply( function(t) ts_split(t,sample.out=(0.2*length(t))))    # 
creates my train test split
list_ts <- do.call("rbind", list_ts)  #Creates a list of time series

创建多个时间序列列表。在这种情况下,在全局环境中创建了729个对象。

代码语言:javascript
运行
AI代码解释
复制
n1 <- seq(0.1, 0.99, by = 0.1)
n2 <- seq(0.1, 0.99, by = 0.1)
n3 <- seq(0.1, 0.99, by = 0.1)

dat_n <- expand.grid(n1 = n1, n2= n2, n3 = n3) 
out<- lapply(seq_len(nrow(dat_n)), function(i) {
   c_triple_holtwinters_multiplicative <- lapply(list_ts[1: 
(length(list_ts)/2)], function(x) 
       forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))
    c_triple_holtwinters_multiplicative <- 
 lapply(c_triple_holtwinters_multiplicative, "[", "mean")
  assign(paste0("c_triple_holtwinters_multiplicative", i), 
c_triple_holtwinters_multiplicative, envir = .GlobalEnv)
 c_triple_holtwinters_multiplicative})

我想添加下面的函数,在这里我可以准确地测试每个列表对象的训练模型数据,并基于RMSE (list_ts[4]是训练,测试是list_ts[8],因为有4个唯一的子产品,它是4+4=8)。

代码语言:javascript
运行
AI代码解释
复制
 forecast::accuracy(forecast::forecast(HoltWinters(list_ts[[4]],
 seasonal="multiplicative",alpha=.1,beta=.1,gamma=.2),h=24),list_ts[[8]])

        ME     RMSE      MAE         MPE      MAPE      MASE        ACF1 Theil's U
Training set    86.77923 2325.705 1476.658   -5.382147  32.47896 0.5611823 -0.05022049        
 NA
Test set     -3165.29871 6126.887 5389.800 -102.314548 129.32404 2.0483154  0.33876651  
 2.446896

我们的目标不是拥有729个对象,例如,我只想要一个在测试数据上具有最佳RMSE的模型对象。

Edit1:现在从上面的代码中去掉这一点,以使用准确性。

代码语言:javascript
运行
AI代码解释
复制
 c_triple_holtwinters_multiplicative <- 
     lapply(c_triple_holtwinters_multiplicative, "[", "mean")

Edit2:修复了现在可以工作的代码和c_triple...为1-4,list_ts始终为5-8。

代码语言:javascript
运行
AI代码解释
复制
forecast::accuracy(c_triple_holtwinters_multiplicative1[[1]],
 list_ts[[5]])[4] # pulls out the RMSE

当我们找到最低RMSE时,我们想要添加回均值函数,以便在glb环境中创建模型

Edit3:

代码语言:javascript
运行
AI代码解释
复制
dat_n <- expand.grid(n1 = n1, n2= n2, n3 = n3) 
out<- lapply(seq_len(nrow(dat_n)), function(i) {
  c_triple_holtwinters_additive <- lapply(list_ts[1: 
(length(list_ts)/2)], function(x) 
      forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))
 #    c_triple_holtwinters_additive <- 
 # lapply(c_triple_holtwinters_additive, "[", "mean")
 assign(paste0("c_triple_holtwinters_additive", i), 
c_triple_holtwinters_additive, envir = .GlobalEnv)
 c_triple_holtwinters_additive})

forecast::accuracy(c_triple_holtwinters_additive1[[1]],list_ts[[5]])[4]
EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2021-07-07 23:33:23

我们可以使用

代码语言:javascript
运行
AI代码解释
复制
out1 <- lapply(seq_len(nrow(dat_n)), function(i) {
    c_triple_holtwinters_additive <- lapply(list_ts[1: 
  (length(list_ts)/2)], function(x) 
        forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
  dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))

    c_triple_holtwinters_additive1 <- 
         lapply(c_triple_holtwinters_additive, "[", "mean")
    
    acc1 <- unlist(Map(function(x, y)

         forecast::accuracy(x,y )[4],
                 c_triple_holtwinters_additive,  list_ts[5:8]
              ))
    ind1 <- which.min(acc1)
    nm1 <- paste0("c_triple_holtwinters_additive", i)
    
    
     assign(nm1[ind1], 
        c_triple_holtwinters_additive1[[ind1]], envir = .GlobalEnv)

    c_triple_holtwinters_additive1[[ind1]]
   })

-checking

代码语言:javascript
运行
AI代码解释
复制
head(out1, 5)
[[1]]
[[1]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 3.992136 4.551152 4.819030 2.722871 3.429581 5.088622 3.169820 5.611467 5.198844 3.475341 3.554109 5.348270
2022 3.335633 3.894648 4.162526 2.066368 2.773077 4.432118 2.513316 4.954963 4.542341 2.818837 2.897606 4.691766


[[2]]
[[2]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 3.973570 4.537064 4.810701 2.720144 3.431003 5.093744 3.176812 5.638199 5.244988 3.506140 3.572943 5.374759
2022 3.363802 3.927296 4.200934 2.110376 2.821235 4.483976 2.567044 5.028431 4.635220 2.896372 2.963175 4.764991


[[3]]
[[3]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.045785 4.619027 4.903568 2.823377 3.542898 5.213984 3.303773 5.790314 5.418427 3.663552 3.723406 5.541533
2022 3.546085 4.119327 4.403867 2.323676 3.043197 4.714283 2.804073 5.290613 4.918727 3.163851 3.223705 5.041832


[[4]]
[[4]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.126131 4.707987 5.002172 2.930755 3.657247 5.335301 3.430712 5.941848 5.587022 3.810281 3.864567 5.703121
2022 3.722981 4.304837 4.599022 2.527605 3.254097 4.932151 3.027563 5.538699 5.183873 3.407132 3.461417 5.299972


[[5]]
[[5]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.171013 4.757059 5.056343 2.988862 3.717521 5.398159 3.495038 6.027034 5.681583 3.874808 3.923682 5.783772
2022 3.811419 4.397465 4.696749 2.629268 3.357928 5.038565 3.135444 5.667440 5.321989 3.515214 3.564088 5.424178
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/68276239

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档