Placing one box per row in shinydashboard

1. Background

I want to create a dynamic UI of boxes and graphs placed inside those boxes in shinydashboard. I found this blogpost that perfectly suits my needs: Create a dynamic number of UI elements in Shiny with purrr

2. Problem

There is just one design element that I'd like to change. Currently, the dashboard contains two boxes per fluidRow because each box has width=6. I could change the width to 12 to solve my problem, but I wanted to see if I could create one box of width=6 per row. I've tried to include a br() but that doesn't do much.

3. Code

Here's my code

# Load packages---------
library(tidyverse)
library(shinydashboard)
library(shiny)
library(shinyWidgets)
library(shinymanager)
library(kableExtra)
library(readxl)


# Create function that plots graphs
plot_mtcars <- function(df) {
  
  df %>% 
    ggplot(aes(wt, mpg)) +
    geom_point() +
    labs(x = "Weight",
         y = "Miles per gallon")
  
  
}




# Start of shinydashboard---------
header <- dashboardHeader(
  title = "Minimal App",
  titleWidth = 240
)

sidebar <- dashboardSidebar(

  # Width of the sidebar (in pixels)
  width = 240,
  sidebarMenu(
    
    h1("Welcome!"),
    menuItem(text = "WEEKLY RESULTS", tabName = "weekly_results")
  )
  

)

body <- dashboardBody(
  
  
  tabItems(
    tabItem(tabName = "weekly_results", 
            
            
            fluidRow(
              
              uiOutput(outputId = "graphs_ui")            
            )
            
    )
  )
)


ui <- dashboardPage(skin = "black", header = header,
                    sidebar = sidebar,
                    body = body)




server <- function(input, output, session) {
  
  
  mtcars_reactive <- reactive({
    
    mtcars %>% 
      head(8) %>% 
      mutate(car_names = rownames(head(mtcars, 8)))
    
  })
    
  
  
  # Create reactive graphs
  graphs <- reactive({
    
    mtcars_reactive() %>% 
      group_by(car_names) %>% 
      nest() %>% 
      mutate(
        graphs = map(data, plot_mtcars)) %>% 
      pull(graphs)
    
  })
  
  
  output$graphs_ui <- renderUI({
   
    
    iwalk(graphs(), ~{
      output_name <- paste0("plot_", .y)
      output[[output_name]] <- renderPlot(.x)
    })
    
    
    plots_list <- imap(graphs(), ~{
      
      tagList(
        
        
        tags$div(class = "another-box", id = paste0("danger", .y, "_id"),
                 box(width = 6,
                     title = "Mtcars Data", 
                     status = "danger", solidHeader = TRUE,
                     plotOutput(outputId = paste0("plot_", .y)), 
                     ""
                 ),
                 tags$style(HTML(
                   paste0( 
                     "
                        #danger", .y, "_id .box.box-solid.box-danger>.box-header {
                        color:#fff;
                        background:", "#FF0000","
                        }

                        #danger", .y, "_id .box.box-solid.box-danger {
                        border-bottom-color:", "#FF0000", ";
                        border-left-color:", "#FF0000", ";
                        border-right-color:", "#FF0000",";
                        border-top-color:", "#FF0000", ";
                        }

                        "
                   )
                 )) 
        ),
        
        br()
        
        
      )
      
    })
    
    tagList(plots_list)
    
    
    
  })
  
  
  
  
}


shinyApp(ui, server)

Combine column and fluid row

body <- dashboardBody(

	tabItems(

		tabItem(tabName = "weekly_results",

						column(width=6,
							fluidRow(
								uiOutput(outputId = "graphs_ui")
							)
						)

		)
	)
)

replace your width from 6 to 100%

...
box(title = "Mtcars Data", width = "100%",
...

1 Like

Thank you so much!!! This was a much simpler solution than I'd imagined :slight_smile:

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

If you have a query related to it or one of the replies, start a new topic and refer back with a link.

documentation is there Shiny Dashboard Structure (rstudio.github.io)

1 Like