OpenSEIR model to share. To run locally, use: library(shiny) runGist('7595396')

server.R

# See https://github.com/mkiang/OpenSEIR for comments or updates.
library(shiny)
library(deSolve) 
library(ggplot2)

shinyServer(function(input, output) { 
    
    # Define the SEIR model for open population
    # b is transmission probability, k is contact rate, r is recovery rate,
    # bd is birth/death rate, and L is the rate from latent to infectious.
    SEIR <- function(t, x, parms){
        with(as.list(c(parms, x)), {
            N <- S + E + I + R
            dS <- -b*k*S*I/N + bd*N - bd*S
            dE <- b*k*S*I/N - L*E - bd*E
            dI <- L*E - r*I - bd*I
            dR <- r*I - bd*R
            result <- c(dS, dE, dI, dR)
            list(result)
        }) 
    }
    
    # Define a function to find max infections
    max.inf <- function(x) {
        infectious <- round(max(x$people[x$compartments=="I"], na.rm=TRUE))
        timestep <- which.max(x$people[x$compartments=="I"])
        info <- cbind(infectious, timestep)
        return(info)
    }
    
    # Interactive part
    output$guessPlot <- renderPlot(function() {
        
        # ODE inputs
        inits <- c(S = 999999, E = 0, I = 1, R = 0)
        ifelse(input$tmax<180, dt <-seq(0, input$tmax, by=.01), 
               ifelse(input$tmax < 600, dt <- seq(0, input$tmax, .1), dt <- seq(0, input$tmax, .25)))
        # Make sure L is not 0 or we get an error. Note that when L = 0,
        # I'm setting it to .000001 which effectively turns the model into an SIR.
        if (input$L==0) tempL <- .01 else tempL <- input$L
        if (input$demographics==FALSE) bd <- 0 else bd <- input$bdrate
        
        # Numbers are a litle weird. Still deciding between days/weeks/months/years.
        guess_pars <- c(r = (1/input$D)*365/12, b=input$b, k=input$k*52/12, L=(1/tempL)*365/12, bd=bd/12)
        
        # Run it
        guess.wide <- as.data.frame(ode(inits, dt, SEIR, parms=guess_pars))
        
        # Modify data a little bit so ggplot() will play nice
        guess <- stack(guess.wide[, -1])
        guess$time <- rep(seq_len(nrow(guess.wide)), length(table(guess$ind)))
        names(guess)[1:2] <- c("people", "compartments")
        guess$compartments <- factor(guess$compartments, levels=c("S", "E", "I", "R"), ordered=TRUE)
        
        # Max infections
        max.guess <- as.data.frame(max.inf(guess))
        max.guess$compartments <- "I"
        
        # Plots
        base.plot <- ggplot(guess, aes(x=time, y=people, group=compartments,
                                       color=compartments)) + geom_line(alpha=.8)
        pretty.plot <- base.plot + theme(legend.position="bottom") + xlab("Time") + 
            theme(legend.title=element_blank()) + ylab("Number of People")
        
        # Need to rescale the x-axis and time info. Also switch on and off text.
        if(input$maxinfect==FALSE) {
            if(input$tmax<180) {
                final.plot <- pretty.plot + geom_text(data=max.guess, aes(timestep*1.1, infectious, 
                                            label=paste("Max people infected:\n", 
                                                    infectious, "at", timestep/100, "months")), 
                                                    hjust=0, vjust=1, show_guide=FALSE, size=5, alpha=.66, 
                                                    color="black") + scale_x_continuous(labels=function(x) x/100)
            } else if(input$tmax>=180 & input$tmax<600) {
                final.plot <- pretty.plot + geom_text(data=max.guess, aes(timestep*1.1, infectious, 
                                            label=paste("Max people infected:\n", 
                                                    infectious, "at", timestep/10, "months")), 
                                                    hjust=0, vjust=1, show_guide=FALSE, size=5, alpha=.66, 
                                                    color="black") + scale_x_continuous(labels=function(x) x/10)
            } else {
                final.plot <- pretty.plot + geom_text(data=max.guess, aes(timestep*1.1, infectious, 
                                            label=paste("Max people infected:\n", 
                                                    infectious, "at", timestep/4, "months")), 
                                                    hjust=0, vjust=1, show_guide=FALSE, size=5, alpha=.66, 
                                                    color="black") + scale_x_continuous(labels=function(x) x/4)
            }
        } else {
            if(input$tmax<180) {
                final.plot <- pretty.plot + scale_x_continuous(labels=function(x) x/100)
            } else if(input$tmax>=180 & input$tmax<600) {
                final.plot <- pretty.plot + scale_x_continuous(labels=function(x) x/10)
            } else {
                final.plot <- pretty.plot + scale_x_continuous(labels=function(x) x/4)
            }
        }
        
        print(final.plot)
        
    })  # closes reactivePlot
})  # Closes shinyServer

ui.R

# See https://github.com/mkiang/OpenSEIR for comments or updates.
library(shiny)

# Define UI
shinyUI(pageWithSidebar(
    
    # Application title
    headerPanel("An SEIR model in a constant population with demographic variables"),
    
    # Sidebar with controls
    sidebarPanel(
        wellPanel(tags$body("This is a simple disease dynamics model with Susceptible, Exposed (but not infectious), Infectious, and Recovered (SEIR) compartments in an open (i.e., births and deaths) population that remains constant. For more, see", tags$a("the wiki.", href="http://en.wikipedia.org/wiki/Compartmental_models_in_epidemiology#The_SEIR_model"))
      ),
        sliderInput("b", "Probability of transmission:", 
                    value=.75, min=0, max=1, step=.01),
        sliderInput("k", "Average contacts (per week):", 
                    value=12, min=1, max=100, step=1),
        sliderInput("L", "Latent period (days):", 
                    value=12, min=0, max=60, step=1),
        sliderInput("D", "Disease duration (days):", 
                    value=7, min=1, max=60, step=1),
        sliderInput("tmax", "Time max (months):", value=600, min=1, max=1200),
        checkboxInput("maxinfect", "Hide infection info", value=TRUE),
        checkboxInput("demographics", "Add birth and death rates", value=TRUE),
        conditionalPanel(
            condition = "input.demographics == true",
            sliderInput("bdrate", label = "Birth and death rates:",
                        min = 0.010, max = .030, step = 0.001, value = .013)),
        
        wellPanel(
            tags$body(tags$p("For simplicity, the model always assumes the epidemic starts with just one infectious person in a constant population of 1 million people with birth rate equal to death rate."),
                      p("Note: When the latent period is 0, the model is effectively an open SIR model--with slightly less accuracy. Likewise, to ensure reponsiveness, the larger time max becomes, the less fine-grained it is.")),
            tags$br(), h5("Created by Mathew Kiang"),
            tags$body("(", tags$a("Git", href="http://github.com/mkiang"),
                      " | ",
                      tags$a("Tweet", href="http://twitter.com/mattkiang")," | ",
                      tags$a("Read", href="http://mathewkiang.com"),")")
        )),
    
    mainPanel(
        plotOutput("guessPlot")
    )
))