Question

我正在开发一款允许用户选择特定输入的应用。在这种情况下，应用程序提供了两个selectizeInput选项，可以从各种选项中进行选择。

以下是数据集：

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

在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.")
                    )
            )
      )
)

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

})

因此，基于用户选择，我需要过滤掉包含所有这些字符串的行，并仅使用那些相关行更新表。我无法使用过滤器更新表格。我得到这个代码，这个错误：

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

有人可以帮助我做错了吗？

Answer 1

您可以简化服务器代码：

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

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

1 个答案: