1

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)
zx8754
  • 52,746
  • 12
  • 114
  • 209
samq
  • 11
  • 1
  • 3

2 Answers2

2

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)
Dieter Menne
  • 10,076
  • 44
  • 67
0

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)
MLavoie
  • 9,671
  • 41
  • 36
  • 56
  • Thank you @MLavoie. It does work! But i was hoping to avoid using if statements if it's not necessary. Any ideas on how to do that? – samq Feb 20 '18 at 18:41
  • I don't think it is possible. It says: "The values should be strings" Maybe someone else will have a better solution. – MLavoie Feb 20 '18 at 18:48