使用 optim() 优化 Holt-Winter 的平滑参数在零次迭代后停止 [R]

Question

对于大量时间序列，我想优化 Holt-Winter 预测方法的平滑参数，以便得到一组最优参数。 共有三个参数： alpha 、 beta和gamma 。 下面我提出一个时间序列的简化过程，以指示遇到的问题。 我创建了一个季节性时间序列，如下所示：

check_vec <- rep(c(7,6,5,4,3,2,1), times = 100)
check_ts <- ts(check_vec, frequency = 7)

时间序列如下所示。

Time Series:
Start = c(1, 1) 
End = c(100, 7) 
Frequency = 7 
  [1] 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6
 [52] 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4
[103] 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2
[154] 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7
[205] 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5
[256] 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3
[307] 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1
[358] 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6
[409] 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4
[460] 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2
[511] 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7
[562] 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5
[613] 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3
[664] 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1

然后，我使用以下函数进行优化：

check_func <- function(param) {
  
  a <- param[[1]]
  b <- param[[2]]
  c <- param[[3]]
  
  if (c > 1 - a | a < b) {
    
    return(100000)
    
  } else {
    
    rmse <- accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2]
    
    return(rmse)
    
  }
  
}

因此，该函数返回均方根误差（我想最小化）。 它为不同的输入返回不同的值。

> check_func(c(a = 0.18, b = 0.07, c = 0.1))
[1] 3.77942e-16
> check_func(c(a = 0.18, b = 0.07, c = 0.2))
[1] 3.382083e-16

我使用以下optim()命令来优化参数：

optim(par = c(a = 0.18, b = 0.07, c = 0.1),
      fn = check_func,
      lower = c(0.005,0.005,0.005),
      upper = c(0.99, 0.99, 0.99),
      method = "L-BFGS-B",
      control = list(trace = 6,
                     pgtol = 1.490117e-08))

执行optim()命令会给出初始参数作为结果（即优化过程的零次迭代。它返回以下消息。

N = 3, M = 5 machine precision = 2.22045e-16
L = 0.005 0.005 0.005 
X0 = 0.18 0.07 0.1 
U = 0.99 0.99 0.99 
At X0, 0 variables are exactly at the bounds
At iterate     0  f=       37.794  |proj g|=            0

iterations 0
function evaluations 1
segments explored during Cauchy searches 0
BFGS updates skipped 0
active bounds at final generalized Cauchy point 0
norm of the final projected gradient 0
final function value 37.7942

X = 0.18 0.07 0.1 
F = 37.7942
final  value 37.794202 
converged
$par
   a    b    c 
0.18 0.07 0.10 

$value
[1] 37.7942

$counts
function gradient 
       1        1 

$convergence
[1] 0

$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"

我试图增加函数输出的规模并减少pgtol但没有任何成功。 有人知道该怎么做吗？

编辑我添加了更多代码和我找到的过程的结果。

EDIT 2这是修改后的check_func我用来测试 Enrico 的方法是否有效。

check_func <- function(param) {
  
  a <- param[[1]]
  b <- param[[2]]
  c <- param[[3]]
  
  rmse <- try(accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2])
  if (inherits(rmse, "try-error"))
    return(200)
  else
    return(rmse)
  
}

Answer 1

如果您提供了一个可重复的示例，您可能会得到更有帮助的答案。 包装forecast的accuracy和hw是什么？ 在任何情况下，您都可以尝试网格搜索：

library("NMOF")
res <- gridSearch(check_func,
                  lower = rep(0.05, 3),
                  upper = rep(0.99, 3),
                  n = 10)
## List of 4
##  $ minfun   : num 4.11e-17
##  $ minlevels: num [1:3] 0.05 0.05 0.886
##  $ values   : num [1:1000] 3.81e-16 3.81e-16 ...
##  $ levels   :List of 1000
##   ..$ : num [1:3] 0.05 0.05 0.05
##   ..$ : num [1:3] 0.154 0.05 0.05
##   ..$ : num [1:3] 0.259 0.05 0.05

对于许多参数选择， check_func会失败。 所以我会用类似的东西来保护计算：

rmse <- try(accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2])
  if (inherits(rmse, "try-error"))
      return(200)

（披露：我是包NMOF的维护者。）