javascript - 在 Shiny 中选择一个选项时如何关闭汉堡菜单的下拉菜单

Question

我在 R Shiny 中有一个可折叠的导航栏菜单。当菜单折叠并且我点击汉堡包按钮时，选项出现了。当我单击其中一个选项时，(正确地)选择了另一个面板，但菜单保持打开状态。

是否可以(使用 css？)让“下拉菜单”(即选项列表)在我选择其中一个选项后立即关闭？

代码如下所示:

library(shiny)

ui <- tagList(
  navbarPage(
    title = NULL, id = "navBar", collapsible = TRUE,

    tabPanel(title = "Panel1", uiOutput('panel1')),
    tabPanel(title = "Panel2", uiOutput('panel2')),
    tabPanel(title = "Panel3", uiOutput('panel3'))
  )
)

server <- function(input, output, session) {
  output$panel1 <- renderUI({p("This is panel 1")})
  output$panel2 <- renderUI({p("This is panel 2")})
  output$panel3 <- renderUI({p("This is panel 3")})
}  

shinyApp(ui = ui, server = server)

Answer 1

您可以使用 input$navBar(您在 navbarPage() 中的 id)监听 navbarPage 并通过 javascript 触发更改。

  observeEvent(input$navBar, {
    runjs('
      var elem = document.getElementsByClassName("navbar-collapse")[0]
      elem.setAttribute("aria-expanded", "false");
      elem.setAttribute("class", "navbar-collapse collapse");
    ')
  })

可重现的例子:

library(shiny)
library(shinyjs)

ui <- tagList(
  useShinyjs(),
  navbarPage(
    title=NULL, id = "navBar", collapsible = TRUE,

    tabPanel(title = "Panel1", uiOutput('panel1')),
    tabPanel(title = "Panel2", uiOutput('panel2')),
    tabPanel(title = "Panel3", uiOutput('panel3'))
  )
)

server <- function(input, output, session) {
  output$panel1 <- renderUI({p("This is panel 1")})
  output$panel2 <- renderUI({p("This is panel 2")})
  output$panel3 <- renderUI({p("This is panel 3")})

  observeEvent(input$navBar, {
    runjs('
      var elem = document.getElementsByClassName("navbar-collapse")[0]
      elem.setAttribute("aria-expanded", "false");
      elem.setAttribute("class", "navbar-collapse collapse");
    ')
  })
}

shinyApp(ui = ui, server = server)