#load various variable definitions that are the same for each app source('startup_script.R') currentrmdfile = knitr::current_input() appsettings = get_settings(currentrmdfile,appdocdir,packagename)
This app is meant to teach you about the basic concepts behind the reproductive number. Read about the model in the "Model" tab. Then do the tasks described in the "What to do" tab.
For this app, we'll use the basic compartmental SIR model. This model has the following compartments: We allow for 3 different stages/compartments:
In addition to specifying the compartments of a model, we need to specify the dynamics determining the changes for each compartment. Broadly speaking, some processes increase the number of individuals in a given compartment/stage and other processes that lead to a reduction. Those processes are sometimes called inflows and outflows.
For our system, we specify the following processes/flows:
The flow diagram and the set of equations which are used are the basic SIR model and are shown again:
knitr::include_graphics(here::here('inst/media',appsettings$modelfigname))
The model equations are:
$$\dot S = - b SI $$ $$\dot I = b S I - g I $$ $$\dot R = g I$$
The app and tasks deal with the reproductive number concept. The following section provides a very brief introduction. I recommend reading a bit more about it. I'm following the terminology of my own write-up. You can also check the books listed in the ID introduction app or some of the papers listed in the _Further Resources section of this app._
The reproductive number is defined as the average number of new infected (and infectious) individuals caused by one infectious individual. The basic reproductive number is the reproductive number in a scenario where everyone is susceptible. For the SIR model shown above, one can figure the value out by determining how many new infections are caused by one infected person. A person is infectious for a duration of 1/g, during that time they infect others at rate b. Thus the average number of new infections during created in b/g. For the whole population, assuming initially everyone is susceptible, we multiply by the number of initial susceptibles to get $$R_0=\frac{bS_0}{g}$$ where S~0~ is the initial number of susceptibles.
For a single outbreak (no births, natural death or waning immunity) and a basic SIR model, an equation linking the final number of susceptibles left at the end and the basic reproductive number is $$R_0=\frac{\ln(S_f)}{(S_f - 1)}$$ where $\ln()$ is the natural logarithm and S~f~ is the fraction of susceptibles still left, i.e. $S_f = S_{final}/S_{initial}$, where $S_{initial}$ and $S_{final}$ are the number of susceptibles at the beginning and end of the outbreak.
Note the unfortunate fact that the letter R is used both for the recovered compartment in the model and the reproductive number. This is standard notation and I'll therefore use it here. Just be careful to figure out from the context if someone is talking about the recovered individuals or the reproductive number.
The tasks below are described in a way that assumes everything is in units of days (rate parameters, therefore, have units of inverse days). If any quantity is not given in those units, you need to convert it first.
#this is the running counter for the records which starts at 1 rc=1 #empty object, will hold all outcomes alloutcomes = NULL # Task 1 tid = 1 tasktext = "Set the simulation the following simulation parameter values 1000 susceptibles, 1 infected, tfinal = 100 days, _g_=0.5, and _b_=0.001. Run the simulation, you should get an outbreak. Use the final size equation linking R~0~ and the fraction of susceptible hosts left at the end of the outbreak to compute the reproductive number (see the information in the _Model_ tab)." # Record for task 1 nrec = 3 # number of items to record out_records = c("Day at which outbreak peaks", "Susceptible at end of simulation", "The value for R~0~") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 2 tid = 2 tasktext = "Use the equation that expresses R~0~ as a function of the model parameters. Using the values of the model parameters from task 1, compute R~0~. Check that it agrees with what you found in the previous task." # Record for task 2 nrec = 1 # number of items to record out_records = c("The value for R~0~") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 3 tid = 3 tasktext = "Double the value of the transmission parameter, _b_. Leave everything else as before. Before you run the simulation, use the equation to compute R~0~. Then run the simulation and compute R~0~ using the final outbreak size. Make sure the two numbers approximately agree." # Record for task 3 nrec = 1 # number of items to record out_records = c("The value for R~0~") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 4 tid = 4 tasktext = "Double the rate of the recovery parameter, _g_. Leave everything else unchanged. Think about your expectations for R~0~ and the resulting outbreak dynamics. Run the simulation to check your expectations. Use the final outbreak size to compute R~0~." nrec = 3 # number of items to record out_records = c("Day at which outbreak peaks", "Susceptible at end of simulation", "The value for R~0~") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 5 tid = 5 tasktext = "Another way to estimate R~0~ is to determine the rate of increase in infected hosts at the beginning of the outbreak. During the initial phase, new infections increase exponentially according to _I(t)=I~0~ exp(rt)_, with _r_ being the rate of growth. Usually, for any real outbreak, you do not know the number of infected at the start, I~0~, or the exact time the outbreak starts. It is still possible to estimate _r_ by obtaining two values of _I_ at two time points during that initial growth rate, i.e. _I~1~_ at time _t~1~_ and _I~2~_ at time _t~2~_. One obtains equations _I~1~=I~0~ exp(r t~1~)_ and _I~2~=I~0~ exp(r t~2~)_. By solving one of these equations for _I~0~_ and substituting into the other, we get _I~2~= I~1~ exp(r (t~2~ - t~1~))_. By solving the model for _r_ and entering numbers for _I~1~_ and _I~2~_ and times _t~1~_ and _t~2~_ we can figure out _r_. Let's try that out. Set the model parameters back to those given in task #1. Let's try using the new method for estimating R~0~. Run the model with tfinal = 1 and tfinal = 2 and record the number of infected at the end of the simulation each time. Then substitute all the values into the equation you found for _r_ and thus compute the growth rate. For this model, the growth rate and R~0~ are related through _R~0~ = 1+rD_, where _D_ is the average duration of the infectious period (i.e. the inverse of the recovery rate). Use this to determine R~0~. You should get essentially the same answer (up to some rounding differences) as for task #1. Note that the choice of _t~1~_ and _t~2~_ can influence the results. Earlier times are better since once the number of susceptibles starts to drop markedly, the growth of infected slows down and is not exponential anymore." # Record for task 5 nrec = 1 # number of items to record out_records = c("The value for R~0~") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 6 tid = 6 tasktext = "What is the value of the reproductive number _R_ at the time the outbreak peaks? (It's only called R~0~ at the beginning for a fully susceptible population). Explain how you can find that value for R, both using intuitive reasoning and using the equation for R~0~ given above (R~0~ = 1+rD). For some hints, note that at the peak numbers of infected are briefly flat, i.e. there is no more growth (what does that mean for _r_?). Also, there is no decline yet, for the infected to stay exactly the same, the average number of infections produced by one infected person before they recover needs to have a very specific value. What is that value? Note that at this R value, the outbreak wanes, but people still get infected. What R value would you need to halt any further infections completely?" # Record for task 6 nrec = 2 # number of items to record out_records = c("R value at which number of infected neither grows nor declines", "R value to completely halt any further infections") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 7 tid = 7 tasktext = "What would happen if a new ID came along that had an R~0~ value that was the same as the one you just determined in the previous question, namely the value of R at the peak of an outbreak? Test this with the simulation. Set everyting as in task 1, then reduce transmission rate by half, which should get you the right R~0~ (you can check by plugging the parameter values into the R~0~ equation). Run the simulation and observe what the model produces. You should not see any outbreak." # Record for task 7 nrec = 1 # number of items to record out_records = c("Nothing") out_types = rep("None",nrec) out_notes = c("") outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task # Task 8 tid = 8 tasktext = "A) R~0~ quantifies the level of transmissibility of an ID, which determines how many people will become infected or what level of intervention is needed to stop/prevent an outbreak. However, it is important to be aware that R~0~ says nothing about the timing/dynamics of the outbreak. Set parameter values as in #1. Also increase simulation time to 200 so we can make sure the outbreak is over. Run an outbreak, pay attention to the time of peak and duration of the outbreak (the latter is somewhat ill-defined, so just come up with a rough number). B) Now increase the infectious duration by a factor of 4 (rate reduced by a factor of 4) and adjust the infectiousness-level such that you get the same R~0~ as before. Run again and compare the results concerning total outbreak size and timing of outbreak." # Record for task 8 nrec = 4 # number of items to record out_records = c("Number susceptible left at end of outbreak (part A)", "Day the outbreak peaked (part A)", "Number susceptible left at end of outbreak (part B)", "Day the outbreak peaked (part B)") out_types = rep("Rounded_Integer",nrec) out_notes = rep("Report the rounded integer",nrec) outcomes = data.frame( TaskID = rep(tid,nrec), TaskText = rep(tasktext,nrec), RecordID = paste0('T',tid,'R',(1:nrec)), Record = out_records, Type = out_types, Note = out_notes) alloutcomes = rbind(alloutcomes,outcomes) rc = rc + nrec #increment record counter by number of outcomes to record for this task
#save the fully filled task table to a tsv file alloutcomes$QuizID = paste0(packagename,"_",appsettings$appid) alloutcomes$AppTitle = appsettings$apptitle alloutcomes$AppID = appsettings$appid #remove a few variables from the data frame savedoutcomes <- dplyr::select(alloutcomes,QuizID,AppID,AppTitle,TaskID,TaskText,RecordID,Record,Type,Note) write.table(savedoutcomes, paste0(appsettings$appid,"_tasktable.tsv"), append = FALSE, sep = "\t", row.names = F, col.names = TRUE)
# Take all the text stored in the table and print the tasks and items to record write_tasktext(alloutcomes)
r appsettings$simfunction
. You can call them directly, without going through the shiny app. Use the help()
command for more information on how to use the functions directly. If you go that route, you need to use the results returned from this function and produce useful output (such as a plot) yourself. vignette('DSAIDE')
into the R console.Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.