Building a Shiny Dashboard
The Discovery team has adopted RStudio's shiny framework for developing dashboards to visualize data. An example of this is the Metrics & KPIs dashboard originally developed by Oliver Keyes and currently maintained by Mikhail Popov.
R is one of the most popular languages and environments for working with data, and Shiny enables users to build fairly complex web applications using only the R language without knowing any CSS, HTML, or Javascript.
The dashboard is written in R and utilizes shiny, shinydashboard, and various htmlwidgets packages (e.g. dygraphs for plotting time series). Additional functionality can be added with jQuery.
Installation and setup
Erik is working on documentation for getting Shiny Server up and running on Cloud VPS machines via Vagrant. See Phabricator ticket T103000 for more information on the progress.
Basics
A dashboard built with R/Shiny requires its specification to be contained in two R scripts: ui.R and server.R. ui.R is where you will specify what the dashboard looks like and provide placeholders for content (e.g. plots, tables, dynamic UI). In server.R, you can refer to user's inputs to generate dynamic content.
Inputs and Outputs
Shiny has a variety of inputs that enable a lot of complex interactions. To name a few, there are checkboxGroupInput & checkboxInput, dateInput for selecting dates using a calendar widget, numericInput, radioButtons, and sliderInput for letting the user pick a value in a range.
It also has outputs for showing plots and tables generated on the server side, often (but not necessarily) using user-provided inputs. For example, one might overlay a density on top of a histogram in renderPlot while controlling how smooth or bumpy to make the density fit from user-controlled sliderInput. The packages shinydashboard and dygraphs also provide outputs.
| In ui.R | In server.R | Comment |
|---|---|---|
| htmlOutput
uiOutput |
renderUI | Great for building dynamic UI – e.g. a drop-down menu that gets its contents from the column names of a user-selected dataset |
| imageOutput | renderImage | |
| plotOutput | renderPlot | |
| tableOutput | renderTable | |
| dataTableOutput | renderDataTable | Uses the DataTables jQuery plug-in to display the data, which enables: searching, sorting, and pagination. See this article for more information. |
| textOutput | renderText | |
| verbatimTextOutput | renderText | for code |
| infoBoxOutput | renderInfoBox | |
| valueBoxOutput | renderValueBox | valueBoxes are similar to infoBoxes, but have a somewhat different appearance
|
| dygraphOutput | renderDygraph | time series plotting |
Template
Your dashboard will live in one directory consisting of dir containing markdown files (and any other assets), some R files, and a dir containing additional css/js files your specific dashboard will use:
- [dashboard name]
- assets
- (markdown files)
- ui.R
- server.R
- www
- custom.css
- custom.js
- assets
The next several sections provide you with starting points for what ui.R, server.R, custom.css, and custom.js should look like. For an explanation of the individual components such as modules and widgets, please refer to the Components section below.
ui.R
library(shiny)
library(shinydashboard)
# library(dygraphs) # optional, used for dygraphs
# Header elements for the visualization
header <- dashboardHeader(title = "Dashboard Name", disable = FALSE)
# Sidebar elements for the search visualizations
sidebar <- dashboardSidebar(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"),
tags$script(src = "custom.js")
),
sidebarMenu(
menuItem(text = "KPIs",
menuSubItem(text = "Summary", tabName = "kpis_summary"),
menuSubItem(text = "KPI 1", tabName = "kpi_1")
) # /menuItem
# this is where other menuItems & menuSubItems would go
) # /sidebarMenu
) # /dashboardSidebar
#Body elements for the search visualizations.
body <- dashboardBody(
tabItems(
tabItem(tabName = "kpis_summary",
fluidRow(valueBoxOutput("kpi_summary_box_1", width = 4),
valueBoxOutput("kpi_summary_box_2", width = 4),
valueBoxOutput("kpi_summary_box_3", width = 4)),
p('Include documentation via includeMarkdown("./assets/kpis_summary.md") ')
),
tabItem(tabName = "kpi_1",
# e.g. plotOutput(), textOutput(), dygraphOutput(), etc.
p('includeMarkdown("./assets/kpi_1.md") is kinda like a README for this module'))
) # /tabItems
) # /dashboardBody
dashboardPage(header, sidebar, body, skin = "black")
server.R
source("utils.R")
shinyServer(function(input, output) {
output$kpi_summary_box_1 <- renderValueBox({
valueBox(
value = sprintf("%s", compress(245923)),
subtitle = sprintf("KPI 1 (%.1f%%)", 8.9202),
icon = icon("arrow-up"),
color = "green"
)
})
output$kpi_summary_box_2 <- renderValueBox({
valueBox(
value = sprintf("%s", compress(190)),
subtitle = sprintf("KPI 2 (%.1f%%)", -0.23),
icon = icon("arrow-down"),
color = "red"
)
})
output$kpi_summary_box_3 <- renderValueBox({
valueBox(
value = sprintf("%s", compress(104924422)),
subtitle = sprintf("KPI 3 (%.1f%%)", -5.422),
icon = icon("arrow-down"),
color = "green"
)
})
})
utils.R
# This is where you import any libraries that will be used in computations or plot generation:
# e.g. library(xts), library(ggplot2); library(tm); library(dplyr); library(tidyr); library(stargazer)
# This is where you add dashboard-specific functions to use in ui.R and server.R
# e.g.
start_date <- function(date_range) {
return(Sys.Date() - (switch(date_range, daily = 2, weekly = 14, monthly = 60, quarterly = 90) + 1))
}
www/custom.css
/* custom CSS code goes here */
www/custom.js
$(function() {
// Enables linking to specific tabs:
if (window.location.hash){
var hash = $.trim(window.location.hash);
var tab = decodeURI(hash.substring(1, 100));
$('a[data-value=\"'+tab+'\"]').click();
}
// Usage: append the tabName to the URL after the hash.
// Reveals the KPI dropdown menu at launch:
$('ul.sidebar-menu li.treeview').first().addClass('active');
// Update the URL in the browser when a tab is clicked on:
$('a[href^=#shiny-tab]').click(function(){
window.location.hash = encodeURI($(this).attr('data-value'));
})
});
For example, we have a tab named "failure_rate", so we can directly link to it with: http://searchdata.wmflabs.org/metrics/#failure_rate
Components
Modules
You can add a module to the dashboard as a tabItem inside tabItems inside dashboardBody in ui.R:
tabItem(tabName = "<url_friendly_name_of_your_module>",
# fluidRow(), box(), and other layout-related functions
# infoBox(), valueBox(), plotOutput(), textOutput(), dygraphOutput(), etc.
includeMarkdown("./assets/<your_module's_README>.md"))
We strongly recommend having some documentation for every module (either as a Markdown or HTML file). Think of every module as its own thing that deserves its own README.
Once you've added the tab, add a way to navigate to it by adding a corresponding menuItem (or menuSubItem if you have a group of related modules) inside sidebarMenu inside dashboardSidebar in ui.R:
menuItem(text = "<Name of your module>", tabName = "<url_friendly_name_of_your_module>")
Note: you can add badges to menuItems (but not menuSubItems or when a menuItem has menuSubItems) to highlight new modules or experimental modules, although you shouldn't be deploying experimental modules to production until they're ready.
Widgets
Most likely you're going to use the dashboard for surfacing metrics or statuses (e.g. "Server is okay"). Your widgets will include summaries (e.g. latest value or last week's average) via infoBox or valueBox and time series of those metrics via dygraph. A widget can be as simple as that or as complex as a box (see Boxes) that has a plot of the forecast and an accessible explanation of the ARIMA model with parameter estimates inside the text.
Clickable Widgets
This is just example Javascript for making the KPI widgets clickable so that you can use them as shortcuts for tabs specific to them. Note that this works by finding widgets with IDs matching kpi_summary_box_*. Adjust this code as required by your application. The code goes in www/custom.js.
$(function() {
// Other code (e.g. the code above that enables linking to specific tabs)
// Enables clicking on a kpi summary value box to view the time series:
$('div[id^=kpi_summary_box_]').click(function(){
var parent_id = $(this).closest('div').attr('id');
var parent_target = parent_id.replace('_summary_box', '');
$('a[data-value=\"'+parent_target+'\"]').click();
});
// Visual feedback that the value box is now something you can click:
$('div[id^=kpi_summary_box_]').hover(function() {
$(this).css('cursor','pointer');
});
});
Example Utility Functions
These go inside utils.R
Downloading aggregated datasets
Note: The Discovery Analytics team no longer includes this in every utils.R file in their dashboards, and instead have a R package polloi for common functions between the dashboards. The below function exists as polloi::read_dataset().
library(readr)
#Utility functions for handling particularly common tasks
download_set <- function(location){
location <- paste0("http://analytics.wikimedia.org/datasets/<e.g. search|discovery>/", location,
"?ts=", gsub(x = Sys.time(), pattern = "(-| )", replacement = ""))
con <- url(location)
return(readr::read_delim(con, delim = "\t"))
}
Example usage:
download_set("desktop_event_counts.tsv")
Dynamic colors and arrows for widgets
If you want an infoBox or a valueBox's appearance to reflect its contents (show an up arrow in case of an increase or be green in case it's good), you'll want to include these:
# Conditional icon for widget.
# Returns arrow-up icon on true (if true_direction is 'up'), e.g. load time % change > 0
cond_icon <- function(condition, true_direction = "up") {
if (true_direction == "up") {
return(icon(ifelse(condition, "arrow-up", "arrow-down")))
}
return(icon(ifelse(condition, "arrow-down", "arrow-up")))
}
# Conditional color for widget
# Returns 'green' on true, 'red' on false, e.g. api usage % change > 0
# load time % change < 0
cond_color <- function(condition, true_color = "green") {
if(is.na(condition)){
return("black")
}
colours <- c("green","red")
return(ifelse(condition, true_color, colours[!colours == true_color]))
}
Example usage:
Here we grab the two most recent time points of usage for several APIs we have. Then we store the total API usage for t-1 (yesterday) in y2 and t-2 (day before yesterday) in y1. Then we calculate the % change from y1 to y2 and store that in z. Then we use cond_color() and cond_icon() with z to show the user an up arrow and green color if the % change z was positive; down arrow and red color if negative.
output$kpi_summary_box_api_usage <- renderValueBox({
x <- lapply(split_dataset, function(x) {
tail(x$events, 2)
})
y1 <- sum(unlist(x)[seq(1, 9, 2)])
y2 <- sum(unlist(x)[seq(2, 10, 2)])
z <- 100*(y2-y1)/y1
valueBox(
subtitle = sprintf("API usage (%.1f%%)", z),
value = compress(y2, 0),
color = cond_color(z > 0),
icon = cond_icon(z > 0)
)
})