R NLS-logistic回归的optimx问题

我试图根据历史数据（y）估计函数的一些参数。这是一个带有异步更新（增量）的逻辑回归

这就是所讨论的系统：

其中（出于我们的目的）X[t]=y[t]，n2表示为（1-n1），phi1和phi2表示为phi1+deltaphi（作为phi2>phi1），u[t]是由y_hat捕获的隐式误差项

数据（日志值）：

其他材料：

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)

---

T我可以用不同的优化器得到一些答案（但不能用
nlm
）；它也确实看起来像您的目标函数可能被过度指定，不同的优化器将以不同的方式处理。。。我试着把目标函数简化一点

设置常数
目标函数
nlm给出所有NA值；BFGS不符合两个KKT标准；内尔德·米德看起来还行。Nelder Mead和BFGS给出了适度不同的参数估计，尽管两者给出的SSQ都很小

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

cc我可以用不同的优化器得到一些答案（但不能用
nlm
）；它也确实看起来像您的目标函数可能被过度指定，不同的优化器将以不同的方式处理。。。我试着把目标函数简化一点

设置常数
目标函数
nlm给出所有NA值；BFGS不符合两个KKT标准；内尔德·米德看起来还行。Nelder Mead和BFGS给出了适度不同的参数估计，尽管两者给出的SSQ都很小

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

cc谢谢你的回答，教授！很抱歉，在我最初的帖子中，我没有提到一些限制，我现在已经在帖子中编辑了这些限制。Beta应该是正的非零（或者它抵消了该项），delta应该在0和1之间（但同样，不是=1）。使用这些约束条件，我可以引导函数获得一些有利的结果，但拟合似乎受到了很大的影响。您可以使用
L-BFGS-B
施加框约束，或者在进一步考虑后，估计转换尺度（β的对数标度，δ的对数赔率（plogis/qlogis）尺度）上的参数，通过使用nlsLM而不是optimx，我成功地实现了非常有利的拟合，正如我在残差中观察到的条件异方差，执行了第二次加权回归。你对目标函数的调整使我走上了正确的道路。非常感谢。转换后的音阶其实很有趣，人们会怎么做呢？如果我正确理解了plogis函数，我可以用plogis（delta，log.p=TRUE）和log（beta）替换参数。然而，当我这样做时，我似乎得到了关于拟合数据的不错的结果，但标准误差非常高。你有什么见解吗？谢谢你的回答，教授！很抱歉，在我最初的帖子中，我没有提到一些限制，我现在已经在帖子中编辑了这些限制。Beta应该是正的非零（或者它抵消了该项），delta应该在0和1之间（但同样，不是=1）。使用这些约束条件，我可以引导函数获得一些有利的结果，但拟合似乎受到了很大的影响。您可以使用
L-BFGS-B
施加框约束，或者在进一步考虑后，估计转换尺度（β的对数标度，δ的对数赔率（plogis/qlogis）尺度）上的参数，通过使用nlsLM而不是optimx，我成功地实现了非常有利的拟合，正如我在残差中观察到的条件异方差，执行了第二次加权回归。你对目标函数的调整使我走上了正确的道路。非常感谢。转换后的音阶其实很有趣，人们会怎么做呢？如果我正确理解了plogis函数，我可以用plogis（delta，log.p=TRUE）和log（beta）替换参数。然而，当我这样做时，我似乎得到了关于拟合数据的不错的结果，但标准误差非常高。你有什么见解吗？
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)

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

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

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

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 ...