如何强制 r optim 运行更多迭代？

问题描述

R Optim 比我想要的更早停止迭代。我使用 method="L-BFGS-B" （因为我需要不同参数的不同界限）。我知道我可以通过 'control'>'maxit' 设置最大迭代次数，但 optim 没有达到最大值。我想 'control'>'pgtol' 和/或 'factr' 应该会有所帮助，但显然它们没有。

我使用 Excel 求解器插件进行了相同的优化，因此我知道 R 过早地停止迭代。

这是我的示例数据和代码：

dsg <- as.data.frame(cbind(c(0:47),c(0.402469136,0.368944099,0.375477721,0.391121435,0.36741817,0.366685299,0.373907486,0.409429755,0.383399692,0.412436098,0.389864409,0.411901702,0.379012346,0.383269431,0.372778178,0.397308798,0.407005188,0.396770412,0.378525076,0.38084766,0.378051956,0.376836815,0.351144888,0.387655975,0.415815896,0.39851447,0.384345349,0.40061633,0.370402697,0.373590499,0.379474943,0.378865913,0.382395269,0.365808609,0.383106843,0.35946353,0.361037542,0.36077482,0.384418935,0.362583824,0.385405581,0.348344335,0.358934922,0.379079876,0.391434446,0.354347971,0.361197833,0.372232682),c(0.114814815,0.118012422,0.132153971,0.137563457,0.113412879,0.113819587,0.117105297,0.117003116,0.132768529,0.114580427,0.120072809,0.116621127,0.124691358,0.118103399,0.130523309,0.13783449,0.114587233,0.10441059,0.113704754,0.109561299,0.108298377,0.118025013,0.125106438,0.106440408,0.107985517,0.127293523,0.130639958,0.113993233,0.111258799,0.113139383,0.114220436,0.094720217,0.094661712,0.119814534,0.100816305,0.10081601,0.092889949,0.100408522,0.090772039,0.090377762,0.084900005,0.092355162,0.112520582,0.097859676,0.087209055,0.1041137,0.112856553,0.090746204),c(9.18031601,11.09227687,9.83844379,9.64580639,10.22514748,10.23337748,10.40043161,11.42924699,13.81486345,14.13952435,13.61129849,10.83903702,6.88640782,9.04216056,12.02954886,10.72787232,9.4425759,11.13168511,10.81846319,7.78656007,9.72518025,13.7847261,12.33280119,9.26193982,9.44348187,9.84196161,11.74926408,12.84258627,11.7028168,10.15912189,9.40823422,10.91680175,13.23648902,16.4693486,14.21047788,9.13496124,7.57774394,8.51722165,11.76416064,10.1919151,11.73247567,9.81560667,8.74626473,8.28651636,12.22919798,14.78829048,12.31028928,7.84778185),c(32.81570128,31.82592469,38.98876493,36.76658375,38.44461603,25.63108488,24.05370986,29.96483401,35.41164119,38.10191701,40.08138389,40.88474396,30.11146104,28.32714529,38.10802983,33.06030547,30.26582152,30.81661426,19.32980669,22.1124164,39.01648731,36.54290113,42.37598936,37.80545142,35.41146597,38.03598825,44.00978984,39.49187432,42.19555313,46.46831371,28.62873468,29.05176428,53.9939235,54.82043874,46.26856583,46.39431442,39.83112353,40.50502621,39.48027012,37.93228955,42.59635965,35.06031045,30.37208461,28.13106896,38.42397418,38.90616994,42.98276083,39.79207105),c(3470.0,3927.0,4996.8,3148.7,3882.4,4579.9,4191.0,4328.4,4059.6,3667.6,4074.3,4220.0,3698.0,3660.2,4717.6,3687.2,4259.2,4098.1,4297.1,4321.0,3761.5,3586.7,3952.5,3630.0,3803.1,3863.9,4457.1,4280.6,4083.1,4443.2,4534.8,4510.7,3839.3,4408.0,4404.3,3633.3,4153.2,4129.3,4648.0,4947.3,5136.5,4491.6,5758.0,5423.6,5177.8,5312.8,5241.7,4551.9)
             ))
vs <- names(dsg)[1:5]
cr <- names(dsg)[6]
attach(dsg)

#a linear regression
minL.RSS <- function(par) {
  Zws <- par[1] 
  for(u in 1:length(vs)) {
    Zws <- Zws + par[u+1] * (get(vs[u]) ^ 1)
  }
  Zws <- (Zws - get(cr))^2
  sum(Zws)
}

#same linear regression adding an exponent
minE.RSS <- function(par) {
  Zws <- par[1] 
  for(u in 1:length(vs)) {
    Zws <- Zws + par[u+1] * (get(vs[u]) ^ par[u+1+length(vs)])
  }
  Zws <- (Zws - get(cr))^2
  sum(Zws)
}

#running optim for the simple regression
resultL <- optim(par = c(0,rep(0,length(vs))),fn = minL.RSS,method="L-BFGS-B",lower = c(0,-Inf,-Inf),upper = c(Inf,rep(c(Inf),control = list(maxit = 4000)
)
resultL

#running optim for the regression with exponent,using the parameter start values found with the model before - but they dont change (but should)
resultE <- optim(par = c(resultL$par[1],resultL$par[2:(length(vs)+1)],rep(1,fn = minE.RSS,rep(c(0.1),length(vs)),rep(c(1),control = list(maxit = 4000,pgtol = 1e-100)
)
resultE

#using initial parameter values I received from same formula with Excel solver Add-In - the result is getting better=smaller
resultX <- optim(par = c(0,31,3500,2860,-31,1,0.17,1),pgtol = 1e-100)
)
resultX


detach(dsg)

结果X$值 [1] 8109259

结果L$值 [1] 8175660

resultE$value [1] 8175660

我尝试使用非常小和非常大的值 (1e100 / 1e-100) 的 pgtol 和 factr，但 resultE 并没有比 resultL 好。我从 Excel 求解器插件中知道有一个更好的解决方案 (resultX)。

如何强制 optim 运行更多迭代和/或找到与 Excel 求解器插件一样好的解决方案？

解决方法

在您的情况下，factr、ndeps 和 maxit 似乎受到了限制。当你这样做时，你可以非常接近resultX$value：

resultE2 <- optim(par = c(resultL$par[1],resultL$par[2:(length(vs)+1)],rep(1,length(vs))),fn = minE.RSS,method="L-BFGS-B",lower = c(0,-Inf,rep(c(0.1),upper = c(Inf,rep(c(Inf),length(vs)),rep(c(1),control = list(maxit = 1e4,pgtol = 0,ndeps = rep(1e-6,11),factr=0))
resultE2$value
[1] 8109250