无法使用 ShinyApp 中的 SelectInput 按钮 select 多列

Question

我正在使用 R 构建一个 shinyApp。目前我正在使用 selectinput 到 select multiple regions/columns 通过设置 multiple=TRUE。但由于某些不可预见的原因，它无法正常工作。 它仅在我将 ALL 放入选择区域 时有效。 我相信我的 问题出在服务器 的反应部分。我附上了我的代码如下。有人可以调查一下，让我知道他们出了什么问题吗？万分感谢:)

  **Updated Codes**

  library(shiny)
  library(tidyr)
  library(dplyr)
  library(readr)
  library(DT)

  data_table<-mtcars[,c(2,8,1,3,4,5,9,6,7, 10,11)]

  data_table$disp<-NULL

  names(data_table)[3:10]<- rep(x = 
c('TS_lhr_Wave_1','TS_isb_Wave_2','TS_quta_Wave_1','TS_karach_Wave_2',                                                                            

'NTS_lhr_Wave_1','NTS_isb_Wave_2','NTS_quta_Wave_1','NTS_karach_Wave_2'), 
                              times=1, each=1)   

  # Define UI
  ui <- fluidPage(
  downloadButton('downLoadFilter',"Download the filtered data"),

  selectInput(inputId = "cyl",
              label = "cyl:",
              choices = c("All",
                          unique(as.character(data_table$cyl))),
              selected = "All",
              multiple = TRUE),


  checkboxGroupInput(inputId = "regions", label = "choose region",
                     choices =c("All", "lhr", "isb", "quta", "karach"), 
                     inline = TRUE,   selected = c("All")),


  checkboxGroupInput(inputId = "waves", label = "choose wave",
              choices =c("All", "Wave_1", "Wave_2"), inline = TRUE,
              selected = c("All")),


  DT::dataTableOutput('ex1'))


  # Define Server
  server <- function(input, output) {

  thedata <- reactive({

    if(input$cyl != 'All'){
      data_table<-data_table[data_table$cyl %in%   input$cyl,] }  


    #region
    cols <- c(1, 2)
    # print(input$regions)
    if  ('All' %in% input$regions){
      cols <- 1:ncol(data_table)
    }
    else{
      if  ('lhr' %in% input$regions){
        cols <- c(cols, c(3,7))

      }  
      if  ('isb' %in% input$regions){
        cols <- c(cols, c(4,8))

      }
      if  ('quta'  %in%  input$regions){
        cols <- c(cols, c(5,9))

      }
      if  ('karach'  %in%  input$regions){
        cols <- c(cols, c(6,10))

      }}                

    #else
    data_table<-data_table[,cols, drop=FALSE] 




    #waves
    colss <- c(1, 2)
    # print(input$regions)
    if  ('All' %in% input$waves){
      colss <- 1:ncol(data_table)
    }
    else{
      if  ('Wave_1' %in% input$waves){
        colss <- c(colss, c(3,5,7, 9))
      }  

      if  ('Wave_2'  %in%  input$waves){
        colss <- c(colss, c(4,6, 8, 10))
      }}                

    #else
    data_table<-data_table[,colss, drop=FALSE] 


  }) 


  output$ex1 <- DT::renderDataTable(DT::datatable(filter = 'top',
                                                  escape = FALSE, 
                                                  options = list(                                                                      


scrollX='500px',autoWidth = TRUE),{
                                                      thedata()   }))

  output$downLoadFilter <- downloadHandler(
    filename = function() {
      paste('Filtered data-', Sys.Date(), '.csv', sep = '')  },
    content = function(path){
      write_csv(thedata(),path)   })}

  shinyApp(ui = ui, server = server)

Answer 1

所以你假设错误是在服务器的反应部分是正确的，我发现了两个主要问题。

1. 当你 select 多个区域时，input$regions 是一个多于一个字符的向量，这就是为什么当 R 计算表达式 input$regions == 'lhr' 时它仅将 input$regions 的第一个元素与 'lhr' 进行比较，并在控制台中打印出一条警告。

2. 如果语句您要重新分配data_table变量，例如，当'lhr'和'isb'选择时，则在第一个[= = =时选择'isb' 18=] 语句你为 data_table 分配了 4 列，然后在计算第二个 if

时要求第八列

建议：在开发App的过程中可以添加打印语句作为调试手段，在运行App开发的时候眼睛盯着控制台看情况。我添加了一个打印语句作为评论，如果你想取消评论并尝试它。

thedata <- reactive({

if(input$cyl != 'All'){
  data_table <- data_table[data_table$cyl %in% input$cyl,] }  

#region
all_cols <- names(data_table)
region_cols <- c("cyl", "vs" )
# print(input$regions)
if  ('All' %in% input$regions){
  region_cols <- names(data_table)
}
else{
  if  ('lhr' %in% input$regions){
    region_cols <- c(region_cols, all_cols[grep('lhr', all_cols)])

  }  
  if  ('isb' %in% input$regions){
    region_cols <- c(region_cols, all_cols[grep('isb', all_cols)])

  }
  if  ('quta'  %in%  input$regions){
    region_cols <- c(region_cols, all_cols[grep('quta', all_cols)])

  }
  if  ('karach'  %in%  input$regions){
    region_cols <- c(region_cols, all_cols[grep('karach', all_cols)])

  }}                

#waves
waves_cols <- c("cyl", "vs" )
# print(input$regions)
if  ('All' %in% input$waves){
  waves_cols <- names(data_table)
}
else{
  if  ('Wave_1' %in% input$waves){
    waves_cols <- c(waves_cols, all_cols[grep('Wave_1', all_cols)])
  }  

  if  ('Wave_2'  %in%  input$waves){
    waves_cols <- c(waves_cols, all_cols[grep('Wave_2', all_cols)])
  }}                
# print(intersect(region_cols, waves_cols))
data_table <- data_table[,intersect(region_cols, waves_cols), drop=FALSE]
})

至于评论中的问题，似乎我在选择 "All" 时忘记添加 if 语句 (:P)，现在它的工作方式是一旦 "All" 是选择则无需评估另一个 if 语句。

并且前两列现在总是 selected（并且不重复），无论是否有任何区域 selected。