【问题标题】:How to combine top navigation (navbarPage) and a sidebar menu (sidebarMenu) in shiny如何在闪亮中结合顶部导航(navbarPage)和侧边栏菜单(sidebarMenu)
【发布时间】:2018-02-19 02:23:29
【问题描述】:

我有一个带有许多选项卡的闪亮应用程序(使用 navbarPage),我想添加一个无论选择哪个选项卡都可以看到的侧边栏菜单。侧边栏中的输入值会影响所有选项卡的内容。 此外,应该可以隐藏 sidebarMenu,因为它在闪亮的仪表板中。

我看到了两种可能的方式:

(A) 使用 shinydashboard 并以某种方式添加顶部导航栏或

(B) 使用 navbarPage 并以某种方式添加可以隐藏的侧边栏菜单。

(A) 使用 shinydashboard,最接近我想要的是这个(简化的 MWE):

library("shiny")
library("shinydashboard")

cases <- list(A=seq(50,500, length.out=10), B=seq(1000,10000, length.out=10))

ui <- dashboardPage(
  dashboardHeader(title = "dash w/ navbarMenu"),
  dashboardSidebar(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE), numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1)),
  dashboardBody(
    tabsetPanel(
      tabPanel(h4("Perspective 1"),
               tabsetPanel(
                 tabPanel("Subtab 1.1", plotOutput("plot11")),
                 tabPanel("Subtab 1.2")
               )),
      tabPanel(h4("Perspective 2"),
               tabsetPanel(
                 tabPanel("Subtab 2.1"),
                 tabPanel("Subtab 2.2")
               ))
    )
  )
)

server <- function(input, output) {
  output$plot11 <- renderPlot({
    hist(rnorm(cases[[input$case]][input$num]))
  })
}

shinyApp(ui, server)

这很丑,因为导航栏菜单是不属于菜单的选项卡集。我想要的是:

基于这个post,我猜根本不可能在顶部菜单中包含“Perspective 1”和“Perspective 2”选项卡,因此使用 shinydashboard 似乎不可行。

(B) 使用 navbarPage,我尝试使用 navlistPanel() 但没有成功

(1) 使其行为类似于侧边栏菜单,即在页面左侧整体可见并且

(2) 添加隐藏功能。这是我的尝试:

library("shiny")

cases <- list(A=seq(50,500, length.out=10),
              B=seq(1000,10000, length.out=10))

ui <- navbarPage(title = "nav w/ sidebarMenu",
                   tabPanel(h4("Perspective 1"),
                            tabsetPanel(
                              tabPanel("Subtab 1.1",
                                       plotOutput("plot11")),
                              tabPanel("Subtab 1.2")
                            )),
                   tabPanel(h4("Perspective 2"),
                            tabsetPanel(
                              tabPanel("Subtab 2.1"),
                              tabPanel("Subtab 2.2")
                            )),

                 navlistPanel(widths = c(2, 2), "SidebarMenu",
                              tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
                              tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
                 )
)


server <- function(input, output) {
  output$plot11 <- renderPlot({
    hist(rnorm(cases[[input$case]][input$num]))
  })
}

shinyApp(ui, server)

同样,我想要的是:

我知道,有flexDashboard。它没有解决问题有三个原因:

(1) 我认为侧边栏菜单是不可能隐藏的,因为它是一个列而不是真正的侧边栏菜单,

(2) 它不是我在应用程序中需要的响应式,

(3) 我认为dataTables 不工作,我也需要。

此外,我宁愿不必将代码更改为 Rmarkdown 语法。

我最好使用 navbarPage 并添加一个 sidebarMenu,因为我的应用程序已经使用 navbarPage 构建了。

