首页 > 解决方案 > 调整单选按钮和滑块后如何刷新绘图?

问题描述

对于我正在开发的闪亮应用程序,我希望在用户调整滑块和单选按钮后直方图会刷新。

如何将单选按钮和滑块与绘图链接?

我尝试过使用filter(),当单选按钮调整为“是”或“否”时,它总是会导致绘图不出现。但是,当单选按钮保持在“全部”时,情节看起来很好。

下面是server.r我用过的:

plotdata<- reactive({
    if(input$DayTrade=="All")
        {dataset %>%
         filter(dataset$INVEST<=input$INVEST[2],
               dataset$INVEST>=input$INVEST[1],
               dataset$Age<=input$Age[2],
               dataset$Age>=input$Age[1],dataset$DayTrade==dataset$DayTrade)}
    else if (input$DayTrade=="No")
        {dataset %>%
         filter(dataset$INVEST<=input$INVEST[2],
               dataset$INVEST>=input$INVEST[1],
               dataset$Age<=input$Age[2],
               dataset$Age>=input$Age[1],dataset$DayTrade=="No")}
    else 
        {dataset %>%
         filter(dataset$INVEST<=input$INVEST[2],
                dataset$INVEST>=input$INVEST[1],
                dataset$Age<=input$Age[2],
                dataset$Age>=input$Age[1],dataset$DayTrade=="Yes")}

})
output$histogramplot<-renderPlot({
  datos<-plotdata()
  ggplot(datos, aes(factor(Age),fill=factor(SEX))) + geom_bar(bins=15)  
})

下面是ui.r我用过的:

tabPanel("no-Eaccount",sidebarLayout(
    sidebarPanel(

      sliderInput("INVEST","Invest Range:",min = 0,max = 5000,value = c(100,300),pre="$"),
      sliderInput("Age","Age Range:",min = 0,max = 100,value = c(20,30)),
      radioButtons("DayTrade", "Day Trade:",
                   choices = c("Yes", "No","All"),
                   selected = "All")

    ),

    mainPanel(
      div(plotOutput("histogramplot"),style="width:100%")         
    )
    ))

我该如何解决这个问题?

标签: rshiny

解决方案


我们可以使用eventReactive来监听单选按钮和滑块,并在它们发生变化时做出反应。这是一个例子

shinyApp(
  ui = fluidPage(
    column(4,
           radioButtons("x", "Value x", choices = c('5'=5,'7'=7,'8'=8), selected = 5),
           sliderInput("y", "Value y", value = 7,6,10)
    ),
    column(8, tableOutput("table"))
  ),
  server = function(input, output, sessio) {
    # Take an action every time button is pressed;
    # here, we just print a message to the console
    observeEvent(input$x, {
      cat("Showing", input$x, "rows\n")
    })
    # Take a reactive dependency on input$x or input$y, but
    # not on any of the stuff inside the function
    df <- eventReactive(as.numeric(input$x) | input$y, {
      data.frame(x=input$x,y=input$y)
    })
    output$table <- renderTable({
      df()
    })
  }
)

推荐阅读