使用 shinydashboard 重现 flexdashboard 布局

Question

我正在尝试使用持久侧边栏和多个选项卡来重现 flexdashboard 简单布局。这个问题类似于我最近问过的this one，但在后者中我使用了另一个 SO 答案中的一些代码，而在这个问题中我使用了简单的flexdashboard 代码。

这是一个简单的flexdashboard 布局：

---
title: "Title of a Shiny app"
output: 
  flexdashboard::flex_dashboard
runtime: shiny
---

Sidebar {.sidebar}
=====================================

```{r}
textInput("test", "test")
actionButton("test_2", "test 2")
```

Tab 1
=====================================  

Tab 2
=====================================  

Tab 3
=====================================  

您可以看到它将持久侧边栏与导航栏混合在一起。

但是，我不知道如何在shinydashboard 中重现此内容：

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    textInput("test", "test"),
    actionButton("test_2", "test 2")
  ),
  dashboardBody(
    tabsetPanel(
      tabPanel("Tab 1"),
      tabPanel("Tab 2"),
      tabPanel("Tab 3") 
    )
  )
)

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

shinyApp(ui, server)

此示例中的选项卡不是导航栏，就像 flexdashboard 示例中的那样。

是否有一种简单的方式（即不使用几十行 CSS）来使用 shinydashboard（或其他解决方案）生成 flexdashboard 示例？

Answer 1

我不确定这是否适合您，但您可以使用 shinydashboard 的 dropdownMenu 和 hidden dashboardSidebar 来模仿 flexdashboard 的外观。但是，默认情况下菜单是向右对齐的：

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

ui <- dashboardPage(
  dashboardHeader(
    tags$li(class = "dropdown",
            tags$li(class = "dropdown", actionLink(inputId = "tab1dropdown", label = "Tab 1"), style = "position: absolute; left: 4.3%; top: 50%; transform: translate(-50%, -50%); font-weight: bold;"),
            tags$li(class = "dropdown", actionLink(inputId = "tab2dropdown", label = "Tab 2"), style = "position: absolute; left: 8%; top: 50%; transform: translate(-50%, -50%); font-weight: bold;"),
            tags$li(class = "dropdown", actionLink(inputId = "tab3dropdown", label = "Tab 3"), style = "position: absolute; left: 11.7%; top: 50%; transform: translate(-50%, -50%); font-weight: bold;"),
    )
  ),
  dashboardSidebar(
    textInput("test", "test"),
    actionButton("test_2", "test 2"),
    hidden(sidebarMenu(
        id = "sidebarID",
        menuItem("tab1", tabName = "tab1"),
        menuItem("tab2", tabName = "tab2"),
        menuItem("tab3", tabName = "tab3")
      ))
  ),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem("tab1", "Tab 1 content"),
      tabItem("tab2", "Tab 2 content"),
      tabItem("tab3", "Tab 3 content")
    )
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$tab1dropdown, {
    updateTabItems(session, "sidebarID", selected = "tab1")
  })
  observeEvent(input$tab2dropdown, {
    updateTabItems(session, "sidebarID", selected = "tab2")
  })
  observeEvent(input$tab3dropdown, {
    updateTabItems(session, "sidebarID", selected = "tab3")
  })
  
}

shinyApp(ui, server)