Question

我正在开发我的第一个闪亮的应用程序，其中我希望有多个滑块来控制主要功能的参数。更改任何滑块时，绘图都不会更新。任何帮助都会很棒。谢谢。

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)

在函数中，我将defaultParams的值替换为滑块值

Answer 1

要获取反应曲线，请使用以下代码。我还没有发布您的功能。目前，似乎并没有基于3个选定的滑块输入来更改绘图。这实际上取决于在您的函数中如何使用它们。最好将所有11个参数都作为滑块输入。您可以在defaultParams中提供这些内容作为输入。有些线是重叠的。为了区分它们，您可以记录比例y轴。希望这会有所帮助。

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)

闪亮的滑块不更新

1 个答案: