Reputation: 17
I am working on my first shiny app where I would like to have multiple sliders to control parameters to my main function. My plot is not updating when I change any of the sliders. Any help would be great. Thank you.
ui <- fluidPage(titlePanel("Effects of Tick to Carrier Interaction on Human CCHF Cases Per Year"),
sliderInput("betaTC","Tick to Carrier Contact", min=0, max=1, step=0.1, value=0),
sliderInput("betaCT", "Carrier to Tick Contact", min=0, max=1, step=0.1, value=0),
sliderInput("betaHH", "Human to Human Contact", min=0, max=1, step=0.1, value=0),
#DT::dataTableOutput("data"),
plotOutput("plotIH"))```
server <- function(input, output, session){
#ommitted code initializing defaultParams, initialXcombined, timeCombined
dataSetCombined <- eventReactive(defaultParams,{
ode(y = initialXCombined,
times = timeCombined,
func = CCHFModelCombined,
parms = defaultParams,
sliderValue1 = input$betaTC,
sliderValue2 = input$betaCT,
sliderValue3 = input$betaHH,
method = "ode45"
) %>%
as.data.frame() -> out
})
output$data <- DT::renderDataTable({
dataSetCombined()
})
output$plotIH <- renderPlot({
ggplot(dataSetCombined(), aes(x=time , y = IH)) +
geom_line(color = '#00CED1', size = 1) +
ggtitle("Crimean-Congo haemorrhagic fever") +
scale_x_continuous(name = "Time(days)") +
scale_y_continuous(name = "Infected Humans", limits = c(0,50))
})
}
shinyApp(ui = ui, server = server)
In my Function I replace values of defaultParams with the slider values
Upvotes: 0
Views: 318
Reputation: 21349
To obtain a reactive plot, please use the following code. I have not posted your function. At the moment, it does not appear to change the plot based on the 3 selected slider inputs. It really depends on how they are used in your function. It is best to have all 11 parameters as slider inputs. You can provide those as input in defaultParams
. Some of the lines are overlapping. To differentiate them you can log scale y-axis. Hope this helps.
solve_eqns <- function(eqns, ics, times, parms){
trySolve <- tryCatch(deSolve::lsoda(y = ics,
times = times,
func = eqns,
parms = parms),
error = function(e) e,
warning = function(w) w)
if (inherits(trySolve, "condition")) {
print(paste("deSolve error:", trySolve$message))
stop("ODE solutions are unreliable. Check model attributes e.g. equations, parameterization, and initial conditions.")
} else {
soln <- deSolve::lsoda(y = ics,
times = times,
func = eqns,
parms = parms)
}
output <- data.frame(soln) %>% tbl_df() %>%
tidyr::gather(variable, value, 2:ncol(.))
return(output)
}
ui <- fluidPage(titlePanel("Effects of Tick to Carrier Interaction on Human CCHF Cases Per Year"),
sliderInput("betaTC","Tick to Carrier Contact", min=0, max=1, step=0.1, value=0),
sliderInput("betaCT", "Carrier to Tick Contact", min=0, max=1, step=0.1, value=0),
sliderInput("betaHH", "Human to Human Contact", min=0, max=1, step=0.1, value=0),
#DTOutput("data1")
#plotOutput("plotIH")
#plotOutput("plotlyIH")
plotlyOutput("plotlyIH", width="900px", height="500px")
)
server <- function(input, output, session){
# time to start solution
timeCombined = seq(from = 0, to = 365, by = 0.1)
#initialize initial conditions
initialXCombined = c(SH = 82000, EH = 0, IH = 1, RH = 0, ST = 870000, ET = 0, IT = 107010, SC = 145000, EC = 0, IC = 35, RC = 0)
defaultParams <- reactive({
req(input$betaTC,input$betaHH,input$betaCT)
params <- c(betaHH = input$betaHH, # .0000022,
betaTH = .000018,
betaCH = .0000045,
betaTC = input$betaTC, # One tick attaches to one carrier per year
betaCT = input$betaCT, # 59/365, # One cattle infects 59 ticks per year (assuming 60 ticks on cattle)
betaTTV = 0.0001, # ticks not giving birth
betaTTH = 59/365,
gamma = 1/10, # death occurs 7-9th day after onset of illness plus 2 day incubation
muH = (1/(365 * 79)),
muT = (1/(365* 2)) + 0.0035,
muC = (1/(8 * 365)), #sheep/deer live 6-11 years
piH = 1.25/(79 * 365), # one couple produces 2.5 children in a lifetime, so one mother produces 1.25
piT = 0.00001, # ticks not giving birth
piC = 3/(8 * 365), # sheep produce 7 babies in their life
deltaH1 = 1/2.5, # 1-3 days from ticks, 5-6 days from blood contact
deltaT = 1/1.5,
deltaC = 1/2,
alpha = 1/17, # recovery after 15 days
alpha2 = 1/7)
params
})
ds <- reactive({data <- solve_eqns(CCHFModelCombined,
initialXCombined,
timeCombined,
defaultParams())
data$variable <- factor(data$variable, levels=unique(data$variable))
return(data)
})
output$data1 <- DT::renderDT({
ds()
})
output$plotlyIH <- renderPlotly({
legend_title <- "Compartment"
textsize <- 10
linesize <- 2
sirplot <- ggplot(ds(), aes(x = time, y = value, colour = as.factor(variable))) +
geom_line(size = linesize) +
scale_colour_discrete(legend_title) +
labs(x="Time", y="Number of Individuals", title="Crimean-Congo haemorrhagic fever") +
theme_bw() + theme(axis.text = element_text(size = textsize),
axis.title= element_text(size = textsize + 2),
legend.text = element_text(size = textsize),
legend.title = element_text(size = textsize + 2) )
sirplotly <- ggplotly(sirplot)
sirplotly
})
}
shinyApp(ui = ui, server = server)
Upvotes: 1