运行多次求解随时间变化的参数

Question

我想将此代码重复运行，为每个运行创建一个具有不同列变量的输出数据集。现在，该代码可以工作并允许我在不同的时间插入不同的事件。但是，我希望能够改变事件的大小，

IPT  <- ifelse (t<210, IPT, 0.35*exp(-(t-209)/21))

从 0.35 到 0.4、0.5、0.6 等不等。我已经尝试过 For 循环，但根本无法让它工作。我的代码如下：

library(deSolve)
##Simple parameter list
params <- c(b = 0.477, bs = .4, bsv = 0.1, nets = 0.4767, betah = 0.2, 
        rhos = 179, Bthetas = 0.2, psi = 14,phis = 0.5, gamma =14, 
        thetas = 0.79,piv = 1/19, betav = 0.09122, nu = 0.2085, sigma = 12, 
        muv = 1/19, IPT = 0, IPT2 = 0, IPT3 = 0)
dt      <- seq(0, 5000, 7)
inits      <- c(Ss = 30000, Is = 0, As = 0, Rs = 0,
            Sv = 29999, Ev = 0, Iv = 1)
Nh <- 30000
Nv <- 30000


## Create an SIR function
sir1 <- function(t, x, params) {

with(as.list(c(params, x)), {

IPT  <- ifelse (t<210, IPT, 0.35*exp(-(t-209)/21))

dSs <- -((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss         /Nh                                 + As*(1/rhos)*(1-Bthetas)                                                                         + Rs*(1/psi)
dIs <-  ((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss*(1-phis)/Nh - 1/gamma   * Is                                                            - Is*(IPT + IPT2  + IPT3)
dAs <-  ((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss*(  phis)/Nh + 1/gamma  * Is*(1-thetas) - As*(1/rhos)*(1-Bthetas) - As*(2/rhos)*Bthetas                          - As*(IPT + IPT2 + IPT3)
dRs <-                                                               1/gamma * Is*(  thetas)                           + As*(2/rhos)*Bthetas + Is*(IPT2 +    IPT3+ IPT) + As*(IPT + IPT2 + IPT3) - Rs*(1/psi)  

dSv <- piv*Nv - Sv*betav*b*(nu*(
    ((bsv*(1-nets))+(bsv*nets*0.78))*As)+
   ((bsv*(1-nets))+(bsv*nets*0.78))*Is/Nh) - Sv*muv 
dEv <-          Sv*betav*b*(nu*(
  ((bsv*(1-nets))+(bsv*nets*0.78))*As)+
    ((bsv*(1-nets))+(bsv*nets*0.78))*Is/Nh)  - Ev*(1/sigma + muv)
dIv <-      Ev*(1/sigma)- Iv*muv


der <- c(dSs, dIs, dAs, dRs,
         dSv, dEv, dIv)
list(der)
 })
 }

out <- as.data.frame(lsoda(inits, dt, sir1, parms = params))

out$prev <- with(out, Is+As/Nh)

我希望最终数据集有多个前一列，每个运行具有不同的事件值。

任何帮助将不胜感激，谢谢！

Answer 1

一个潜在的解决方案是将幅度作为参数而不是常数（这里我称之为 mag）。

library(deSolve)
##Simple parameter list
params <- c(b = 0.477, bs = .4, bsv = 0.1, nets = 0.4767, betah = 0.2, 
        rhos = 179, Bthetas = 0.2, psi = 14,phis = 0.5, gamma =14, 
        thetas = 0.79,piv = 1/19, betav = 0.09122, nu = 0.2085, sigma = 12, 
        muv = 1/19, IPT = 0, IPT2 = 0, IPT3 = 0, mag=0.35)
dt      <- seq(0, 5000, 7)
inits      <- c(Ss = 30000, Is = 0, As = 0, Rs = 0,
            Sv = 29999, Ev = 0, Iv = 1)
Nh <- 30000
Nv <- 30000

然后我们可以调整sir1函数取mag参数...

## Create an SIR function
sir1 <- function(t, x, params) {

with(as.list(c(params, x)), {

IPT  <- ifelse (t<210, IPT, mag*exp(-(t-209)/21))

dSs <- -((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss         /Nh                                 + As*(1/rhos)*(1-Bthetas)                                                                         + Rs*(1/psi)
dIs <-  ((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss*(1-phis)/Nh - 1/gamma   * Is                                                            - Is*(IPT + IPT2  + IPT3)
dAs <-  ((b*bs*(1-nets))+(b*bs*nets*0.78))*betah*Iv*Ss*(  phis)/Nh + 1/gamma  * Is*(1-thetas) - As*(1/rhos)*(1-Bthetas) - As*(2/rhos)*Bthetas                          - As*(IPT + IPT2 + IPT3)
dRs <-                                                               1/gamma * Is*(  thetas)                           + As*(2/rhos)*Bthetas + Is*(IPT2 +    IPT3+ IPT) + As*(IPT + IPT2 + IPT3) - Rs*(1/psi)  

dSv <- piv*Nv - Sv*betav*b*(nu*(
    ((bsv*(1-nets))+(bsv*nets*0.78))*As)+
   ((bsv*(1-nets))+(bsv*nets*0.78))*Is/Nh) - Sv*muv 
dEv <-          Sv*betav*b*(nu*(
  ((bsv*(1-nets))+(bsv*nets*0.78))*As)+
    ((bsv*(1-nets))+(bsv*nets*0.78))*Is/Nh)  - Ev*(1/sigma + muv)
dIv <-      Ev*(1/sigma)- Iv*muv


der <- c(dSs, dIs, dAs, dRs,
         dSv, dEv, dIv)
list(der)
 })
 }

... 我们可以在循环中修改 params 向量，该循环还运行模型、获取输出、计算 prev，并将其存储在 out data.frame。

out <- as.data.frame(lsoda(inits, dt, sir1, parms = params))
magz <- seq(0.2, 0.5, length.out=10)

for(i in 1:length(magz)){
  params['mag'] <- magz[i]
  tmp <- as.data.frame(lsoda(inits, dt, sir1, parms = params))
  nm <- paste('prev', round(params['mag'],2), sep='')
  out[,nm] <- with(tmp, Is+As/Nh)
}

可能有更好的方法来做您想做的事，但这是一个潜在的解决方案。

运行多次求解随时间变化的参数

run deSolve multiple times varying a time-varying parameter

r

ode

运行 多次求解随时间变化的参数

run deSolve multiple times varying a time-varying parameter

r

ode

运行多次求解随时间变化的参数