CODEWITHSUNDEEP
rshinyflexdashboard
bretauv
bretauv

Reputation: 8526

Reproduce a flexdashboard layout with shinydashboard

I am trying to reproduce a flexdashboard simple layout with a persistent sidebar and several tabs. This question is similar to this one I asked recently but in the latter I used some code found in another SO answer, whereas in this question I use straightforward flexdashboard code.

Here's a simple flexdashboard layout:

---
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
=====================================

You can see that it mixes a persistent sidebar with a navbar.

However, I don't know how to reproduce this in 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)

The tabs in this example are not a navbar, like in the flexdashboard example.

Is there a simple way (i.e not using dozens of lines of CSS) to produce the flexdashboard example using shinydashboard (or other solution)?

Upvotes: 3

Views: 740

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33397

I'm not sure if this is an option for you, but you could use shinydashboard's dropdownMenu and a hidden dashboardSidebar to mimic the appearance of a flexdashboard. However, the menu by default is aligned to the right (Edit: now aligned to the left via htmltools::tagQuery):

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

modifiedDashboardHeader <- tagQuery(dashboardHeader(
  tags$li(class = "dropdown",
          tags$li(class = "dropdown", actionLink(inputId = "tab1dropdown", label = "Tab 1")),
          tags$li(class = "dropdown", actionLink(inputId = "tab2dropdown", label = "Tab 2")),
          tags$li(class = "dropdown", actionLink(inputId = "tab3dropdown", label = "Tab 3"))
  )
))$find(".navbar-custom-menu")$removeAttrs("style")$addAttrs("style" = "float: left; margin-left: 0px;")$allTags()

ui <- dashboardPage(
  modifiedDashboardHeader,
  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)

result

PS: also please check shinydashboardPlus::dashboardHeader(leftUi = tagList(...)) as an alternative.

Upvotes: 4

Related Questions