Filter data frame in Shiny app

问题

I'm trying to filter a data frame with user input as radio buttons. Unfortunately, only one type of filter works (the "Annual" version in my example), but the "Monthly" and "Quarterly" options are not returning anything. Here is my sample data set and code.

    # sample data
mydf <- data.frame("Data"=rnorm(12), 
                   "Months"=c("Jan", "Nov", "Dec", "Feb", 
                              "Mar", "Apr", "May", "Jun", 
                              "Jul", "Aug", "Sep", "Oct"))
library(shiny)
library(dbplyr)
ui <- fluidPage(
        # Input() function
        radioButtons(inputId = "myDateInterval", label = "Select Date Interval",
                     choiceNames = list("Monthly","Quarterly","Annual"),
                     choiceValues = list(unique(as.character(mydf$Month)),
                                         unique(as.character(mydf$Month))
                                      [seq(1,length(unique(mydf$Month)),3)],
                                         unique(as.character(mydf$Month)[1]))),

        # Output() functions
        tableOutput("results"))
# set up server object
server <- function(input, output) {
        output$results <-  renderTable({
                mydf %>% filter(Months %in% input$myDateInterval)
        })
}
shinyApp(ui = ui, server = server)

回答1:

The documentation is not very clear about this limitation, but in

https://blog.rstudio.com/2017/04/05/shiny-1-0-1/

you find

The elements in choiceValues must still be plain text (these are the values used for computation). But the elements in choiceNames (the UI labels) can be constructed out of HTML, either using the HTML() function, or an HTML tag generation function, like tags$img() and icon().

Plain text is required because it has to cross the border between JS and R. You could use JSON as a transporter; I do not really recommend it here, but it is fairly easy:

library(jsonlite)
library(shiny)
mydf <- data.frame("Data"=rnorm(12), 
                   "Months"=c("Jan", "Nov", "Dec", "Feb", 
                   "Mar", "Apr", "May", "Jun", 
                   "Jul", "Aug", "Sep", "Oct"), stringsAsFactors = FALSE)
ui <- fluidPage(
  # Input() function
  radioButtons(inputId = "myDateInterval", label = "Select Date Interval",
               choiceNames = list("Monthly","Quarterly","Annual"),
               choiceValues = list(toJSON(mydf$Month),
                                   toJSON(mydf$Month[seq(1,length(unique(mydf$Month)),3)]),
                                   toJSON(mydf$Month[1]))),

  # Output() functions
  tableOutput("results"))
# set up server object
server <- function(input, output) {
  output$results <-  renderTable({
    ipt = fromJSON(input$myDateInterval)
    ret = mydf[mydf$Months %in% ipt,]
    ret
  })
}
shinyApp(ui = ui, server = server)

回答2:

Would this work for you:

ui <- fluidPage(
  # Input() function
  radioButtons(inputId = "myDateInterval", label = "Select Date Interval",
               choiceNames = list("Monthly","Quarterly","Annual"), choiceValues = list("Monthly","Quarterly","Annual")),

  # Output() functions
  tableOutput("results"))
# set up server object
server <- function(input, output) {
  output$results <-  renderTable({

    if(input$myDateInterval == "Monthly") {

   mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month))))

    }

    if(input$myDateInterval == "Quarterly") {

      mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month)))[seq(1,length(unique(mydf$Month)),3)])

    }

    if(input$myDateInterval == "Annual") {

      mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month)[1])))

    }

    mydf2
  })
}
shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/48890869/filter-data-frame-in-shiny-app

标签

Shiny

radio-button

dbplyr