【问题标题】:Problem with selecting columns within selected columns using RadioButtons in ShinyApp在 ShinyApp 中使用 RadioButtons 在选定列中选择列的问题
【发布时间】:2019-05-01 05:33:07
【问题描述】:

我正在使用 R 构建 shinyApp。我正在使用 radioButtons 来选择列,然后再次使用 radiobuttons 在先前选定的列中选择更多列。 我无法这样做,因为每当我从 choose variable'、'choose wave' 和 'choose wave' 中选择 All 以外的任何内容时都会出现错误。

我认为问题在于服务器的反应部分。 有人可以看看我的代码吗?我将非常感激:)

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

radioButtons(inputId = "columns", label = "choose variable",
           choices =c("All","TS", "NTS"), inline =TRUE,
           selected = c("TS")),

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

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


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


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

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

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


#TS NTS
if  (input$columns== 'TS'){
  data_table<-  data_table[,c(1,2, 3,4,5,6),drop=FALSE]    }


if  (input$columns== 'NTS'){
  data_table<-  data_table[,c(1,2,7,8,9,10),drop=FALSE]    }



#region
if  (input$regions== 'lhr' ){
  data_table<-  data_table[,c(1,2,3,7),
                           drop=FALSE]    }

if  (input$regions== 'isb' ){
  data_table<-  data_table[,c(1,2,4,8),
                           drop=FALSE]    }


if  (input$regions== 'quta' ){
  data_table<-  data_table[,c(1,2,5,9),
                           drop=FALSE]    }


if  (input$regions== 'karach' ){
  data_table<-  data_table[,c(1,2,6,10),
                           drop=FALSE]    }


#waves
if  (input$waves== 'Wave_1' ){
  data_table<-  data_table[,c(1,2,3,5,7, 9),
                           drop=FALSE]    }

if  (input$waves== 'Wave_2' ){
  data_table<-  data_table[,c(1,2,4,6, 8, 10),
                           drop=FALSE]    }


else
  data_table })

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

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)

【问题讨论】:

  • 是的,你的问题在于你的 if 条件逻辑的反应性或更具体。您按索引过滤列,它会尝试过滤不再存在的列,因为它们在之前的 if 语句中被过滤掉了。您必须适应所有这些条件,并且可能按列名而不是索引进行过滤。
  • 例如,如果您过滤表中的 TS 或 NTS 列,然后在您的区域选择中,您再次过滤 TS NTS 列,但其中之一将不可用因为它们已经被过滤掉了。因此,只有将变量设置为 All 时,才能使用区域和波浪过滤器。
  • 嗨,伙计,非常感谢您的帮助。是否可以更新代码?当我试图解决它,但对我不起作用

标签: r shiny radio-button dashboard dt


【解决方案1】:

我不确切知道您想如何构建该逻辑,但这里有一个如何禁用和启用某些输入的示例。它仍然会在控制台中引发一些错误,但至少所有内容都在应用程序中正确显示。

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

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(
  useShinyjs(),
  downloadButton('downLoadFilter',"Download the filtered data"),

  radioButtons(inputId = "columns", label = "choose variable",
               choices =c("All","TS", "NTS"), inline =TRUE,
               selected = c("All")),

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

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


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


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

  DT::dataTableOutput('ex1', width="100%")
)}


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

  observe({
    if (input$columns != "All") {
      updateRadioButtons(session, "regions", selected = "All")
      updateRadioButtons(session, "waves", selected = "All")

      shinyjs::disable("regions")
      shinyjs::disable("waves")
    } else {
      shinyjs::enable("regions")
      shinyjs::enable("waves")
    }

    if (input$regions != "All") {
      shinyjs::disable("waves")
    }
    if (input$waves != "All") {
      shinyjs::disable("regions")
    }
  })



  thedata <- reactive({

    #TS NTS
    if  (input$columns == 'TS'){
      data_table<-  data_table[,c("cyl","vs", "TS_lhr_Wave_1", "TS_isb_Wave_2", "TS_quta_Wave_1", "TS_karach_Wave_2"),drop=FALSE]    }
    if  (input$columns == 'NTS'){
      data_table<-  data_table[,c("cyl","vs","NTS_lhr_Wave_1", "NTS_isb_Wave_2","NTS_quta_Wave_1", "NTS_karach_Wave_2"),drop=FALSE]    }

    #waves
    if  (input$waves == 'Wave_1' ){
      data_table<-  data_table[,c("cyl","vs","TS_lhr_Wave_1","TS_quta_Wave_1","NTS_lhr_Wave_1", "NTS_quta_Wave_1"), drop=FALSE]    }
    if  (input$waves == 'Wave_2' ){
      data_table<-  data_table[,c("cyl","vs","TS_isb_Wave_2","TS_karach_Wave_2", "NTS_isb_Wave_2", "NTS_karach_Wave_2"), drop=FALSE]    }

    #region
    if  (input$regions == 'lhr' ){
      data_table<-  data_table[,c("cyl","vs","TS_lhr_Wave_1","NTS_lhr_Wave_1"), drop=FALSE]    }
    if  (input$regions == 'isb' ){
      data_table<-  data_table[,c("cyl","vs","TS_isb_Wave_2","NTS_isb_Wave_2"), drop=FALSE]    }
    if  (input$regions == 'quta' ){
      data_table<-  data_table[,c("cyl","vs","TS_quta_Wave_1","NTS_quta_Wave_1"), drop=FALSE]    }
    if  (input$regions == 'karach' ){
      data_table<-  data_table[,c("cyl","vs","TS_karach_Wave_2","NTS_karach_Wave_2"), drop=FALSE]    }

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

    req(data_table)

    data_table
  })

  output$ex1 <- DT::renderDataTable({
    req(thedata())

    DT::datatable(filter = 'top', escape = FALSE, width = "100%",
                  options = list(pageLength =  10, 
                                 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)

【讨论】:

    猜你喜欢
    • 2019-03-28
    • 2019-06-08
    • 2019-05-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2020-09-13
    • 1970-01-01
    相关资源
    最近更新 更多