如何实现Shiny模态框打开时下拉菜单默认处于关闭状态

我来帮你搞定这个问题！你遇到的情况是因为Shiny原生的selectInput依赖Selectize.js，当模态框加载完成时，下拉菜单意外处于展开状态。我们可以通过两种方式解决：

方法一：利用Selectize.js API手动关闭下拉 #

修改你的modal.js代码，在模态框完全显示后，调用Selectize的关闭方法，确保下拉菜单默认收起：

$('.ui.modal').modal({
  onVisible: function() {
    $('#my_table').show().trigger('shown');
    // 调用Selectize的close方法关闭下拉菜单
    $('#picker').selectize()[0].selectize.close();
  }
}).modal('show');

替换原代码中的modal.js后，完整代码如下：

library(shiny)
library(shinyjs)
library(shiny.semantic)
library(DT)

modal.js <- "$('.ui.modal').modal({
  onVisible: function() {
    $('#my_table').show().trigger('shown');
    $('#picker').selectize()[0].selectize.close();
  }
}).modal('show');"

ui <- semanticPage(
  suppressDependencies("bootstrap"),
  useShinyjs(),
  div(
    class = "ui modal",
    div(class = "header", "Modal header"),
    div(class = "content",
        div(class = "ui raised segment",
            selectInput(inputId = "picker", label = "Select column", choices = names(iris), selected = names(iris)[-1], multiple=T),
            br(),
            DT::dataTableOutput("my_table")))
  ),
  div(class = "ui basic button action-button", id = "open_modal", "Open modal ui")
)

server <- function(input, output, session) {
  output$my_table = DT::renderDataTable(head(iris[,input$picker]))
  observeEvent(input$open_modal, runjs(modal.js))
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

方法二：改用shiny.semantic原生下拉组件 #

既然你在用shiny.semantic，更推荐使用它的dropdown_input组件，这样能更好地和Semantic UI模态框兼容，避免样式和行为冲突：

library(shiny)
library(shinyjs)
library(shiny.semantic)
library(DT)

modal.js <- "$('.ui.modal').modal('show'); $('#my_table').show().trigger('shown');"

ui <- semanticPage(
  suppressDependencies("bootstrap"),
  useShinyjs(),
  div(
    class = "ui modal",
    div(class = "header", "Modal header"),
    div(class = "content",
        div(class = "ui raised segment",
            # 改用shiny.semantic的dropdown_input
            dropdown_input(
              input_id = "picker",
              label = "Select column",
              choices = names(iris),
              selected = names(iris)[-1],
              multiple = TRUE
            ),
            br(),
            DT::dataTableOutput("my_table")))
  ),
  div(class = "ui basic button action-button", id = "open_modal", "Open modal ui")
)

server <- function(input, output, session) {
  output$my_table = DT::renderDataTable(head(iris[,input$picker]))
  observeEvent(input$open_modal, runjs(modal.js))
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

这个方法不需要额外的JS代码，因为dropdown_input默认就是收起状态，和Semantic UI的模态框适配性更好。

内容的提问来源于stack exchange，提问作者6PO0222