【问题讨论】:

    标签: r shiny sidebar shinydashboard


    【解决方案1】:

    您可以使用sidebarLayout 并执行以下操作:

    ui <- fluidPage(sidebarLayout(
      sidebarPanel(navlistPanel(
        widths = c(12, 12), "SidebarMenu",
        tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
        tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
      )),
          mainPanel(navbarPage(title = "nav w/ sidebarMenu",
                                
                                tabPanel(h4("Perspective 1"),
                                         tabsetPanel(
                                           tabPanel("Subtab 1.1",
                                                    plotOutput("plot11")),
                                           tabPanel("Subtab 1.2")
                                         )),
                                tabPanel(h4("Perspective 2"),
                                         tabsetPanel(
                                           tabPanel("Subtab 2.1"),
                                           tabPanel("Subtab 2.2")
                                         )))
          
          )
        ))
    

    你会得到这样的东西:

    另一种选择是使用fluidRow 函数。像这样的:

      ui <- fluidPage(
        fluidRow(
          column(3, navlistPanel(
            widths = c(12, 12), "SidebarMenu",
            tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
            tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
          )),
          column(9,  navbarPage(title = "nav w/ sidebarMenu",
                                 
                                 tabPanel(h4("Perspective 1"),
                                          tabsetPanel(
                                            tabPanel("Subtab 1.1",
                                                     plotOutput("plot11")),
                                            tabPanel("Subtab 1.2")
                                          )),
                                 tabPanel(h4("Perspective 2"),
                                          tabsetPanel(
                                            tabPanel("Subtab 2.1"),
                                            tabPanel("Subtab 2.2")
                                          ))))
          
          
        )
          )
        
    

    要得到这个:

    希望对你有帮助!

    【讨论】:

    • 感谢 SBista。是否可以使 sidebarMenu 可折叠?
    • 您可以使用来自shinyjs 包的hide
    • 我知道 R 但在 HTML 方面完全没有经验,我对此有一些疑问:这是一个合法的用途(不使用 navbarPage 作为顶级容器)?
    【解决方案2】:

    现在有一种更简单、更优雅的方式来实现它:

    shinydashboardPlus

    here 看看它的实际效果。

    【讨论】:

    • 你能详细说明一下这个@jmjr 吗?我看到我可以添加一个带有 shinydashboardPlus 的 left_menu,但是如何在其中放置适当的导航?放置 sidebarMenu() 并不能真正令人满意。
    • 此已接受答案中的两个链接之一已失效。也许@jmjr 愿意用可重现的代码更新答案以替换死链接?
    【解决方案3】:

    现在可以使用bootstraplib

    Github 请求实现这个: https://github.com/rstudio/bootstraplib/issues/76

    最小代表:

    # package load ------------------------------------------------------------
    library(shiny)
    library(bootstraplib)
    
    # boot dash layout funs ---------------------------------------------------
    
    
    boot_side_layout <- function(...) {
      div(class = "d-flex wrapper", ...)
    }
    
    boot_sidebar <- function(...) {
      div(
        class = "bg-light border-right sidebar-wrapper",
        div(class = "list-group list-group-flush", ...)
      )
    }
    
    boot_main <- function(...) {
      div(
        class = "page-content-wrapper",
        div(class = "container-fluid", ...)
      )
    }
    
    
    
    # title -------------------------------------------------------------------
    html_title <-
      '<span class="logo">
        <div style="display:inline-block;">
          <a href="https://www.google.com"><img src="https://jeroen.github.io/images/Rlogo.png" height="35"/></a>
          <b>my company name</b> a subtitle of application or dashboard
        </div>
      </span>'
    
    
    # css ---------------------------------------------------------------------
    
    css_def <- "
    body {
      overflow-x: hidden;
    }
    
    .container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
        padding-left: 0px;
    }
    
    .sidebar-wrapper {
      min-height: 100vh;
      margin-left: -15rem;
      padding-left: 15px;
      padding-right: 15px;
      -webkit-transition: margin .25s ease-out;
      -moz-transition: margin .25s ease-out;
      -o-transition: margin .25s ease-out;
      transition: margin .25s ease-out;
    }
    
    
    .sidebar-wrapper .list-group {
      width: 15rem;
    }
    
    .page-content-wrapper {
      min-width: 100vw;
      padding: 20px;
    }
    
    .wrapper.toggled .sidebar-wrapper {
      margin-left: 0;
    }
    
    .sidebar-wrapper, .page-content-wrapper {
      padding-top: 20px;
    }
    
    .navbar{
      margin-bottom: 0px;
    }
    
    @media (max-width: 768px) {
      .sidebar-wrapper {
        padding-right: 0px;
        padding-left: 0px;
    
      }
    }
    
    @media (min-width: 768px) {
      .sidebar-wrapper {
        margin-left: 0;
      }
    
      .page-content-wrapper {
        min-width: 0;
        width: 100%;
      }
    
      .wrapper.toggled .sidebar-wrapper {
        margin-left: -15rem;
      }
    }
    
    "
    
    
    # app ---------------------------------------------------------------------
    ui <- tagList(
      tags$head(tags$style(HTML(css_def))),
      bootstrap(),
      navbarPage(
        collapsible = TRUE,
        title = HTML(html_title),
        tabPanel(
          "Tab 1",
          boot_side_layout(
            boot_sidebar(
              sliderInput(
                inputId = "bins",
                label = "Number of bins:",
                min = 1,
                max = 50,
                value = 30
              )
            ),
            boot_main(
              fluidRow(column(6, h1("Plot 1")), column(6, h1("Plot 2"))),
              fluidRow(
                column(6, plotOutput(outputId = "distPlot")),
                column(6, plotOutput(outputId = "distPlot2"))
              )
            )
          )
        ),
        tabPanel(
          "Tab 2",
          boot_side_layout(
            boot_sidebar(h1("sidebar input")),
            boot_main(h1("main output"))
          )
        )
      )
    )
    
    server <- function(input, output) {
      output$distPlot <- renderPlot({
        x <- faithful$waiting
        bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
        hist(x,
          breaks = bins, col = "#75AADB", border = "white",
          xlab = "Waiting time to next eruption (in mins)",
          main = "Histogram of waiting times"
        )
      })
    
      output$distPlot2 <- renderPlot({
        x <- faithful$waiting
        bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
        hist(x,
          breaks = bins, col = "#75AADB", border = "white",
          xlab = "Waiting time to next eruption (in mins)",
          main = "Histogram of waiting times"
        )
      })
    }
    
    shinyApp(ui, server)
    

    【讨论】:

    • 这是一个不错的布局,你知道如何使侧边栏在选项卡之间永久化,以便在侧边栏中显示相同的输入,无论选择哪个选项卡? (如仪表板)
    猜你喜欢
    • 2020-01-04
    • 1970-01-01
    • 2014-07-03
    • 1970-01-01
    • 2018-07-06
    • 2014-04-21
    • 2017-06-22
    • 2014-09-02
    相关资源
    最近更新 更多