[英]run deSolve multiple times varying a time-varying parameter
我想讓此代碼重復運行,為每個運行創建一個具有不同列變量的單個輸出數據集。 現在,該代碼可以正常工作,並允許我在不同的時間插入不同的事件。 但是,我希望能夠更改事件的規模,
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)
我希望最終數據集具有多個prev列,每個列用於具有不同事件值的每次運行。
任何幫助,將不勝感激,謝謝!
潛在的解決方案是將幅度作為參數而不是常數(在這里我將其稱為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)
}
可能有更好的方法來做您想做的事情,但這是一個潛在的解決方案。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.