[SOLVED] Two-Host SI model and varying parameters in R

Issue

This Content is from Stack Overflow. Question asked by Sprawk48

I’m currently working on a two-host epidemiological SI model. That is, a compartmental model with no recovery compartment.

I’m still relatively new to R, but am developing a decent understanding after mostly using MATLAB. However, the thing I am having issues with finding any helpful resources on is how to vary two different input parameters so I can examine them and maybe even 3-D plot these variables or phase plot them to see if the population dies off.

So, more specifically I want to produce results when varying mu between 0 and 1, and alpha between 0 and 1, I could just “plug and play” but I want to be able to show a more dynamic result and think it would be handy to have as a tool in my wheel-house.

Anyway, here is the code I have so far:

# Here we will load the required packages for the assignment
library(deSolve) 
library(ggplot2)

# Here we  the two-host (male & female) SI model

KModel <- function(time, state, params){
  
  with(as.list(c(state, params)),{
    N <- SF+IF+SM+IM
    dSF <- r*(SF+alpha*IF)-r*N*SF-BFM*(SF*IM)/N
    dIF <- (BFM*(SF*IM)/N)-r*N*IF-mu*IF
    dSM <- r*(SF+alpha*IF)-r*N*SM-BMF*(SM*IF)/N
    dIM <- (BMF*(SM*IF)/N)-r*N*IM-mu*IM
    
    return(list(c(dSF, dIF, dSM, dIM)))
  })
}
# here are the initial parameters

r = 0.2
BFM = 1.2
BMF = 1
mu = 0
alpha = 0

params<-c(r,BFM,BMF,mu,alpha)

initial_state<-c(SF=0.49 ,IF=0.01, SM=0.49,IM=0.01)

times<-0:60
# Here we use ode() to numerically solve the system
out1<-ode(y=initial_state, times=times, func=KModel, parms=params, method="ode23")
out<-as.data.frame(out1)
plot(out1)

So, I think I have a pretty good “skeleton” for solving any single solution for a compartmental model, however Like I mentioned I’d like to be able to vary two of the parameters to examine specific scenarios.

Thanks!



Solution

After reading the question a first time, it was not completely clear to me if the parameters should vary over time or if scenarios for different parameter combinations are intended. For the first case, several posts exist already on StackOverflow, e.g. https://stackoverflow.com/a/69846444/3677576 or Modifying SIR model to include stochasticity.

If the influence of parameters should be evaluated in form of scenarios, one may consider nested loops. As a more compact alternative, one can create a matrix with all desired parameter combinations using expand.grid. Then one can use an apply function, e.g. lapply. The (temporary) output tmp is then a list of matrices, that can be converted into a big data frame with the common do.call() approach (see relevant SO posts about this).

This is then joined together with the parameter matrix and forms a suitable data structure for ggplot.

Note also that I used the default solver lsoda instead of ode23, because it is more precise and efficient.

library(deSolve) 
library(ggplot2)
library(dplyr)

KModel <- function(time, state, params){
  
  with(as.list(c(state, params)),{
    N <- SF+IF+SM+IM
    dSF <- r*(SF+alpha*IF)-r*N*SF-BFM*(SF*IM)/N
    dIF <- (BFM*(SF*IM)/N)-r*N*IF-mu*IF
    dSM <- r*(SF+alpha*IF)-r*N*SM-BMF*(SM*IF)/N
    dIM <- (BMF*(SM*IF)/N)-r*N*IM-mu*IM
    
    return(list(c(dSF, dIF, dSM, dIM)))
  })
}

times <- 0:60

parms <- expand.grid(mu = c(0, 0.1, 0.2, 0.3, 1), 
                     alpha = seq(0, 1, 0.1), 
                     r = 0.2, 
                     BFM = 1.2, 
                     BMF = 1)

initial_state <- c(SF = 0.49, IF = 0.01, SM = 0.49, IM = 0.01)


## run all simulations and store it as list of matrices
tmp <- lapply(1:nrow(parms), function(i) 
  cbind(run = i, 
        ode(y = initial_state, times = times, 
            func = KModel, parms = parms[i,])
  )
)

## convert list of matrices to single data frame
out <- as.data.frame(do.call("rbind", tmp))

## add run number to parameter table
parms <- as.data.frame(cbind(parms, run = 1:nrow(parms)))

## join the two tables together and create plots
out %>% 
  left_join(parms, by = "run") %>%
  ggplot(aes(time, IF)) + geom_line() + facet_grid(mu ~ alpha)

## or with colors
out %>% 
  left_join(parms, by = "run") %>%
  mutate(alpha = factor(alpha)) %>%
  ggplot(aes(time, IF, color = alpha)) + geom_line() + facet_grid( ~ mu)

plot with two varying parameters


This Question was asked in StackOverflow by Sprawk48 and Answered by tpetzoldt It is licensed under the terms of CC BY-SA 2.5. - CC BY-SA 3.0. - CC BY-SA 4.0.

people found this article helpful. What about you?