R 边界上的mle2（bbmle）参数估计，年产生的NANobject@vcov

我正试图用mle2命令运行传染病分区传播模型（SEIR，在我的例子中是SSEIR）的MLE，试图拟合预测每周死亡人数与观察每周死亡人数的曲线，类似如下： . 然而，参数估计似乎总是在我提供的（合理的）边界上，SEs、z值、p值都是NA

我建立了SEIR模型，然后用ode解算器进行求解。使用该模型输出和观测数据，我计算负对数似然，然后将其提交给mle2函数。 当我第一次设置它时，有多个错误阻止了脚本的运行，但是现在这些问题都解决了，我似乎无法找到配件不起作用的根源。 我确信我为参数估计设置的边界是合理的。这些参数是隔室之间的转换率，因此定义为（例如）δ=1/感染持续时间，因此这些参数可能存在非常真实的生物学界限

我知道我正在尝试用不太多的数据拟合很多参数，但当我尝试只拟合一个参数时，同样的问题仍然存在，因此这不是问题的根源

library(deSolve)
library(bbmle)


#data

gdta <- c(0, 36.2708172419082, 1.57129615346629, 28.1146409459558, 147.701669719614, 311.876708482584, 512.401145459178, 563.798275104372, 470.731269976821, 292.716043742125, 153.604156195608, 125.760068922451, 198.755685044427, 143.847282793854, 69.2693867232681, 42.2093135487066, 17.0200426587424)


#build seir function
seir <- function(time, state, parameters) {
  with(as.list(c(state, parameters)), {

    dS0 <- - beta0 * S0 * (I/N) 
    dS1 <- - beta1 * S1 * (I/N) 
    dE <- beta0 * S0 * (I/N) + beta1 * S1 * (I/N) - delta * E
    dI <- delta * E - gamma * I
    dR <- gamma * I

    return(list(c(dS0, dS1, dE, dI, dR)))
  })
}


# build function to run seir, include ode solver
run_seir <- function(time, state, beta0, beta1, delta, gamma, sigma, N, startInf) {
  parameters <- c(beta0, beta1, delta, gamma) 
  names(parameters) <- c("beta0", "beta1", "delta", "gamma")
  init <- c(S0 = (N - startInf)*(sigma) ,
            S1 = (N - startInf) * (1-sigma), 
            E = 0,
            I = startInf,
            R = 0)
  state_est <- as.data.frame(ode(y = init, times = times, func = seir, parms = parameters))
  return(state_est)
}


times <- seq(0, 16, by = 1)  #sequence  
states <- c("S0", "S1", "E", "I", "R")


# run the run_seir function to see if it works
run_seir(time = times, state= states, beta0 = 1/(1.9/7), beta1 = 0.3*(1/(1.9/7)), delta = 1/(4.1/7), gamma = 1/(4.68/7), sigma = 0.7, N = 1114100, startInf = 100)


#build calc likelihood function
calc_likelihood <- function(times, state, beta0, beta1, delta, gamma, sigma, N, startInf, CFR)  {
  model.output <- run_seir(time, state, beta0, beta1, delta, gamma, sigma, N, startInf)  
  LL <- sum(dpois(round(as.numeric(gdta)), (model.output$I)/(1/delta)*CFR, log = TRUE))
  print(LL)
  return(LL)
}


# run calc_likelihood function
calc_likelihood(time = times, state = states, beta0 = 1/(1.9/7), beta1 = 0.3*(1/(1.9/7)), delta = 1/(4.1/7), gamma = 1/(4.68/7), sigma = 0.7, N = 1114100, startInf = 100, CFR = 0.02)



#MLE

#parameters that are supposed to be fixed
fixed.pars <- c(N=1114100, startInf=100, CFR = 0.02)

#parameters that mle2 is supposed to estimate
free.pars <- c(beta0 = 1/(1.9/7), beta1 = 0.3*(1/(1.9/7)),
           delta = 1/(4.1/7), gamma = 1/(4.68/7), sigma = 0.7)



#lower bound
lower_v <- c(beta0 = 0, beta1 = 0, delta = 0, gamma = 0, sigma = 0) 
#upper bound
upper_v <- c(beta0 = 15, beta1 = 15, delta = 15, gamma = 15, sigma = 1)
#sigma = 1, this is not a typo


#mle function - need to use L-BFGS-B since we need to include boundaries
test2 <- mle2(calc_likelihood, start = as.list(free.pars), fixed = as.list(fixed.pars),method = "L-BFGS-B", lower = lower_v, upper = upper_v)

summary(test2)

库（deSolve）
图书馆（bbmle）
#资料
gdta