custom valueboxes in R Shiny are compressed with large white spaces in between them

863 Views Asked by At

I'm trying to make custom valueboxes in R Shiny. I've discovered how to change the color of the background, but something is making my value boxes stubby and leaving large gaps in between them. I'd like to display 3 on a line ideally, but even with a width of 4, they appear squished. How can I get them to have more of the red with just a small gap of white in between.

Below is a reproducible example as well as a screenshot.enter image description here

library(shinydashboard)
library(shiny)
library(dplyr)

red_box_format <- ".inner , p , h3 { background-color: red};"


ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit")
            
        ),
        mainPanel(
            tags$style(red_box_format),
            column(4,align="center",div(valueBoxOutput("total_perfect"), style= "color: #FFFFFF")),
            column(4,align="center",div(valueBoxOutput("total_fails"), style= "color: #FFFFFF"))
        )
    ))
server <- function(input, output) {
    
    data <- tibble(name = c("Justin", "Corey", "Sibley"),
                   grade = c(50, 100, 100))
    
    
    output$total_perfect <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_100s <- data %>% filter(grade == 100) %>% nrow()
            valueBox(value = num_100s, subtitle = "Number of Perfect Scores")
        }
    })
    
    output$total_fails <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_50s <- data %>% filter(grade == 50) %>% nrow()
            valueBox(value = num_50s, subtitle = "Number of Failures")
        }
    })
    
}
shinyApp(ui, server)
2

There are 2 best solutions below

3
On BEST ANSWER

Insert the outputs in a fluidRow; they will be placed better in the bootstrapp grid:

mainPanel(
      fluidRow(
      tags$style(red_box_format),
      valueBoxOutput("total_perfect"),
      valueBoxOutput("total_fails")
    ))

Then, you have to render them like this in the server:

valueBox(value = tags$p(num_100s, style = "text-align:center;color: #FFFFFF;"),
               subtitle = tags$p("Number of Perfect Scores", style = "text-align:center;color: #FFFFFF;"))
0
On

In case this is of use, I extended the above answer to allow for color coding of each individual boxes, including how to incorporate multiple colors into an value box if you'd like. (Screenshot, code, and explanation/tips below [especially if you're new to CSS, like me]).

Screenshot

enter image description here

Code

library(shinydashboard)
library(shiny)
library(dplyr)

navy_inner_box <- "#total_fails .inner{ background-color: navy};"
yellow_inner_box <- "#total_perfect .inner , p , h3 { background-color: yellow};"


ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit")
            
        ),
        mainPanel(
            fluidRow(
                tags$style(yellow_inner_box),
                tags$style(navy_inner_box),
                valueBoxOutput("total_perfect"),
                valueBoxOutput("total_fails")
            ))
    ))
server <- function(input, output) {
    
    data <- tibble(name = c("Justin", "Corey", "Sibley"),
                   grade = c(50, 100, 100))
    
    
    output$total_perfect <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_100s <- data %>% filter(grade == 100) %>% nrow()
            valueBox(value = tags$p(num_100s, style = "text-align:center;color: #FFFFFF; background-color: red"),
                     subtitle = tags$p("Number of Perfect Scores", style = "text-align:center;color: #FFFFFF; background-color: red"))        }
    })
    
    output$total_fails <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_50s <- data %>% filter(grade == 50) %>% nrow()
            valueBox(value = tags$p(num_50s, style = "text-align:center;color: #FFFFFF; background-color: navy"),
                     subtitle = tags$p("Number of Total Failures", style = "text-align:center;color: #FFFFFF; background-color: navy"))}
    })
    
}
shinyApp(ui, server)

Explanation/Tips

As someone who is new to CSS, I couldn't understand why the boxes would either not change colors or just change part of it when I would specify a background-color argument. The value boxes are divided into 3 parts: the value (the 2 and 1 in my screenshots), the subtitles, and the inner portion (where there is no text). Each of these have their own background, so if you want each box to be different colors, you need to specify the colors for each box by their names (note how CSS name of #total_fails in the navy_inner_box) corresponds with the output name, output$total_fails.

The other background colors are specified within calls that wrap the value and subtitles respectively in the server.

I wouldn't have discovered these boxes' inner names had it not been through the free Google Chrome extension, CSS Selector. If you're new to CSS and the tags don't make intuitive sense to you, I'd highly recommend checking it out.