有没有办法在R中使用optim优化ODE的初始值？

我想使用

optim

优化

R

中的值（

numcasewk0

）。然而，该值不是ODE的参数-只是初始值

下面显示的代码试图这样做，但优化过程不断失败，只产生用户提供的上限。我怀疑这可能是因为

numcasewk0

不是ODE的参数之一。如果有人能告诉我如何解决这个问题，我会很高兴的。谢谢

library(deSolve)

### ODE FUNCTION

HAVODE <- function(t, states, parameters){
  with(as.list(c(states,parameters)),
       {
         N    <- S + L + Z + I + R
         dS <- -beta * S * (I/N) 
         dL <-  beta * S * (I/N) - (1/durL)*L
         dI <-  (1/durL)*L +(1/durRel)*R - (1/durI)*I             
         dZ <- (1-propRelapse)*(1/durI)*I
         dR <- propRelapse*(1/durI)*I - (1/durRel)*R 
         return(list(c(dS, dL, dI, dZ, dR)))
       })
}

### COST FUNCTION

calib_function <- function(x, parameters,observed.){

  ## Variable to be optimized

  numcaseswk0 <- x

  initpop = parameters[1]
  durL = parameters[2]
  durI = parameters[3]
  fracImmune = parameters[4]
  durRel = parameters[5]
  propRelapse = parameters[6]
  probdetec = parameters[7]
  beta  = parameters[8]

  ## Starting values for states 
  S. = (1-fracImmune)*initpop
  L. = numcaseswk0              # ***  I want this value to be optimized
  I. = 0
  Z. = fracImmune*initpop
  R. = 0  
  states = c(S=S., L= L. , I=I.,  Z=Z.,   R=R.)

  ## Parameters to be fed into ODE solver
  parameters1 = c(durL = durL, durI = durI,durRel = durRel, propRelapse = propRelapse,  beta = beta  )                 
  tspan = seq(0, length(observed.)+10); 
  # Run the ODE solver
  result <- data.frame(ode(y = states, times = tspan,  func = HAVODE,  parms = parameters1))

  # Calculating model response (number of detected incident cases)

  IncDetec <- probdetec *((1/durL)*result[, 3] + (1/durRel)*result[, 6])

  model_response <- IncDetec[-1][1:length(observed.)]     # exclude initial week


  # Calculate negative log likelihood of model responses

  NLLK <- -sum(dpois(x = floor(model_response), lambda = observed., log = TRUE ))

  if (NLLK == Inf){

    NLLK = 999999    # if NLLK is infinity, replace by a large number
  }
  return(NLLK)  
}

## vector of starting values
x0 <- 2
## set lower and upper bounds for these variables
upper <- 10
lower <- 1

## Call the cost function with optim

calib_parameters <- c(135722, 9.2088, 2.6047, 0.47, 3.930, 7.21, 0.094, 0.517)

optimization_results <- optim(par=x0, lower = lower,  upper = upper, method = 'Brent', fn = calib_function, parameters = calib_parameters,  observed. =  abs(rnorm(50, mean=6, sd=3)))

---

optim

产生的估计值是提供的下限值（

lower=1

）。您可能还注意到没有函数求值。为什么优化不适用于

numcasewk0

？

正如Ben已经指出的，代码示例是不可复制的。如果我发布一段我们的教程示例中的代码片段，这可能会对您有所帮助

该示例使用包FME，它包装optim（和其他优化器）并提供一些额外的支持

### ============================================================================
### code snippet from the useR!2014 (Los Angeles) tutorial
###
### Copyright tpetzoldt, license: GPL >= 2.0
### more see: 
###   http://desolve.r-forge.r-project.org/user2014/examples/FME/fit_twocomp.svg
### ============================================================================
library(deSolve)
library(FME)

## A two compartment pharmacokinetic model
twocomp <- function (time, y, parms, ...) {
  with(as.list(c(parms, y)), {
    dCL <- kFL * CF - kLF * CL - ke * CL  # concentration in liver
    dCF <-    kLF * CL  - kFL * CF        # concentration in fat
    list(c(dCL, dCF))
  })
}
parms <- c(ke = 0.2,    kFL = 0.1,  kLF = 0.05)
times <- seq(0, 40, length=200)
y0      <-  c(CL = 1, CF = 0)
out <- ode(y0, times, twocomp, parms)

## -----------------------------------------------------------------------------
## data in database format
## -----------------------------------------------------------------------------
dat2 <- data.frame(
  label = rep(c("CL", "CF"), each=8),  # must be the first column
  time = rep(seq(0, 28, 4), 2),
  value = c(1.31,  0.61,  0.49,  0.41,  0.20,  0.12,  0.16,  0.21,
            0.001, 0.041, 0.050, 0.039, 0.031, 0.025, 0.017, 0.012)
)

## -----------------------------------------------------------------------------
## fit parameters and initial values
## -----------------------------------------------------------------------------

parms <- c(CL = 1.0, CF = 0.0, ke = 0.2,    kFL = 0.1,  kLF = 0.05)

