在Shiny（R）中创建动态过滤器

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

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)


   })

   })

控制台

  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

---

我曾经犯过类似的错误。我认为原因是，

renderUI

表达式不一定要及时计算，以生成

if

语句所需的

输入值。由于在
selectInput（）
s的
renderUI
表达式中实际上没有任何反应值，因此您可以将它们放入
ui
脚本中，并从
服务器
脚本中取出

这对我很有用：

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)

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)


  })

库（dplyr）
图书馆（GG2）
图书馆（闪亮）
raw这对我很有用：

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)

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)


  })

output$table嗨，Alex，我试过这个，可惜没有乐趣！谢谢你的帮助谢谢Alex，我在另一台设备上试用过，效果也很好！！！只有我的设备soCool，如果它回答了您的问题，请在我的答案（或Bertil的）上打勾。嗨，Bertil，谢谢您的帮助，但这对我不起作用。嗨，Bertil，我在另一台设备上尝试了该代码，它工作了！。。。。。似乎就是我正在使用的设备。。。