deSolve for R-参数化事件

Question

I'm writing an SIR Model using the deSolve package for R.

The model describes transmission of an infection within a community and then allows the introduction of external events - which represent mass treatment of the whole community.

These are modelled as events that occur at specific times.

For the transmission model itself I have been able to code it so that the model runs a large number of simulations using a range of values for the baseline population sizes and parameters (plist and initlist).

I would like to be able to do the same for the external event (Total Community Treatment) parameters.

At present the impact of the external event on the Susceptible population is: S <- S + 0.95*L + 0.95*I1 + 0.95*I2

But I would like to be able to specify a range of values eg 0.85-0.99 and have the model run multiple simulations across the full range of possibilities.

I tried including these as additional parameters in the plist eg

S <- S + TCT*L + TCT*I1 + TCT*I2

and then including it in the plist such as

plist <- cbind(TCT = runif(100,min = 0.88, max = 0.99)........etc)

But I get errors saying that the parameter eg TCT doesn't exist

Full code below and suggestions welcomed.

library(deSolve)

#generate an empty list for the data to be put into

simulationlist <- list()

#define the transmission model

SI1I2L <- function(t, y, parms) {

  with(as.list(c(parms,y)),{
    dS <- - Beta*S*I1 - Beta*S*I2 + treat*I1 + treat*I2 +latenttreat*L
    dI1 <- + Beta*S*I1 + Beta*S*I2 - treat*I1 -second*I1 - latent*I1
    dI2 <- + second*I1 - latent*I2 - treat*I2 + relapse*L
    dL <- +latent*I1 + latent*I2 - relapse*L - latenttreat*L

    der <- c(dS, dI1,dI2, dL)
    list(der)    
  }) 

} 

#define Total Community Treatment Parameters

eventtct <- function(t, y, parms){
  with (as.list(y),{
    S <- S + 0.95*L + 0.95*I1 + 0.95*I2
    I1 <- I1*0.05
    I2 <- I2*0.05
    L <- L*0.05
    return(c(S,I1,I2,L))
  })
}

#Set the time frame for the model
dt    <- seq(0,100,1)    

#Define the spectrum of Parameters for transmission with Min/Max values and number of variations
plist <- cbind(Beta = runif(100,min = 0.00000167, max = 0.0000043),second = runif(100,min= 0.0278,max = 0.0556),latent = runif(100,min=0.004, max=0.009), treat = runif(100, min=0.01, max =0.03),latenttreat = runif(100,min=0.004,max=0.009),relapse = runif(100,min=0.012,max=0.028))
for (i in 1:nrow(plist))
#Define the spectrum of inital values for population size

initlist <- cbind(S = runif(100,min = 110681, max = 118636),I1 = runif(100,min=798, max=2926),I2 = runif(100,min=266,max=1463),L=runif(100,min=13300, max=27930))
for (i in 1:nrow(initlist))

#run multiple simulations  
simulationlist[[i]] <- as.data.frame(lsoda(initlist[i,], dt, SI1I2L, parms=plist[i,],events = list(func = eventtct, time = c(2,12) ))) 

Answer 1

Please test my solution. Thinks it works

    #### Clear currrent lists from memory
    rm(list=ls())
    library(deSolve)

    #generate an empty list for the data to be put into

    simulationlist <- list()

    #define the transmission model

    SI1I2L <- function(t, y, parameters) {
      with(as.list(c(parameters,y)),{
        dS <- - Beta*S*I1 - Beta*S*I2 + treat*I1 + treat*I2 +latenttreat*L
        dI1 <- + Beta*S*I1 + Beta*S*I2 - treat*I1 -second*I1 - latent*I1
                dI2 <- + second*I1 - latent*I2 - treat*I2 + relapse*L
        dL <- +latent*I1 + latent*I2 - relapse*L - latenttreat*L

        der <- c(dS, dI1,dI2, dL)
        list(der)    
      }) 

    } 
    n=10;
    #define Total Community Treatment Parameters
    TCTlist = runif(n,min = 0.88, max = 0.99);
    #eventtct <- function(t, y, parms){
    eventtct <- function(t,y,parameters){
      with (as.list(y,parameters),{
    #    eval(TCT=parameters[7])
        S <- S + TCT*L + TCT*I1 + TCT*I2
        I1 <- I1*(1-TCT)
        I2 <- I2*(1-TCT)
        L <- L*(1-TCT)
        return(c(S,I1,I2,L))
      })
    }

    #Set the time frame for the model
    dt    <- seq(0,100,1)    




    #Define the spectrum of Parameters for transmission with Min/Max values and number of     variations
    plist <- cbind(Beta = runif(n,min = 0.00000167, max = 0.0000043),second = runif(n,min= 0.0278,max = 0.0556),latent = runif(n,min=0.004, max=0.009), treat = runif(n, min=0.01, max =0.03),latenttreat = runif(n,min=0.004,max=0.009),relapse = runif(n,min=0.012,max=0.028))
    for (i in 1:n)
      #Define the spectrum of inital values for population size

      initlist <- cbind(S = runif(n,min = 110681, max = 118636),I1 = runif(n,min=798, max=2926),I2 = runif(n,min=266,max=1463),L=runif(n,min=13300, max=27930))


    for (i in 1:n){
        #run multiple simulations  
      parameters = c(plist[i,],TCT=TCTlist[i]);
      eventsfunction = list(eventtct, time = c(2,12) );
      simulationlist[[i]] <- as.data.frame(ode(initlist[i,], time=dt, func=SI1I2L,         parms=parameters,events =eventsfunction )) 
    }