我想从下拉菜单中的数据集中选择一个样本。
由于有许多样本可供选择，我想通过在复选框下拉菜单中选择其他数据列的值来缩小可选样本的范围。
我可以成功地创建复选框下拉菜单，并打印那里所做的选择。
我很难将这些相同的选定值输入到选择样本的下拉菜单中，我想对selectInput进行选择，但无法像在renderText（）中那样访问变量。
查看代码中的注解，了解我的困惑所在。
谢谢!

library(shiny)
library(dplyr)

##################################
#### checkbox dropdown module ####
##################################

mod_ui_checkbox_dropdown_ui <- function(id){
  ns <- NS(id)
  
  tagList(
    uiOutput(ns("choice_dropdown"))
    
  )
}

mod_ui_checkbox_dropdown_server <- function(id, dropdown_label = "Items", menu_choices = c("item1", "item2", "item3"), dropdown_status = "default"){
  
  dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
    
    status <- match.arg(status)
    # dropdown button content
    html_ul <- list(
      class = "dropdown-menu",
      style = "max-width: 300px;",
      #style = if (!is.null(width))
      #  paste0("width: ", validateCssUnit(width), ";"),
      lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # dropdown button appearance
    html_button <- list(
      class = paste0("btn btn-", status," dropdown-toggle"),
      style = "width: 100%; max-width: 300px; display: flex; justify-content: space-between;",
      type = "button",
      `data-toggle` = "dropdown"
    )
    html_button <- c(html_button, list(label))
    html_button <- c(html_button, list(tags$span(class = "caret", style = "margin-top: 8px;")))
    # final result
    tags$div(
      class = "dropdown",
      do.call(tags$button, html_button),
      do.call(tags$ul, html_ul),
      tags$script(
        "$('.dropdown-menu').click(function(e) {
      e.stopPropagation();
});")
    )
  }
  
  
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    
    # output$selected_items <- renderPrint({
    #   input$dropdown_checkboxes
    # })
    
    
    output$choice_dropdown <- renderUI({
      dropdownButton(
        label = dropdown_label, status = dropdown_status, width = "100%",
        actionButton(inputId = ns("all"), label = "all/none", class = "btn btn-sm", style = "margin-bottom: 8px;"),
        checkboxGroupInput(inputId = ns("dropdown_checkboxes"), label = NULL, choices = menu_choices, selected = menu_choices)
      )
    })
    
    
    
    
    # Select all / Unselect all
    observeEvent(input$all, {
      if (is.null(input$dropdown_checkboxes)) {
        updateCheckboxGroupInput(
          session = session, inputId = "dropdown_checkboxes", selected = menu_choices
        )
      } else {
        updateCheckboxGroupInput(
          session = session, inputId = "dropdown_checkboxes", selected = ""
        )
      }
    })
    
    
    # return selected values
    return(reactive(input$dropdown_checkboxes))
    
  })
}






##################
#### main app ####
##################

ui <- fluidPage(
  
  textOutput("text"),
  uiOutput("sample_dropdown"),
  #uiOutput("manual_checks"),
  br(),
  br(),
  uiOutput("sample_filters"),
  
)

server <- function(input, output, session) {
  
  
  
  data <- tibble::tibble("Sample ID" = c("Sample1", "Sample2", "Sample3", "Sample4", "Sample5", "Sample6"),
                         "Group" = c("group1", "group1", "group2", "group2", "group3", "group3"),
                         "Name" = c("Aime", "Balthasar", "Charlotte", "Daniel", "Emilie", "Fiona"))
  
  ns <- session$ns
 
  
  # helper function. filters dataframe columns for only the entries listed in selected_values
  # selected_values is a list with an entry for each filter dropdown that holds a reactive vector with the selected items from each dropdown
  
  filter_selection <- function(data, selected_values){
    # loop through list by names of the list items
    for (val in names(selected_values)){
      if(!is.null(val)){
        data <- dplyr::filter(data, .data[[val]] %in% selected_values[[val]]())
      }
    }
    return(data)
  }
  
  ### select sample ###
  
  # get selectable samples from study data
  selectable_samples <- reactive({

##### HERE BE DRAGONS 
##### THIS DOES NOT WORK: When I try to access the values from the checkboxes here in this reactive element, I only get the empty list().
##### How do I make this reactive element respond to the selected values?

    ### ONLY PRINTS EMPTY LIST ###
    print(selected_values)
    ### THIS GIVES AN ERROR ###
    #print(selected_values$Name())
    
    data %>%
      
      # filter the choices based on the selected values here
      {if(length(selected_values) != 0) filter_selection(., selected_values) else .} %>%
      
      dplyr::select(any_of("Sample ID")) %>%
      unique() %>%
      pull() %>%
      sort()
   
  })
  
  
  
  output$sample_dropdown <- renderUI({
      selectInput("sample_dropdown", label = NULL, choices = selectable_samples())
  })
  
  
  
  
  ## ---- sample filters ##
  ## this dynamically creates checkbox dropdown menus for selected filter columns
  sample_filter_cols <-  c("Group", "Name")
  
  
  # create filter module UI elements
  output$sample_filters <- renderUI(
    sapply(sample_filter_cols, function(fav){
      mod_ui_checkbox_dropdown_ui(stringr::str_replace_all(fav, " ", "-")) #IDs don't like spaces
    })
  )
  
  # capture filter module outputs in list
  # solution using a list and observe() adapted from here
  # https://stackoverflow.com/questions/57802428/looping-shiny-callmodule-only-exports-last-value
  selected_values <- list()
  observe(
    selected_values <<- sapply(sample_filter_cols, function(x){

      choices <- data %>%
        select(any_of(x)) %>%
        unique() %>%
        pull() %>%
        sort()
        
      mod_ui_checkbox_dropdown_server(stringr::str_replace_all(x, " ", "-"), dropdown_label =  x, menu_choices = choices)
    }, USE.NAMES = TRUE)
  )
  
 
##### THIS WORKS: I can access the selected values of the filter columns here and print them as text.
##### So why won't this propagate to the reactive element above?

output$text <- renderText(paste("selected values:",
                                 paste(selected_values$Name(), collapse = " "),
                                 paste(selected_values$Group(), collapse = " ")
                                 ))


}

shinyApp(ui, server)