如何动态更新R Shiny中的选择输入选择

Question

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

例如，如果在第一个输入窗口小部件中同时选择了类别和细分，而在第二个输入窗口小部件中仅选择了skin_care，则在第三个输入窗口小部件中，应选择“药用”和“非药用”作为选项，而不是所有细分的唯一名称。 如果在第二个输入小部件中选择hair_care而不是skin_care，则应该在第三个输入小部件下拉菜单中选择“ Gents and Ladies”。 因此，基本上，从下拉菜单中进行选择的选择取决于用户在早期输入小部件上选择的内容。 品牌也一样。 在这里，我假设尺寸的选择始终是从左到右。

实际的应用程序会要求用户加载数据，它可以有10个维度，或者可能更大。为简单起见，我保留了3个。

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. 我在服务器部分的levels1添加了一套完整的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)