在 Shiny 应用程序中过滤数据框

Question

我正在尝试使用用户输入作为单选按钮来过滤数据框。不幸的是，只有一种类型的过滤器有效（在我的示例中为“年度”版本），但“每月”和“每季度”选项没有返回任何内容。这是我的示例数据集和代码。

    # 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)

Answer 1

文档对这个限制不是很清楚，但是在

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

你找到了

choiceValues 中的元素仍然必须是纯文本（这些是 用于计算的值）。但是choiceNames 中的元素（UI 标签）可以用 HTML 构造出来，或者使用 HTML() 函数或 HTML 标记生成函数，如 tags$img() 和 图标（）。

纯文本是必需的，因为它必须跨越 JS 和 R 之间的边界。您可以使用 JSON 作为传输器；在这里我真的不推荐它，但它相当容易：

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)

Answer 2

这对你有用吗：

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)