shiny - 在 R Shiny App 中隐藏主标题切换

Question

我正在寻找一种方法来隐藏主标题切换图标，就像我们使用 ShinyJS 包在 R Shiny App 中的侧边栏所做的那样。附上图片以供参考。

代码

library(shiny)
library(shinydashboard)
library(shinyjs)

ui <- shinyUI(dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs()
)
))

server <- shinyServer(function(input, output, session) {
addClass(selector = "body", class = "sidebar-collapse") # Hide Side Bar
})

shinyApp(ui = ui, server = server)

Answer 1

在应用程序启动时隐藏侧边栏切换的一种方法是使用以下JS()功能htmlwidgets：

library(shiny)
library(shinydashboard)
library(shinyjs)
library(htmlwidgets)

ui <- dashboardPage(
  dashboardHeader(title = "Title"),

  dashboardSidebar(
    # Remove the sidebar toggle element
    tags$script(JS("document.getElementsByClassName('sidebar-toggle')[0].style.visibility = 'hidden';"))
  ),

  dashboardBody()
)

server <- function(input, output, session) {
}

shinyApp(ui = ui, server = server)

我发现以下线程有助于解决这个问题：

使用操作按钮启用和禁用侧边栏切换按钮

在 R 闪亮的页面加载时调用 javascript 函数

Answer 2

我遇到了同样的问题..以下是解决方案...让我知道它是否适合您：-

library(shiny)
library(shinydashboard)
library(shinyjs)

ui <- shinyUI(dashboardPage(
  dashboardHeader(),
  dashboardSidebar( tags$head(
    tags$script(
      HTML(#code for hiding sidebar tabs 
        "Shiny.addCustomMessageHandler('manipulateMenuItem1', function(message)
        {
        var aNodeList = document.getElementsByTagName('a');

        for (var i = 0; i < aNodeList.length; i++) 
        {
        if(aNodeList[i].getAttribute('data-toggle') == message.toggle && aNodeList[i].getAttribute('role') == message.role) 
        {
        if(message.action == 'hide')
        {
        aNodeList[i].setAttribute('style', 'display: none;');
        } 
        else 
        {
        aNodeList[i].setAttribute('style', 'display: block;');
        };
        };
        }
        });"
                                                      )
    )
    )
    ),
  dashboardBody(
    useShinyjs(),
    actionButton("h1","Hide toggle"),
    actionButton("h2","Show toggle")
  )
))

server <- shinyServer(function(input, output, session) {
  observeEvent(input$h1,{
     session$sendCustomMessage(type = "manipulateMenuItem1", message = list(action = "hide",toggle = "offcanvas", role = "button"))
    })
  observeEvent(input$h2,{
    session$sendCustomMessage(type = "manipulateMenuItem1", message = list(action = "show",toggle = "offcanvas", role = "button"))
  })
})

shinyApp(ui = ui, server = server)

Answer 3

您可以更新dashboardHeader功能并删除创建按钮的项目。请注意，我只是将其注释掉并重命名了该函数。

#rm(list = ls())
library(shiny)
library(shinydashboard)
library(shinyjs)
mydashboardHeader <- function(..., title = NULL, disable = FALSE,title.navbar=NULL, .list = NULL) {
  items <- c(list(...), .list)
  #lapply(items, tagAssert, type = "li", class = "dropdown")
  tags$header(class = "main-header",
              style = if (disable) "display: none;",
              span(class = "logo", title),
              tags$nav(class = "navbar navbar-static-top", role = "navigation",
                       # Embed hidden icon so that we get the font-awesome dependency
                       span(shiny::icon("bars"), style = "display:none;"),
                       # Sidebar toggle button
#                        a(href="#", class="sidebar-toggle", `data-toggle`="offcanvas",
#                          role="button",
#                          span(class="sr-only", "Toggle navigation")
#                        ),

                       title.navbar,
                       div(class = "navbar-custom-menu",
                           tags$ul(class = "nav navbar-nav",
                                   items
                           )
                       )
              )
  )
}

ui <- shinyUI(dashboardPage(
  mydashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs()
  )
))

server <- shinyServer(function(input, output, session) {})
shinyApp(ui = ui, server = server)