闪亮的滑块不更新

如何解决闪亮的滑块不更新

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

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",sliderInput("betaHH","Human to Human Contact",#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的值替换为滑块值

解决方法

要获取反应曲线，请使用以下代码。我还没有发布您的功能。目前，似乎并没有基于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,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",sliderInput("betaHH","Human to Human Contact",#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)