如何在 r 中动态更新选择输入的选择

Question

我正在开发一个闪亮的应用程序，其中选择输入的选择应该根据之前的输入动态更新。

例如，如果在第一个输入小部件中同时选择了类别和细分，并且在第二个输入小部件中只选择了 skin_care，则药物和非药物 应该作为第三个输入小部件中的选项，而不是段的所有唯一名称。 如果在第二个输入小部件中选择了 hair_care 而不是 skin_care，则应该在第三个输入小部件下拉列表中选择 Gents and Ladies。 所以基本上从下拉列表中选择的选择取决于用户在早期输入小部件上选择的内容。品牌也一样。 在这里，我假设维度的选择总是从左到右。

实际应用会要求用户加载数据，它可以有 10 个维度，也可能更多。为简单起见，我保留了三个。

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("Data", fluid = TRUE,
         sidebarLayout(
           sidebarPanel(p("Please remove None first"),
                        uiOutput("dim"),
                        uiOutput("levels1")),
           mainPanel(
             DT::dataTableOutput("data_display")
           ))))))

server <- shinyServer(function(input,output){

# creating Data 
data <- reactive({
data <-  data.frame(Date = as.Date(c("2018-05-25","2018-05-26")),
            category = c(rep("skin_care",6),rep("hair_care",6)),
            Segment =  c(rep("Medicated",4),rep("Non_Medicated",2),
                       rep("Ladies",4),rep("Gents",2)),
            Brand = c("X","X","Y","Y","Z","Z","A","A","B","B","C","C"),
            sales = round(rnorm(12,100,3)))
})


# Displaying Data  

output$data_display <- DT::renderDataTable(                    
datatable(data(),options = list(pageLength = 12),rownames = FALSE)
)

# selects dimension (Only character variable to be selected)

output$dim<-renderUI({
b<-colnames(data()[sapply(data(),class)=="character"])
selectInput("x","Select only character variable",choices = 
              c("NONE",b[1:length(b)]),selected="NONE",multiple = TRUE)
 })

 #  user selects levels of dimension 

output$levels1<-renderUI({
if(is.null(input$x)){
  return(NULL)
}
else if(sum(input$x=="NONE")==1){
  return(NULL)
}
else{
  lapply(seq(input$x),function(i){
    selectInput(inputId = paste0("range",i),
                paste0("Select level of ",input$x[i]),
                choices = c(unique(data()[,input$x[i]]),"ALL"),multiple = TRUE)

   })
  }
 })
 })
shinyApp(ui,server)

编辑：在动态出现的 selectinput 小部件的下拉菜单中提供选项

Answer 1

我玩弄了您提供的代码。这个答案可能看起来不完整，但我相信这是解决您问题的最佳方式。让我们来看看：

1. 在 ui 部分中，我添加了另一个名为 level3 的 uiOutput-wrapper（仅在第一个下拉菜单中选择了多个输入时才返回下拉菜单）
2. 随后我在服务器部分添加了另一个renderUI
3. 我将DT-table 移到了服务器部分的末尾
4. 我在server-part的levels1-object中添加了一套完整的if-else条件（解释的太复杂了，自己试一下）
5. 我还添加了一套完整的 if-else-conditions 来检查 ui 是否有效

但是我看不出如何在我的答案中保持我的代码通用。我的意思是，如果您有多个列，那么为每列创建一个下拉列表可能会更容易。对我来说似乎更容易。

主要问题是您无法在第一个下拉菜单中猜测用户会首先选择哪个元素。因此，您需要检查所有可能的组合。如果您有两个以上的变量，那就太疯狂了。无论如何，因为你知道数据 你比我更清楚，如果额外的编程工作值得花时间。如果您不相信我，请使用我的代码，尝试概括代码，使用五个字符列，然后在您学到的内容下方评论。

最后但并非最不重要的一点是，我经常使用grep 来对数据进行子集化。如果你将它与paste 和collapse='|' 结合起来，它会匹配你的字符向量的每个场合。

这是应用程序：

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
  tabsetPanel(
    tabPanel("Data", fluid = TRUE,
             sidebarLayout(
               sidebarPanel(uiOutput("dim"),
                            uiOutput("levels1"),
                            uiOutput("level3")),
               mainPanel(
                 DT::dataTableOutput("data_display")
               ))))))

server <- shinyServer(function(input,output){

  # creating Data 
  data <- reactive({
    data <-  data.frame(Date = as.Date(c("2018-05-25","2018-05-26")),
                        category = c(rep("skin_care",6),rep("hair_care",6)),
                        Brand = c("X","X","Y","Y","Z","Z","A","A","B","B","C","C"),
                        sales = round(rnorm(12,100,3)),stringsAsFactors = FALSE)
  })




  # selects dimension (Only character variable to be selected)

  output$dim<-renderUI({
    b<-colnames(data()[sapply(data(),class)=="character"])
    selectInput("x","Select only character variable",
                choices = b[1:length(b)],multiple = TRUE)
  })


  #  user selects levels of dimension 
  output$levels1<-renderUI({
    if(is.null(input$x)){
      return(NULL)
    }
    else if(sum(input$x=="NONE")==1){
      return(NULL)
    }
    else{
      mydata<-data()
      if(length(input$x)==2){
        selectInput(inputId = 'range1',
                    paste0("Select level of ",'category'),
                    choices = unique(as.character(mydata$category)),
                    selected = "",multiple = TRUE)
      } else {
        lapply(seq(input$x),function(i){
          mychoice<-unique(as.character(mydata[,input$x[i]]))
          selectInput(inputId = paste0("range",i),
                      paste0("Select level of ",input$x[i]),
                      choices = mychoice,selected = "",multiple = TRUE)
          })
      }
    }
  })

  output$level3<-renderUI({
    if(is.null(input$range1) | length(input$x)<2){
      return(NULL)
    } else {
      mydata<-data()
      myrows<-grepl(paste0(input$range1,collapse = '|'),mydata$category)
      mychoices<-unique(as.character(mydata$Brand[myrows]))
      selectInput(inputId = 'range2',
                  paste0("Select level of ",'category'),
                  choices = mychoices,
                  selected = mychoices,multiple = TRUE)
    }

  })

  # Displaying Data  

  output$data_display <- DT::renderDataTable({
    if(is.null(input$x)){ #show full data when nothing is selected in first dropdown
      mydata<-data()
    }
    if(is.null(input$range1)){ # show full data when nothing is selected in second drop down
      mydata<-data()
    } else { # something is selected in second dropdown
      if(length(input$x)>1){ # First dropdown contains two elements
        mydata<-data()
        if(!is.null(input$range2)){
          mydata=mydata[grep(paste0(input$range2,collapse='|'),as.character(mydata$Brand)),]
        }
      } else { # First dropdown contains one element
        mydata<-data()
        if(input$x=='Brand'){
          mydata=mydata[grep(paste0(input$range1,collapse='|'),as.character(mydata$Brand)),]
        } else{
          mydata=mydata[grep(paste0(input$range1,collapse='|'),as.character(mydata$category)),]
        }
      } # close: First dropdown has one element
    } # close: something is selected in second dropdown


    datatable(mydata,options = list(pageLength = 12),rownames = FALSE)
  })


  # observeEvent(input$x,
  #              updateSelectInput(inputId = paste0("range",i),
  #                                paste0("Select level of ",input$x[i]),
  #                                choices = unique(data()[,input$x])))

})

shinyApp(ui,server)