Shiny 滑块未更新

Question

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

Answer 1

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)