cost <- function(p, data, ...) {
  yy <- p[c("CL", "CF")]           # initial values
  pp <-  p[c("ke", "kFL", "kLF")]  # start parameters
  out  <-  ode(yy, times, twocomp, pp)
  modCost(out, data, y="value", ...)
}

## The default Marq optimizer fails here, so we use another, e.g. Port        
fit6  <- modFit(f = cost, p = parms, data=dat2, weight="std",
                lower=rep(0, 5), upper=c(2,2,1,1,1), method="Port")

summary(fit6)        
y0 <- coef(fit6)[c("CL", "CF")]
pp <- coef(fit6)[c("ke", "kFL", "kLF")]
out6 <- ode(y0, times, twocomp, pp)

plot(out, out6, obs=dat2)

###============================================================================
###来自用户的代码片段！2014年（洛杉矶）教程
###
###版权所有tpetzoldt，许可证：GPL>=2.0
###更多信息请参见：
###   http://desolve.r-forge.r-project.org/user2014/examples/FME/fit_twocomp.svg
### ============================================================================
图书馆（deSolve）
图书馆（FME）
##二室药代动力学模型
twocomp我认为您的型号规格有问题。优化器运行正确（在技术意义上），最佳参数为零

请参阅评论，更改内容：


更大的罚款额
将成本价值重新调整到可行范围
对成本函数的一些手动测试调用
一些可能有助于调试的cat（）函数
还请注意，“点”语法（L、R等）不是必需的

下面的内容可能仍然不是您想要的，但希望能够帮助您运行它。祝你好运

    library(deSolve)

    ### ODE FUNCTION

    HAVODE <- function(t, states, parameters){
      with(as.list(c(states,parameters)),
           {
             N    <- S + L + Z + I + R
             #cat("N=", N, "\n")
             dS <- -beta * S * (I/N) 
             dL <-  beta * S * (I/N) - (1/durL)*L
             dI <-  (1/durL)*L +(1/durRel)*R - (1/durI)*I             
             dZ <- (1-propRelapse)*(1/durI)*I
             dR <- propRelapse*(1/durI)*I - (1/durRel)*R 
             return(list(c(dS, dL, dI, dZ, dR)))
           })
    }

    ### COST FUNCTION

    calib_function <- function(x, parameters,observed.){

      ## Variable to be optimized
      #cat("x=", x, "\n")

      numcaseswk0 <- x

      initpop = parameters[1]
      durL = parameters[2]
      durI = parameters[3]
      fracImmune = parameters[4]
      durRel = parameters[5]
      propRelapse = parameters[6]
      probdetec = parameters[7]
      beta  = parameters[8]

      ## Starting values for states 
      S. = (1-fracImmune)*initpop
      L. = numcaseswk0              # ***  I want this value to be optimized
      I. = 0
      Z. = fracImmune*initpop
      R. = 0  
      states = c(S=S., L= L. , I=I.,  Z=Z.,   R=R.)
      #cat(states, "\n")

      ## Parameters to be fed into ODE solver
      parameters1 = c(durL = durL, durI = durI,durRel = durRel, propRelapse = propRelapse,  beta = beta  )                 
      tspan = seq(0, length(observed.)+10); 
      # Run the ODE solver
      result <- data.frame(ode(y = states, times = tspan,  func = HAVODE,  parms = parameters1))

      # Calculating model response (number of detected incident cases)

      IncDetec <- probdetec *((1/durL)*result[, 3] + (1/durRel)*result[, 6])

      model_response <- IncDetec[-1][1:length(observed.)]     # exclude initial week


      # Calculate negative log likelihood of model responses

      NLLK <- -sum(dpois(x = floor(model_response), lambda = observed., log = TRUE ))

      ## tpe: set it to a really large value
      if (!is.finite(NLLK)){
        NLLK = 0.1 * .Machine$double.xmax    # if NLLK is infinity, replace by a large number
      }

      ## tpe: re-scale return value to a numerically feasible range
      return(NLLK * 1e-10)  
    }

    ## vector of starting values
    x0 <- 2
    ## set lower and upper bounds for these variables
    upper <- 10
    lower <- 0

    ## Call the cost function with optim

    calib_parameters <- c(135722, 9.2088, 2.6047, 0.47, 3.930, 7.21, 0.094, 0.517)

    ## tpe: reproducible comparison data
    set.seed(42)
    observed <- abs(rnorm(50, mean=6, sd=3))

    ## test manually
    calib_function(1, calib_parameters, observed)
    calib_function(0, calib_parameters, observed)
    calib_function(10, calib_parameters, observed)

    ## tpe: we see that zero *is* the best among these

    ## optimize automatically
    optimization_results <- optim(par=x0, lower = lower,  upper = upper, 
                                  method = 'L-BFGS-B', fn = calib_function, 
                                  parameters = calib_parameters,  
                                  observed. =  observed,
                                  control=list(trace=TRUE))


    optimization_results
    ## tpe: optimized par is again zero, that confirms the manual test

