Post updated on Mar 26, 2024
Introducction
When you create a dashboard to track some information is usual put the important numbers big and clear at the beginning of the main section. For this, {shinydashboard} (https://rstudio.github.io/shinydashboard/) and other dashboard oriented packages for shiny like {bs4dash}, {argonDash}, {tablerDash} - all from https://rinterface.com/ - have an implementation to put this type of information know as a card or value box.
In some projects like https://jbkunst.shinyapps.io/trd-sttstcs/ I’ve implemented a modification of the original shinydashboard::valueBox
to complement the information (the BIG number) with a sparkline. Always that implementation lives as a function in R/helpers.R
script, so this will be a good opportunity to share the code, thoughts and ideas.
The basic valueBox
Let’s start with what we know: The most direct and simple implementation of a valueBox
in {shinydashboard}.
Code
library(shiny)
library(shinydashboard)
<- valueBox(
vb value = "1,345",
subtitle = "Lines of code written",
icon = icon("code"),
width = 4,
color = "red",
href = NULL)
<- dashboardPage(
ui dashboardHeader(),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidRow(
valueBoxOutput("vbox")
)
)
)
<- function(input, output) {
server
$vbox <- renderValueBox(vb)
output
}
# shiny::shinyApp(ui, server, options = list(launch.browser = .rs.invokeShinyPaneViewer))
This app looks like:
So here it is, a simple value box to emphasize information which can have an icon/color to give some meaning to the number.
Modifying the valueBox
Before to modify a value box we need to know what a valueBox
is, or how is it built, so take a look what is inside this funcion.
Code
valueBox
function(value, subtitle, icon = NULL, color = "aqua", width = 4, href = NULL){
validateColor(color)
if (!is.null(icon))
tagAssert(icon, type = "i")
<- div(
boxContent class = paste0("small-box bg-", color),
div(
class = "inner",
h3(value),
p(subtitle)
),if (!is.null(icon)) div(class = "icon-large", icon)
)
if (!is.null(href))
<- a(href = href, boxContent)
boxContent
div(
class = if (!is.null(width)) paste0("col-sm-", width),
boxContent
) }
As we see, the value
and subtitle
arguments are the main ones. The other are just for styling and format. These elements are in div(class = "inner", ...)
so here we’ll put the new content.
Let’s try to put a title in the top of the div and then use the subtitle as an detailed text.
Code
<- function(value, title, subtitle, icon = NULL, color = "aqua", width = 4, href = NULL){
valueBox2
:::validateColor(color)
shinydashboard
if (!is.null(icon))
:::tagAssert(icon, type = "i")
shinydashboard
<- div(
boxContent class = paste0("small-box bg-", color),
div(
class = "inner",
$small(title),
tagsh3(value),
p(subtitle)
),if (!is.null(icon)) div(class = "icon-large", icon)
)
if (!is.null(href))
<- a(href = href, boxContent)
boxContent
div(
class = if (!is.null(width)) paste0("col-sm-", width),
boxContent
) }
So the implementation is the same as the original valueBox
function:
Code
<- valueBox2(
vb value = "1,345",
title = toupper("Lines of code"),
subtitle = tagList(HTML("↑"), "25% Since last day"),
icon = icon("code"),
width = 4,
color = "red",
href = NULL
)
The idea of put a title is to help the reader, but we use a small text to be subtle, usually I like to use a Small Caps font but in this case I used uppercase for simplicity.
Adding sparklines
The idea to add a sparkline to the value box is give more information. For example, if your have a historical data, it would be good put a sparkline to show the previous behaviour about the data, so you can compare the BIG number with the past.
Let’s simulate data to create a sparkline:
Code
set.seed(123)
<- 20
N
<- cumsum(rnorm(N)) + 0.5 * cumsum(runif(N))
x <- round(200*x)
x
<- data.frame(
df x = sort(as.Date(Sys.time() - lubridate::days(1:N))),
y = abs(x)
)
df
x y
1 2024-03-06 98
2 2024-03-07 102
3 2024-03-08 251
4 2024-03-09 302
5 2024-03-10 343
6 2024-03-11 700
7 2024-03-12 815
8 2024-03-13 609
9 2024-03-14 498
10 2024-03-15 495
11 2024-03-16 744
12 2024-03-17 860
13 2024-03-18 1020
14 2024-03-19 1055
15 2024-03-20 1000
16 2024-03-21 1378
17 2024-03-22 1490
18 2024-03-23 1172
19 2024-03-24 1402
20 2024-03-25 1345
Let’s create a sparkline with {highcharter} package:
Code
library(highcharter)
<- hchart(df, "line", hcaes(x, y), name = "lines of code") %>%
hc hc_size(height = 100)
hc
We have our first sparkline. It’s important note the hc
object will use the available horizontal (width
) space, but we need to control the heigth
.
Now we can create a new valueBox
function;
Code
<- function(value, title, sparkobj = NULL, subtitle, icon = NULL,
valueBox3 color = "aqua", width = 4, href = NULL){
:::validateColor(color)
shinydashboard
if (!is.null(icon))
:::tagAssert(icon, type = "i")
shinydashboard
<- div(
boxContent class = paste0("small-box bg-", color),
div(
class = "inner",
$small(title),
tagsh3(value),
if (!is.null(sparkobj)) sparkobj,
p(subtitle)
),if (!is.null(icon)) div(class = "icon-large", icon, style = "z-index; 0")
)
if (!is.null(href))
<- a(href = href, boxContent)
boxContent
div(
class = if (!is.null(width)) paste0("col-sm-", width),
boxContent
) }
So now:
Code
<- valueBox3(
vb value = "1,345",
title = toupper("Lines of code"),
sparkobj = hc,
subtitle = tagList(HTML("↑"), "25% Since last day"),
icon = icon("code"),
width = 4,
color = "red",
href = NULL)
And the result is:
LOL! We need modify the look of the chart. For this we’ll create a custom theme. The general idea is gain space via removing axis and borders. Then have cleaner look removing grid lines… You know, show just the line.
Code
<- function(...) {
hc_theme_sparkline_vb
<- list(
theme chart = list(
backgroundColor = NULL,
margins = c(0, 0, 0, 0),
spacingTop = 0,
spacingRight = 0,
spacingBottom = 0,
spacingLeft = 0,
plotBorderWidth = 0,
borderWidth = 0,
style = list(overflow = "visible")
),xAxis = list(
visible = FALSE,
endOnTick = FALSE,
startOnTick = FALSE
),yAxis = list(
visible = FALSE,
endOnTick = FALSE,
startOnTick = FALSE
),tooltip = list(
outside = FALSE,
shadow = FALSE,
borderColor = "transparent",
botderWidth = 0,
backgroundColor = "transparent",
style = list(textOutline = "5px white")
),plotOptions = list(
series = list(
marker = list(enabled = FALSE),
lineWidth = 2,
shadow = FALSE,
fillOpacity = 0.25,
color = "#FFFFFFBF",
fillColor = list(
linearGradient = list(x1 = 0, y1 = 1, x2 = 0, y2 = 0),
stops = list(
list(0.00, "#FFFFFF00"),
list(0.50, "#FFFFFF7F"),
list(1.00, "#FFFFFFFF")
)
)
)
),credits = list(
enabled = FALSE,
text = ""
)
)
<- structure(theme, class = "hc_theme")
theme
if (length(list(...)) > 0) {
<- hc_theme_merge(
theme
theme,hc_theme(...)
)
}
theme }
Testing the theme.
Code
<- hc %>%
hc hc_add_theme(hc_theme_sparkline_vb()) %>%
hc_credits(enabled = FALSE)
%>%
hc # emulate the background color of the valueBox
hc_chart(backgroundColor = "#DD4B39")
And trying again:
Code
<- valueBox3(
vb value = "1,345",
title = toupper("Lines of code"),
sparkobj = hc,
subtitle = tagList(HTML("↑"), "25% Since last day"),
icon = icon("code"),
width = 4,
color = "red",
href = NULL)
Including an information helper
Sometimes I like to add helper information icon to explain how to read the metric/number if is needed.
This can be done using the icon "info-cirle"
and using the class "pull-right"
to put in the corner.
Code
<- function(value, title, sparkobj = NULL, subtitle, info = NULL,
valueBox4 icon = NULL, color = "aqua", width = 4, href = NULL){
:::validateColor(color)
shinydashboard
if (!is.null(icon))
:::tagAssert(icon, type = "i")
shinydashboard
<- tags$small(
info_icon $i(
tagsclass = "fa fa-info-circle fa-lg",
title = info,
`data-toggle` = "tooltip",
style = "color: rgba(255, 255, 255, 0.75);"
),class = "pull-right"
)
<- div(
boxContent class = paste0("small-box bg-", color),
div(
class = "inner",
$small(title),
tagsif (!is.null(sparkobj)) info_icon,
h3(value),
if (!is.null(sparkobj)) sparkobj,
p(subtitle)
),if (!is.null(icon)) div(class = "icon-large", icon, style = "z-index; 0")
)
if (!is.null(href))
<- a(href = href, boxContent)
boxContent
div(
class = if (!is.null(width)) paste0("col-sm-", width),
boxContent
) }
So now:
Code
<- valueBox4(
vb value = "1,345",
title = toupper("Lines of code"),
sparkobj = hc,
subtitle = tagList(HTML("↑"), "25% Since last day"),
info = "This is the lines of code I've written in the past 20 days! That's a lot, right?",
icon = icon("code"),
width = 4,
color = "red",
href = NULL
)
Voilà we have a value box with a information helper.
Demo
Demo section! We can use other types of charts, texts and colors:
Before the demo, let’s give a proper name to our function:
Code
<- function(value, title, sparkobj = NULL, subtitle, info = NULL,
valueBoxSpark icon = NULL, color = "aqua", width = 4, href = NULL){
:::validateColor(color)
shinydashboard
if (!is.null(icon))
:::tagAssert(icon, type = "i")
shinydashboard
<- tags$small(
info_icon $i(
tagsclass = "fa fa-info-circle fa-lg",
title = info,
`data-toggle` = "tooltip",
style = "color: rgba(255, 255, 255, 0.75);"
),# bs3 pull-right
# bs4 float-right
class = "pull-right float-right"
)
<- div(
boxContent class = paste0("small-box bg-", color),
div(
class = "inner",
$small(title),
tagsif (!is.null(sparkobj)) info_icon,
h3(value),
if (!is.null(sparkobj)) sparkobj,
p(subtitle)
),# bs3 icon-large
# bs4 icon
if (!is.null(icon)) div(class = "icon-large icon", icon, style = "z-index; 0")
)
if (!is.null(href))
<- a(href = href, boxContent)
boxContent
div(
class = if (!is.null(width)) paste0("col-sm-", width),
boxContent
) }
Some charts:
Code
<- hchart(df, "area", hcaes(x, y), name = "lines of code") %>%
hc hc_size(height = 100) %>%
hc_credits(enabled = FALSE) %>%
hc_add_theme(hc_theme_sparkline_vb())
<- hchart(df, "line", hcaes(x, y), name = "Distance") %>%
hc2 hc_size(height = 100) %>%
hc_credits(enabled = FALSE) %>%
hc_add_theme(hc_theme_sparkline_vb())
<- hchart(df, "column", hcaes(x, y), name = "Daily amount") %>%
hc3 hc_size(height = 100) %>%
hc_credits(enabled = FALSE) %>%
hc_add_theme(hc_theme_sparkline_vb())
Some value boxes:
Code
<- valueBoxSpark(
vb value = "1,345",
title = toupper("Lines of code written"),
sparkobj = hc,
subtitle = tagList(HTML("↑"), "25% Since last day"),
info = "This is the lines of code I've written in the past 20 days! That's a lot, right?",
icon = icon("code"),
width = 4,
color = "teal",
href = NULL
)
<- valueBoxSpark(
vb2 value = "1,345 KM",
title = toupper("Distance Traveled"),
sparkobj = hc2,
subtitle = tagList(HTML("↑"), "25% Since last month"),
info = "This is the lines of code I've written in the past 20 days! That's a lot, right?",
icon = icon("plane"),
width = 4,
color = "red",
href = NULL
)
<- valueBoxSpark(
vb3 value = "1,3 Hrs.",
title = toupper("Thinking time"),
sparkobj = hc3,
subtitle = tagList(HTML("↑"), "5% Since last year"),
info = "This is the lines of code I've written in the past 20 days! That's a lot, right?",
icon = icon("hourglass-half"),
width = 4,
color = "yellow",
href = NULL
)
Finally the app:
Code
library(shiny)
library(shinydashboard)
<- dashboardPage(
ui dashboardHeader(),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidRow(
valueBoxOutput("vbox"),
valueBoxOutput("vbox2"),
valueBoxOutput("vbox3")
)
)
)
<- function(input, output) {
server $vbox <- renderValueBox(vb)
output$vbox2 <- renderValueBox(vb2)
output$vbox3 <- renderValueBox(vb3)
output
}
# shiny::shinyApp(ui, server, options = list(launch.browser = .rs.invokeShinyPaneViewer))
This app look like this :)! What do you think?
Extending the idea
Due the {bs4dash} package is based in the same template of the {shinydashboard} https://github.com/ColorlibHQ/AdminLTE is direct use the functions. There some details in the info icon, but you can remove it if you use icon = NULL
.
Code
library(bs4Dash)
<- bs4DashPage(
ui header = dashboardHeader(),
sidebar = bs4DashSidebar(disable = TRUE),
body = bs4DashBody(
# this is for use tooltips in the bs4dash package
$script(HTML("setInterval(function(){ $('[title]').tooltip(); }, 1000)")),
tags$h2("Testing with {bs4dash} package"),
tags$hr(),
tagsfluidRow(
valueBoxOutput("vbox"),
valueBoxOutput("vbox2"),
valueBoxOutput("vbox3")
)
)
)
# setTimeout(function(){ $('[title]').tooltip(); }, 3000)
# setInterval(function(){ $('[title]').tooltip(); }, 3000)
# JS("$(function () { $('[title]').tooltip() })")
This walkthrough/tutorial will help to implement sparklines in other packages as well as other elements such as infoBox
, or maybe with other htmlwidgets like {echarts4r} or {plotly}. So if you make an implementation please tell us and share with other people.
Reuse
Citation
@online{kunst_fuentes2020,
author = {Kunst Fuentes, Joshua},
title = {valueBoxes and {Sparklines}},
date = {2020-06-29},
url = {https://jkunst.com/blog/posts/2020-06-26-valuebox-and-sparklines/},
langid = {en}
}