Невозможно выбрать несколько столбцов с помощью кнопки SelectInput в ShinyApp - PullRequest
Новая
       38

Невозможно выбрать несколько столбцов с помощью кнопки SelectInput в ShinyApp

0 голосов
/ 29 ноября 2018

Я создаю inyApp, используя R .В настоящее время я использую selectinput , чтобы выбрать несколько регионов / столбцов , поставив несколько = ИСТИНА.Но это не работает по какой-то непредвиденной причине.Это работает только тогда, когда я поставил ВСЕ в выбранном регионе .Я считаю, что моя проблема заключается в реактивной части сервера .Я приложил свои коды, как показано ниже.Может кто-нибудь, пожалуйста, посмотрите на них и дайте мне знать, что с ними не так.Пакет благодарностей:) 

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

1 Ответ

0 голосов
/ 29 ноября 2018

Итак, ваше предположение, что ошибка в реактивной части сервера верна, я обнаружил две основные проблемы.

  1. Когда вы выбираете более одного региона, тогда input$regionsявляется вектором из более чем одного символа, поэтому, когда R вычисляет выражение input$regions == 'lhr', он сравнивает только первый элемент input$regions с 'lhr' и выводит предупреждение в консоли.

  2. В каждом операторе if вы повторно присваиваете переменную data_table, например, когда 'lhr' и 'isb' выбраны, то в первом операторе if, который вы назначаете data_table с 4 столбцами,и затем запросите восьмой столбец при оценке второго if

Предложение: при разработке приложения вы можете добавить операторы печати в качестве метода отладки, а также при запуске приложенияследите за консолью, чтобы увидеть, что происходит.Я добавил одну инструкцию для печати в качестве комментария, если вы хотите отменить комментарий и попробуйте его. 

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

Что касается проблем с комментарием, кажется, что я забыл добавить инструкцию if, когда "All"((P), теперь он работает таким образом, что после выбора «Все» нет необходимости оценивать другой оператор if.

И первые два столбца теперь всегда выбираются (и не дублируются).), независимо от того, выбран какой-либо регион или нет.

...