库（deSolve）
###常微分方程
HAVODE看起来你没有给我们一个机会？仅仅盯着代码是很难解决这个问题的……嗨@BenBolker，谢谢你指出这个问题需要重新定义。我确实做到了这一点，确保我提供了重现问题所需的一切。如果您能再看一眼，我将不胜感激。我又试了一次，但代码似乎仍然缺少一些部分。当我运行它时，我得到：
seq.default（length（observed.），et，length.out=numsteps+1）中的错误：找不到对象“numsteps”
@tpetzoldt，你是对的；我的
numsteps
已经存储在R的内存中。但是，代码现在已被编辑，因此在重新运行时不会出现错误。谢谢你的耐心。@tpetzoldt好吧，你又对了，对此我很抱歉。修正了（现在是真的了）。谢谢你。在您提供的代码段中，正在优化的参数是ODE的参数，这与我提出的问题不同。例如，
ke
（在代码中使用）不是ODE中的参数时，您会怎么做？？在我的例子中，我想优化'numcasewk0'，它只是一个初始值。这个例子同时优化了ode模型的参数（pp）和初始值（yy）。对于优化器和成本函数，它们都是“参数”（parms）。非常感谢！至少，优化器现在运行正常。我希望
numcasewk0
在（1,3）的范围内，因此正如您正确地说的，我可能需要重新检查模型。事实上，我已经做过好几次了。实际上，同一个ODE在MATLAB中产生了预期的结果，因此仍然是一个谜，为什么它在R中没有这样做。无论如何，再次感谢您的帮助：）
    library(deSolve)

    ### ODE FUNCTION

    HAVODE <- function(t, states, parameters){
      with(as.list(c(states,parameters)),
           {
             N    <- S + L + Z + I + R
             #cat("N=", N, "\n")
             dS <- -beta * S * (I/N) 
             dL <-  beta * S * (I/N) - (1/durL)*L
             dI <-  (1/durL)*L +(1/durRel)*R - (1/durI)*I             
             dZ <- (1-propRelapse)*(1/durI)*I
             dR <- propRelapse*(1/durI)*I - (1/durRel)*R 
             return(list(c(dS, dL, dI, dZ, dR)))
           })
    }

    ### COST FUNCTION

    calib_function <- function(x, parameters,observed.){

      ## Variable to be optimized
      #cat("x=", x, "\n")

      numcaseswk0 <- x

      initpop = parameters[1]
      durL = parameters[2]
      durI = parameters[3]
      fracImmune = parameters[4]
      durRel = parameters[5]
      propRelapse = parameters[6]
      probdetec = parameters[7]
      beta  = parameters[8]

      ## Starting values for states 
      S. = (1-fracImmune)*initpop
      L. = numcaseswk0              # ***  I want this value to be optimized
      I. = 0
      Z. = fracImmune*initpop
      R. = 0  
      states = c(S=S., L= L. , I=I.,  Z=Z.,   R=R.)
      #cat(states, "\n")

      ## Parameters to be fed into ODE solver
      parameters1 = c(durL = durL, durI = durI,durRel = durRel, propRelapse = propRelapse,  beta = beta  )                 
      tspan = seq(0, length(observed.)+10); 
      # Run the ODE solver
      result <- data.frame(ode(y = states, times = tspan,  func = HAVODE,  parms = parameters1))

      # Calculating model response (number of detected incident cases)

      IncDetec <- probdetec *((1/durL)*result[, 3] + (1/durRel)*result[, 6])

      model_response <- IncDetec[-1][1:length(observed.)]     # exclude initial week


      # Calculate negative log likelihood of model responses

      NLLK <- -sum(dpois(x = floor(model_response), lambda = observed., log = TRUE ))

      ## tpe: set it to a really large value
      if (!is.finite(NLLK)){
        NLLK = 0.1 * .Machine$double.xmax    # if NLLK is infinity, replace by a large number
      }

      ## tpe: re-scale return value to a numerically feasible range
      return(NLLK * 1e-10)  
    }

    ## vector of starting values
    x0 <- 2
    ## set lower and upper bounds for these variables
    upper <- 10
    lower <- 0

    ## Call the cost function with optim

    calib_parameters <- c(135722, 9.2088, 2.6047, 0.47, 3.930, 7.21, 0.094, 0.517)

    ## tpe: reproducible comparison data
    set.seed(42)
    observed <- abs(rnorm(50, mean=6, sd=3))

    ## test manually
    calib_function(1, calib_parameters, observed)
    calib_function(0, calib_parameters, observed)
    calib_function(10, calib_parameters, observed)

    ## tpe: we see that zero *is* the best among these

    ## optimize automatically
    optimization_results <- optim(par=x0, lower = lower,  upper = upper, 
                                  method = 'L-BFGS-B', fn = calib_function, 
                                  parameters = calib_parameters,  
                                  observed. =  observed,
                                  control=list(trace=TRUE))


    optimization_results
    ## tpe: optimized par is again zero, that confirms the manual test