在 Shiny (R) 中创建动态过滤器

Question

我正在尝试创建一个闪亮的应用程序，其中多条件过滤器中的代码取决于用户输入。 因此，如果选择“全部”，我们会看到所有内容，如果所选输入等于其他任何内容，我们只会看到该输入的数据。

if 语句将代码插入到 dplyr 过滤器中。

我希望我能正确解释这一点，任何帮助将不胜感激，请参阅下面的代码：

服务器

library(dplyr)
library(ggplot2)
library(shiny)


shinyServer(function(input, output) {


 raw <- diamonds



  output$cutlist <- renderUI({

  cutlist <- sort(unique(as.vector(raw$cut)), decreasing = FALSE)
  cutlist <- append(cutlist, "All", after =  0)
  selectizeInput("cutchoose", "Cut:", cutlist)

 })


  output$colorlist <- renderUI({

colorlist <- sort(unique(as.vector(raw$color)), decreasing = FALSE)
colorlist <- append(colorlist, "All", 0)
selectizeInput("colorchoose", "color:", colorlist)

})


   output$table <- renderDataTable({



   if(input$colorchoose == "All") {

  filt1 <- quote(color != "@?><")


} else {

  filt1 <- quote(color == input$colorchoose) 

}


if (input$cutchoose == "All") {

  filt2 <- quote(cut != "@?><")


} else {

  filt2 <- quote(cut == input$cutchoose)

}



  raw %>%
  filter_(filt1) %>%
  filter_(filt2)


   })

   })

用户界面

 shinyUI(fluidPage(

 # Application title
 titlePanel("Dynamic Filter Test App"),


  sidebarLayout(
   sidebarPanel(
   uiOutput("cutlist"),
   uiOutput("colorlist")
   ),


mainPanel(
  dataTableOutput("table")
   )
  )
 ))

安慰

  Warning: Error in if: argument is of length zero
  Stack trace (innermost first):
  79: renderDataTable [D:\Independent Learning\R 
       code\dynamFilter/server.R#44]
  78: func
  77: origRenderFunc
   76: output$table
    1: runApp

Answer 1

这对我有用：

output$table <- renderDataTable({

    req(input$colorchoose)
    req(input$cutchoose)
    if(input$colorchoose == "All") {

      filt1 <- quote(color != "@?><")


    } else {

      filt1 <- paste0("color == ","'",input$colorchoose,"'") 

    }


    if (input$cutchoose == "All") {

      filt2 <- quote(cut != "@?><")


    } else {

      filt2 <- paste0("cut == ","'",input$cutchoose,"'")

    }



    raw %>%
      filter_(filt1) %>%
      filter_(filt2)


  })

开头的 req 语句会阻止对 renderDataTable 进行完全评估，直到正确初始化输入。 第二个问题是输入变量似乎不在过滤器动态评估的范围内，因此我更改了语句以包含这些变量的值而不是它们的名称。

Answer 2

我有一次类似的错误。 我认为原因是renderUI表达式不一定及时评估以生成if语句所需的input值。 由于selectInput()的renderUI表达式中实际上没有任何反应值，因此您可以将它们放在ui脚本中并将它们从server脚本中取出。

这对我有用：

library(dplyr)
library(ggplot2)
library(shiny)

raw <- diamonds
cutlist <- sort(unique(as.vector(raw$cut)), decreasing = FALSE) %>%
  append("All", after =  0)
colorlist <- sort(unique(as.vector(raw$color)), decreasing = FALSE) %>%
  append("All", 0)

server <- function(input, output) {
  output$table <- renderDataTable({
    if(input$colorchoose == "All") { 
      filt1 <- quote(color != "@?><")
      } else { filt1 <- quote(color == input$colorchoose) }
    if (input$cutchoose == "All") { 
      filt2 <- quote(cut != "@?><")
      } else { filt2 <- quote(cut == input$cutchoose) }
    filter_(raw, filt1) %>% filter_(filt2) } ) }

ui <- shinyUI(fluidPage(
  titlePanel("Dynamic Filter Test App"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("cutchoose", "Cut:", cutlist),
      selectizeInput("colorchoose", "color:", colorlist) ),
    mainPanel( dataTableOutput("table") ) ) ) )

shinyApp(ui = ui, server = server)