Shiny Developer Challenge (the perfect dashboard design)

Hi all,

I'm calling on all experienced shiny developers for a question that has been asked previously, but none of the attempts have really satisfied the original ask / thought process.

With that being said, I'd love to have open commentary / determine the best solution, even if thats co-collab'ing on a new package / shiny template.


Below I've included:

  • links to previous attempts/responses
  • Pictures of the issue / ask
  • A minimal reprex of the use case
  • Things I've tried

Here are the requirements:

  • Navbar navigation (multiple top level tabs)
  • Full height sidebar (related to top level tab)
  • Full width body


Things I've tried

  • shinydashboard without navpanels
    • issue: forces the application to all be in the same place, even if related ideas are better placed in their own distinct tabs with their own set of inputs
  • a fixed position sidebar / body with css
    • issue: using the navpanel with multiple panels, eliminates the effective use of absolute positioning on a small screen

In closing:

Combined, shiny, and shinydashboard would satisfy the requirements, e.g. shiny navpanel with shinydashboard sidebar / body. But haven't seen / found any way to accomplish this.

I love the way fluidRows respond to other elements (e.g. navpanel that spans multiple rows) but it eliminates the use of a full height sidebar / full width body, and I love the look of shinydashboard layout, but can't use top level navigation.

Knowing that shiny uses bootstrap layout design, I would've thought that something like this bootstrap dashboard layout would be possible, but haven't seen any attempts.

Has anyone found a good solution to this?
Would anyone like to work on a new solution with me?


Minimal Reprex:

library(shiny)
library(tidyverse)
library(stringi)

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

rand_title <- function(n) {
  my_title <- stringi::stri_rand_lipsum(1)
  str_sub(my_title, 1, n)
}
set.seed(123)

ui <- fluidPage(
  navbarPage(
    collapsible = TRUE,
    title = HTML(html_title),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1)))
  )
)

server <- function(input, output) {


}

shinyApp(ui, server)

For reference:

1 Like

If you wait a bit, I’ll come up with a plug and play solution. See https://github.com/RinteRface/bs4Dash/issues/108

If you really want to use the shinydashboard design (Bootstrap 3), I might also do it in shinydashboardPlus.

Hi @DGranjon,

Thanks for your reply. Love that you've taken on the task of creating an entirely new package.

Ideally i'd like to stay within the current shiny / shinydashboard packages due to:

  1. work reasons (Rstudio packages are much easier to get approved)
  2. already have a lot of frameworks / existing applications built using those, so switching to a completely new function list / new architecture would be a task in and of itself.

However, I appreciate your comment, and will certainly follow your package for implementation of this, especially for my personal development projects where I have a bit more free-reign to choose what I develop in.

Ideally i'd like to stay within the current shiny / shinydashboard packages due to

I understand your point.

In that case, you may create a custom dashboardHeader function taking the header navigation from this example but keeping the sidebar from the classic template (see my screenshot).

Since you need a specific sidebar for each header tab, you may use renderMenu and menuOutput, assuming you can recover the id of the current Navbar tab. For that, an input binding is the most appropriate but a bit more complex to create.

Finally, have a look at this resource, especially Chapter 15.3. There is a case study to create an interactive Navbar menu.

Hope my answer is not too far from your target :wink:

1 Like

I'll go ahead and mark this a solution, as I think you provided enough to find a solution.

However, I hope the discussion continues. I think for anyone the idea of the perfect dashboard design is exciting for any shiny developer.

I did also come up with a solution of my own today:

The amended code below

  • hides sidebar on small screens (users on mobile / small screen don't need to access all of the inputs)
  • sidebar doesn't overlap when tabpanels span multiple rows
  • navpanel tabs convert to 100% width when collapsed

full screen:

smaller screen:

mobile sized screens:

I'd like to modify the sidebar so that it's somehow stuck to the side in desktop sized screens, similar to shinydashboard, but for now it suffices.

Original Example modified:

library(shiny)
library(tidyverse)
library(stringi)

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


custom_css <-
  "
.container-fluid {
    padding-left: 0px;
}

.new-sidebar{
  height:1513px;
  width:19%;
  background:grey;
  display:inline-block;
  padding-left: 20px;
  padding-top: 20px;
  margin-right: 20px;
}

.new-main{
  height:1513px;
  width:80%;
  display:inline-block;
  padding-top: 20px;
}

.new-row{
  margin-right: -15px;
  margin-left: 0;
  display: flex;
  margin-top: -20px;
  
}


@media screen and (max-width: 1024px) {
    .new-sidebar {
        display: none !important;
    }
    
    .new-main {
        width: 100%;
    }
}


@media screen and (max-width: 768px){
.navbar-nav {
    float: right;
    width: 100%;
}
  
}

"

new_row <- function(...) {
  div(class = "new-row", ...)
}

new_sidebar <- function(...) {
  div(class = "new-sidebar", ...)
}

new_main <- function(...) {
  div(class = "new-main", ...)
}




rand_title <- function(n) {
  my_title <- stringi::stri_rand_lipsum(1)
  str_sub(my_title, 1, n)
}
set.seed(123)

ui <- fluidPage(
  tags$head(tags$style(HTML(custom_css))),
  navbarPage(
    collapsible = TRUE,
    title = HTML(html_title),
    tabPanel(
      rand_title(sample(1:40, 1)),

      new_row(
        new_sidebar(
          selectInput("select", "select", letters)
        ),
        new_main(
          tags$img(src = "https://jeroen.github.io/images/Rlogo.png", width = "100%")
        )
      )
    ),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1))),
    tabPanel(rand_title(sample(1:40, 1)))
  )
)

server <- function(input, output) {


}

shinyApp(ui, server)

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.