用于NLS逻辑回归的optimx问题

时间:2020-09-07 20:15:43

标签: r optimization logistic-regression

我正在尝试根据历史数据(y)估算函数的一些参数。这是具有异步更新(增量)的逻辑回归。

这是有问题的系统

funcs

在(出于我们的目的)X [t] = y [t]的情况下,将n2公式化为(1-n1),将phi1和phi2公式化为phi1 + delphiphi(因为phi2> phi1),u [t]为y_hat捕获的隐式错误项。

数据(日志值):

y <- c(-0.083522212, -0.080744273, -0.098003453, -0.090994700, -0.105010991, -0.112070623, -0.115681762, -0.143194134, -0.146458642, -0.139691305, -0.128929970, -0.118047088, -0.095065509, -0.082399946, -0.100997872, -0.092699501, -0.082550517, -0.050470001, 0.030390893,  0.131429122,  0.180958369,  0.212374498,  0.223668346,  0.226461144,  0.209141361,  0.195377626,  0.178487458,
0.201981948,  0.233653604,  0.245221474,  0.227886405,  0.141274238,  0.046683795, -0.047819717, -0.112630561, -0.203788442, -0.238529171, -0.211924261, -0.233738086, -0.241872522, -0.238041656, -0.230753558, -0.242931741, -0.231894162, -0.243119603, -0.233052377, -0.230820606, -0.225594126, -0.232095554, -0.244800121, -0.252265025, -0.241778694, -0.227898251, -0.242656156, -0.229516117, -0.216082812, -0.220941314, -0.211800617, -0.183642284, -0.165779424, -0.159285263, -0.147407410, -0.138607996, -0.130455753, -0.094857132, -0.039392141, -0.003361144,  0.076381508,  0.101627405,  0.103042608,  0.096997308,  0.100308333, 0.098658702,  0.083952591,  0.077534743,  0.064491677,  0.056002466,  0.082643906,  0.080460147,  0.090688462)

估计参数:

phi1, deltaphi, beta, delta

其他内容:

T <- 80
y_hat <- mat.or.vec(nr = T, nc = 1)
R = 1.019656
alpha_bar = 0 
n1 = mat.or.vec(nr = T, nc = 1)

功能:

f <- function(t, phi1, deltaphi, beta, delta, R, alpha_bar, y) {
  n1[t] <<- (delta*n1[t-1])+(1-delta)*(1/(1+exp(-beta*((y[t-1]+alpha_bar-R*y[t-2])*((-deltaphi))*y[t-3]))))
  y_hat = (((n1[t]*phi1+(1-n1[t])*(phi1+deltaphi))/((R+alpha_bar)))*y[t-1])
return((y[t]-y_hat)^2) 
}
func <- function(par) sum(sapply(4:T,f, par[1],par[2], par[3],par[4], R, alpha_bar, y)) 

fit <- optimx(c(0.9, 1.05, 0.05, 0.6),
              method = "nlm",
              func,
              hessian = TRUE)

我认为n1是这里的问题,我尝试了很多技巧使其符合要求,因为它是没有起点的递归变量,因此没有超级操作符。我很幸运,但是该功能总是对我崩溃,因此我认为该功能可能在某种程度上被错误指定。 beta和delta受到一些限制-beta应该为正非零值,并且delta应该在0到1之间。

1 个答案:

答案 0 :(得分:0)

我可以使用不同的优化器得到一些答案(但不能使用nlm);它确实确实看起来像您的目标函数可能已被过度指定,不同的优化器将对此进行不同的处理...我试图对目标函数进行一些简化。

设置常量

maxT <- 80
R <- 1.019656
alpha_bar <- 0 

预测功能

我使用with(as.list(par) ...)来避免必须解压参数向量。这确实使调试更加困难,并且确实迫使我们在表达式中使用<<- ...

predfun <- function(par) {
    y_hat <- n1 <- numeric(maxT)  ## pre-allocate vectors
    with(as.list(par), {
        for (t in (4:maxT)) {
            n1[t] <<- (delta*n1[t-1])+(1-delta)*
                (1/(1+exp(-beta*((y[t-1]+alpha_bar-R*y[t-2])*
                                 ((-deltaphi))*y[t-3]))))
            y_hat[t] <<- (((n1[t]*phi1+(1-n1[t])*(phi1+deltaphi))/
                           ((R+alpha_bar)))*y[t-1])
        }
    })
    return(y_hat)
}

目标函数

func <- function(par) {
    return(sum((y[4:maxT]-predfun(par)[4:maxT])^2))
}

优化

p0 <- c(phi1=0.9, deltaphi=1.05, beta=0.05, delta=0.6)
func(p0)  ## check to make sure the function works for starting values
library(optimx)
fit <- optimx(par=p0,
              method = c("Nelder-Mead","BFGS","nlm"),
              func,
              hessian = TRUE)

结果

                  phi1 deltaphi     beta       delta         value fevals
Nelder-Mead -0.4967063 3.026097 6.227032 -0.16820934  7.546323e-02    265
BFGS        -0.4462906 2.903375 2.554713 -0.01802873  7.922255e-02    110
nlm                 NA       NA       NA          NA 8.988466e+307     NA
            gevals niter convcode  kkt1  kkt2 xtime
Nelder-Mead     NA    NA        0  TRUE  TRUE 0.143
BFGS           100    NA        1 FALSE FALSE 0.494
nlm             NA    NA     9999    NA    NA 0.001

nlm给出全NA值; BFGS均未通过KKT标准。 Nelder-Mead出现确定。 Nelder-Mead和BFGS给出的参数估算值存在适度的差异,尽管两者的SSQ值都明显较小。

cc <- coef(fit)
plot(y)
lines(predfun(cc["Nelder-Mead",]), col=2)
lines(predfun(cc["BFGS",]), col=4)

拟合的线(几乎)无法区分。

enter image description here

转换后的参数

如果要在转换后的比例尺上拟合参数,则可以在转换后的比例尺上为优化函数提供初始参数,例如

p0 <- c(phi1=0.9, deltaphi=1.05, log_beta=log(0.05), logit_delta=qlogis(0.6))

然后在您的目标函数中,在使用它们之前对其进行反向转换:

predfun <- function(par) {
    y_hat <- n1 <- numeric(maxT)  ## pre-allocate vectors
    with(as.list(par), {
       delta <- plogis(logit_delta)
       beta <- exp(log_beta)
       ### ... then the rest of your objective function ...