使用R Shiny中的用户输入过滤数据表输出

Question

I am working on an app which allows the user to select specific inputs. In this case the app provides two selectizeInput options to select from the various options.

The following is the dataset:

data_test = data.frame(Name = c ("ABC","ABC","ABC","DEF","DEF", "XYZ", "XYZ", "PQR"),
          Country = c("US, Japan","US, Japan","US, Japan","Canada, US","Canada, US", "UK, US", "UK, US", "Germany"),
          Region = c("North America, Asia","North America, Asia","North America, Asia","North America","North America", "Europe, North America", "Europe, North America", "Europe"),
          Contact = c(1234,1234,1234,7578,7578,9898,9898,7660),
          ContactPerson = c("Geoff","Mary","Mike","Don","Sean","Jessica","Justin","John"))

In ui.R

dashboardPage(skin = "blue",
  dashboardHeader(title = 'My APP'),

  dashboardSidebar(
    sidebarMenu(
      menuItem("Profiles", tabName = "profiles", icon=icon("user")),
      menuItem("Search", tabName = "search", icon=icon("search")),
      menuItem("About App", tabName="about", icon = icon("info"))
    )
  ),
  dashboardBody(
    tabItems(
            tabItem(tabName ="profiles",
                    tabBox( title = "", 
                            width = 12, id = "tabset1", height = "850px",
                    tabPanel("People",
                            fluidRow(
                          box(title = "Filters", solidHeader = TRUE,
                              background = "blue" , collapsible = TRUE, width = 12,
                                  fluidRow(
                                    column(4,selectizeInput("country",label="Country",choices= NULL, multiple = TRUE)),
                                    column(4,selectizeInput("geogPref",label="Region",choices= NULL, multiple = TRUE))
                                          )
                              )
                            ),
                          box(title = "Filtered Results",
                              collapsible = TRUE, status = "success",
                              width = 12, DT::dataTableOutput('results'))
                            ),
                    tabPanel("Details",
                             fluidRow(
                                    box(width = 4, background = "blue",
                                        collapsible = TRUE, solidHeader = TRUE)
                                    )
                            )
                          )
                    ),
            tabItem(tabName ="search",
                    titlePanel("Search"),

                    fluidRow(
                            )  
                    ),
            tabItem(tabName="about",
                    titlePanel("About APP"),
                    HTML("This is an app.")
                    )
            )
      )
)

In server.R

library(shiny)
trim.leading <- function (x)  sub("^\\s+", "", x)

uniqueValues <- function(x){
values <- c()
s <- (unlist(strsplit(x, ",", fixed = TRUE)))
v <- trim.leading(s)
}    

geog <- c()
geog <- unique(unlist(c(geog, sapply(data_set$Region, uniqueValues))))


shinyServer(function(input, output, session) {

  updateSelectizeInput(session, 'country', choices = unique(data_set$Country), server = TRUE)
  updateSelectizeInput(session, 'geogPref', choices = geog, server = TRUE)

  country <-  reactive({
    c <- c()
    c <- c(c, input$country)
  })


  dataset <- reactive({
    data <- data_set
    if (input$country){
      data$c1 <- grepl(paste(country(), collapse = "|"), data$Country)
    }
    else {
      data$c1 <- TRUE
    }

    if (input$geogPref){
      data$c2 <- grepl(input$geogPref, data$Region)
    }
    else {
      data$c2 <- TRUE
    }


    data <- data[which(data$c1 == TRUE & data$c2 == TRUE ),c("Name", "Contact", "ContactPerson")]

    return (data)

  })

  output$results <- DT::renderDataTable(
    DT::datatable( unique(dataset()),
                   rownames = FALSE, options = list(searchable = FALSE)
    ) 

})

So based on the user selection, I need to filter out the rows that contain all those strings and update the table with only those relevant rows. I am not able to update the table with the filters. With this code I am getting, this error:

Error in if: argument is of length zero
Stack trace (innermost first):
    96: <reactive:dataset> [D:\shinyapps\myapp/server.R#21]
    85: dataset
    84: unique
    83: DT::datatable
    82: exprFunc

Can someone help with what I am doing wrong?

Answer 1

You can simplify the server code:

shinyServer(function(input, output, session) {

      updateSelectizeInput(session, 'country', choices = unique(data_set$Country), server = TRUE)
      updateSelectizeInput(session, 'geogPref', choices = geog, server = TRUE)

      dataset <- reactive({
        data <- data_set
        if (length(input$country)){
          data$c1 <- grepl(paste(input$country, collapse = "|"), data$Country)
        }
        else {
          data$c1 <- TRUE
        }

        if (length(input$geogPref)){
          data$c2 <- grepl(paste(input$geogPref, collapse = "|"), data$Region)
        }
        else {
          data$c2 <- TRUE
        }

        data[data$c1  & data$c2 ,c("Name", "Contact", "ContactPerson")]
      })

      output$results <- DT::renderDataTable(
        DT::datatable( dataset(),
                       rownames = FALSE, options = list(searchable = FALSE)
        )) 
    })