How To Create Reports In R Markdown IV: Shiny App Calendar Heatmap

17 min readApr 26, 2019

All posts are available to view here

In our R Markdown series to date, we have covered initial report design looking at tables of data along with data visualisation. We followed that up by adding shiny reactive elements to our report along with CSS to design the aesthetics. Now we are going to combine many of those elements and look at how we can create a calendar heatmap for load metrics. As we are going to use click events here, we will also take our first steps into shiny application development.

The click event here will allow for a table to be produced based on dates selected from the calendar. Along with the table, we will also have the option to export the selected data to a CSV file. Finally we will take a look at a number of quick ways to make using our app-based calendar a smoother process.

A version of the end result can be viewed here and the data is available on Github

Calendar Heatmap Design

We briefly looked at 3 different ways of producing a calendar heatmap previously, now we will take a closer look at one of those methods. This method is based on a post from John Mackintosh’s blog. The method is split into 2 sections: Data Manipulation & Plotting. For the data manipulation we will create a range of date-based metrics which will then be used to format our calendar. The plotting is straightforward with only a few tweaks needed to format the final output.

Data Manipulation

As mentioned, the majority of our data manipulation will be creating a number of date-based metrics which will help format our plot. We will also include an “if else” style function to create the tooltip within the calendar.

The data manipulation itself is split into two parts. First, we format our original dataset to be a long dataset rather than wide. This will help us create the user input options later. We will then create a number of metrics based off the date variable along with the tooltip data. Luckily, Lubridate is a package designed to work with dates and will help with the majority of the steps here. As it fits in with the tidyverse group of packages, we can perform in it a dplyr piping chain also.

Initial Data Manipulation

select(Date, Name, dist_total, msr_total, hsr_total, percentVmax)
Select variables needed for calendar
gather(metric, value, -Name, -Date)
Change from long to wide, with one variable stating metric type and another for metric data.
mutate(metric = factor(metric, levels = c('dist_total', 'msr_total', 'hsr_total','percentVmax'),labels = c('Total Distance', 'Moderate Speed Distance', 'High Speed Distance', 'Percentage of Max Velocity')))
Change metric type variable to be a factor with labels
This makes the final output appear in a clean manner

Tooltip “if else” function

“if else” style functions haven’t been covered a huge amount on the blog to date and rather than delve into them deeply, you can read more about them here. We are going to cheat slightly with our if else function by using dplyr::if_else() rather the base version. This function works very similarly to an if statement in Excel. For this function, we only need a single a if_else()rather than the nested type which we will cover later.

This function is needed as the data has to be cleaned for our tooltip. If left alone it will appear with upto eight decimal places. However, as we have both distance based values, in meters, and a percentage value, the same function cannot be applied to them. As such, within our ifelse function, we are going to round the percentage to two decimal places and for all other values round to zero decimal places.

tooltips_func <- function(metric){
Name and begin our function with metric as the only input
if_else(metric == 'Percentage of Max Velocity'
Open our ifelse, with the ‘if’ statement assessing if our metric variable is equal to Percentage of Max Velocity
paste0(df2$Date, "\n", 'Percent Max Velocity ', round(df2$value*100, 2), "%"),
When our ‘if’ statement is positive, our tooltip will be the date plus our percentage rounded to two decimal places, multiple by a hundred and a percentage sign added
This step can be carried out by scales::percent() however it failed to work in this case
paste0(df2$Date, "\n", 'Distance ', round(df2$value , 0), 'm'))}
When our if statement is negative, our tooltip will be the date plus our distance rounded to zero decimal places along with a meters sign
Close our function

Date Manipulation

Having set our data up in the format we need for the calendar, we will now create a number of variables needed to output our plot in the calendar format.

mutate(Date = anytime::anydate(Date)
Safety check to ensure our date variable is formatted correctly.
dow = wday(Date,label=TRUE, week_start = 1), dow = factor(dow, levels = rev(levels(dow))),
Create variable which states the day of the week
Reverse the order of the variable so it will appear correctly in the plot
This will be our Y-axis variable
week = week(Date),
weeks = format(Date, "%W"), weeks = factor(weeks, levels = unique(weeks)),
Create two week variables, one of which will be turned into a factor variable
This step prevents weeks that cross two months affecting the plot negatively
weekStart = Date - as.POSIXlt(Date)$wday,
Creates variable which states the date each weeks starts
This will be our X-axis
month = month(Date, label = TRUE, abbr = FALSE), month = factor(month, levels = c('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December')),
Variables which states the month for each date
Change to factor and set month order
If you were only going to be looking at data for a single season, you could set this up so the months aligned with the season rather than calendar. You would also need to set your faceting variable differently.
year = year(Date), year = factor(year),
Add a year column and change to factor
yearmonth = paste(month, year),
Create a variable which is a combination of the month and year
This will be our faceting variable
tooltips = tooltips_func(metric)
Use the function created previously to the data for our tooltip
arrange(year, month)
Sort our data by years first and then month
This step arranges the facets in the correct order
mutate(yearmonth = factor(yearmonth, levels = unique(yearmonth)))
Finally change the yearmonth variable to factor
As we previously sorted our data correctly, the levels of this factor will occur in chronological order
We have now set it up to be our faceting variable with the facets appearing in the correct order.

ggplot

Now that we have created our dataset with all the required variables, we can start to build our plot with ggplot. For this plot, we will use ggiraph to provide the interactive elements.

Required “if else” functions

In our final report, we will give the user the ability to select different metrics to view. As a result, for our calendar to remain correct we need to have a number of functions which will adapt based one the different inputs.

Colour Coded Days

As mentioned previously, we have two different “types” of data present in our calendar. Our distance based metrics, total/moderate-speed/high-speed distance, and our velocity metric, percentage of max velocity attained. Both of these will require different different colour scales for our colour code.

The distance based metrics will have a scale where both very low and very high values are cause for concern. Here we will have low as a blue colour, changing to green for average and then red for high. Whereas the velocity will go from low as a concern to high as good, regular exposure to at or near max velocity being important for retention of speed along with injury prevention. In this case, red will be low values and green will be high values.

While we could set the colour scheme through ggplot, we need it to be able to react to different athletes who may have different upper and lower thresholds. Similarly, for our plot to work we need our fill to a factor variable. The main function we will use to create our colour scale will be colourRampPalette(). This function lets you set the colours you want included in your scale. You can then indicate how many different colours you need based on either a numeric value or, as in our case, the number of levels within a factor. We will create a colour scale for our two metrics types, then use dplyr::if_else()to set which will be used.

tooltips_colour_func2 <- function(df, …){
Names and begins our function
td_scale <- colorRampPalette(c('#08B3E5', '#2AF598', '#00FF3E', 'orange', 'red')) (nlevels(factor(df$value)))
Sets our distance colour scale
Hex codes were used here transitioning from blue for low, green for average to red for high
The number of transition colours is going to be set by the number of values present for our metric
vmax_scale <- colorRampPalette(c('red', 'orange', 'lightgreen', 'darkgreen')) (nlevels(factor(df$value)))
Sets our velocity colour scale
Colour names were used here transitioning from red for low to green for high
As before number of transition colours is going to be set by the number of values present for our metric
if_else(df$metric == 'Percentage of Max Velocity', vmax_scale, td_scale)}
Finally we use dplyr::if_else() to set which colour scale will be used.
This function will also set the colour used in our tooltip

Title/Subtitle

Similar to colours above, as we will be allowing different metrics to be used, we need our plot title and subtitle to adapt based on the metric chosen. Here we will need to have a different title/subtitle for each metric.

Our title will show what metric has been chosen and will need a nested dplyr::if_else() to work correctly. Whereas our subtitle will indicate what the colour code, set above, means and only need a single if_else().

Title

title_func <- function(df){
Open and name our function
title_td <- expression(paste(bold('Total Distance '), ' Covered Per Day'))
Set our title for total distance.
Here we use both expression()and paste()
Expression lets us make the metric bold and paste joins the two sections together
This is repeated for each metric
title_msr <- expression(paste(bold('Moderate Speed Distance '), ' Covered Per Day'))
title_hsr <- expression(paste(bold('High Speed Distance '), ' Covered Per Day'))
title_vmax <- expression(paste(bold('Percent Max Velocity '), ' Achieved Per Day'))
if_else(df$metric == 'Total Distance', title_td, if_else(df$metric == 'Moderate Speed Distance', title_msr, if_else(df$metric == 'High Speed Distance', title_hsr, title_vmax)))}
Here we use a nested dplyr::if_else()to set which title will appear based on the metric chosen.

Subtitle

subtitle_func <- function(df){
Open and name our function
sub_dist <- paste0('Blue ->> Low, Green ->> OK, Orange ->> Warning, Red ->> High\n','Athlete Name: ', df$Name)
Set our title to indicate the meaning of our colour code and athlete name chosen
\n adds a line break to our subtitle
paste0()does not add a space between function components like paste()does
Repeat for velocity
sub_vel <- paste0('Red ->> Low, Orange ->> OK, Green ->> Good\n' , 'Athlete Name: ', df$Name)
if_else(df$metric == 'Percentage of Max Velocity',sub_vel,sub_dist)}
Single if_else()setting which subtitle to be used.

Now that we have our functions and data ready to be used we can start to create our calendar plot.

Plot

ggplot(df, aes(weekStart, dow, fill = factor(value)))
Begin our plot with weekstart as our x-axis, day of week on the y-axis and fill set to the value column.
value is wrapped in factor to show we do not want a colour scale applied
geom_tile_interactive(colour = "white", aes(tooltip = tooltips, data_id = as.character(Date)), size = .1)
Using ggiraph::geom_tile_interactive() we create our interactive tiles.
Based on ggplot2::geom_tile()
The aesthetics set our tooltips equal to the variable created earlier
data_id indicates what we want highlighted if we click on the calendar. We wile use this to set and derive our click event data later.
scale_fill_manual(values = tooltips_colour_func2(ts_data3))
Here we set the fill colours using our function created earlier
scale_x_date(date_breaks = "1 week",date_labels="%d-%b")
We set the X-axis labels to show month and day here, e.g “03-Jul”
bbplot::bbc_style()
We use the bbplot package to set the majority of our theme elements
ggExtra::removeGrid()
Removes all grid lines
ggtitle(title_func(ts_data3),subtitle = subtitle_func(ts_data3))
Uses title and subtitle using functions created earlier
labs(x = "Week Beginning", y = NULL)
X and Y axis labels
facet_wrap(~ yearmonth, scales = 'free_x')
Sets faceting variable along with x-axis to readjust based on each facet
theme(plot.title = element_text(hjust = 0, size = 14), plot.subtitle = element_text(size = 10),strip.text = element_text(size = 6),axis.ticks = element_blank(), axis.text.y = element_text(size = 4), axis.text.x = element_text(size = 5, angle = 70), legend.position = "none")
Theme elements, mainly text formatting
girafe(code = print(x2))
tooltip_css <- "padding:10px;border-radius:10px 20px 10px 20px;"
girafe_options(x2, opts_tooltip(offx = -60, offy = -120, use_fill = TRUE, css = tooltip_css),opts_selection(css = 'fill:grey')
Above creates output as ggiraph object and formats tooltip

Heatmap In Markdown

Having covered the main elements of creating our calendar, in order to fully utilise it in R Markdown we must create a Shiny app within our report. While the calendar can be used outside of a Shiny app on its own, to produce the table based on click events, we need it within the app.

Integrating Shiny Apps with R Markdown

A full introduction to shiny app development is beyond the scope of this post, we will cover the basic elements here in order to use the calendar fully.

Shiny App Basics

A shiny app consists of two main parts, the UI (User Interface) and the server (where the magic happens). The UI sets what the user will see and be able to interact with. The server is where the majority of our script will live and work. There are two methods of embedding a shiny app within a r markdown report: create the app within a code chunk using shiny::shinyApp()or call on a pre-exisiting app using shiny::shinyAppDir(). For our calendar we will chose the first option as it is a relatively short script.

Shiny App: UI

The UI for our app will add some of the reactive components covered previously along with set the layout for our app.

shinyApp(
Opens our shiny app creation
ui = fluidPage(
Begins the UI design and sets it to fluidpage
The fluid page design will alter based on the browser width
dateRangeInput('date_select2', label = 'Select Date Range', start = min(ts_data2$Date), end = max(ts_data2$Date), min = min(ts_data2$Date), max = max(ts_data2$Date),weekstart = 1),
Date range input
selectInput('name_select', label = 'Select Name', choices = unique(df2$Name)),
Creates an input to allow user select different athletes
selectInput('metric_select', label = 'Select Metric Name', choices = unique(df2$metric),selected = 'Total Distance'),
Input to allow user select different metrics
ggiraphOutput("calHeat"),shiny::htmlOutput('dt')),
Output for our calendar plot and table of data
Each component on the UI is followed by a comma before beginning the next
Close UI, note comma at end as we are still within the shinyApp function

Shiny App: Server

server = function(input, output, session){
Open our server function
It consists of:
Input variables — Reactive UI elements
Output variables — Server output
Session — Shiny session name
output$calHeat = renderggiraph({
Begin rendering our calendar plot
‘calHeat’ is the name we will give our calendar and is referenced in the UI above along with the click event later on
ts_data3 <- ts_data2 %>% filter(Date >= input$date_select2[1] & Date <= input$date_select2[2] & Name == input$name_select & metric == input$metric_select)
Filter our dataset based on the user inputs.
x2 <- ts_data3 %>% ggplot(aes(weekStart,.....
Create our calendar as outline above
As we opened our render with ({, we will close it })
No comma to separate different server elements

Now we need only close our server function and our shinyApp function to have created our shiny App within our R Markdown report.

Shiny App Additions

Having created the basis for our shiny app we can now start to add elements to increase its usability and benefit for the end-user. We will look at two main ways of adding value here. The first will be to create a table of data based dates selected within the calendar. Second we will look at a number of small additions to our app which increase its aesthetics.

Using Click Events

Click events are exactly what they sound like. Certain interactive objects when rendered create background data based off clicking on the object. This data can be accessed using the input$ similar to the name selection or data range above.

For our plot, where we used ggiraph to create it, we add "_selected" to the name of the plot. Therefore, our click event can be access through input$calHeat_selected. The data that will be created from this input will be equal to the data_id=call set in the geom_tile_interactive() within the plot. As we set this to be equal to our date values, the click event returns a vector of dates. We can then use this to filter our dataset and create a table of selected dates. In a later post I will cover how we can alter the data_id input which in turn alters how the dataset will be filter.

Having filtered our data, we will use a combination of kable and formattable to build our table As this was covered in a previous post, I won’t speak about the table building section here.

output$dt <- shiny::renderUI({
Set the table output to be called “dt”
We use renderUI() here s we are creating a HTML object
out <- ts_data2 %>%filter(Name == input$name_select & Date %in% anytime::anydate(input$calHeat_selected))
Here we filter our dataset based on the name inputs and click events
We must format the click event data as a date time variable

We have one last step to take before we are finished here. If we leave the table render in its current format, there will be a error message present until dates are selected. By adding an “if else” statement at the beginning we can avoid it. Here we we will say to print “Select Dates To View Table” if the click input is empty. If it isn’t empty, print the table.

We now have our code which we will use to build our table.

Data Download From Report

A further step we can take is to allow the user download the data they have selected from the calendar. This means the user can identify dates of high/low load visually, isolate them within the calendar and then download the data for further analysis themselves.

This step requires additions to both our UI and server. The UI will now feature a download button and the server will have the script to create the data for the button as well as the download output.

Download Button: UI

downloadButton('downloadFile', 'Download')
The UI is quite straightforward thanks to the shiny::downloadButton()function.
‘downloadFile’ is referencing the dataset we will create in the server
‘Download’ is the text that will appear on our button

Download Button: Server

In order to have the data available to download, we need to create the dataset. As the table was created in HTML, we cannot use the output for the download data. Instead, we will create a dataset that only exists within the server that we will bring into our download function.

df <- reactive({
Create on abject that reacts to user inputs
ts_data2 %>% filter(Name == input$name_select & Date %in% anytime::anydate(input$calHeat_selected))...
Filter our data using the inputs then continue to build our dataset

output$downloadFile <- downloadHandler(
Here we set the output, however we then use the downloadHandler()function rather than the render types used previously.
filename = function(){
Creates function which builds our file name
paste0(input$name_select,"_", Sys.Date(), ".csv")},
Names our file based on the athlete selected and date.
content = function(file) {write.csv(df(), file,row.names = FALSE)})
Create the content that will exist in our download using write.csv() and the dataset create in the reactive()function
The dataset referenced must have the () after it

We now have a download button present on our report which allows the user download data from selected dates and athletes.

Shiny App Extras

Shiny apps on the own, while providing a lot of functionality, can at times be difficult to use. One area that can create a degree of confusion is that it can be hard to know if the app is working or not while carry out analysis on the server side. Thankfully, there are a few steps we can take to overcome this.

All of these shiny add-ons rely on the shinyjs package and need the package itself loaded initally along with the useShinjs() at the start of the server.

Object Loading Icons

During the initial setup and when inputs are changed shiny greys our the various objects while they are being rendered. We can change this using the shinycssloaders package. This allows us to set an icon to indicate work is being carried out on the server side. It’s very simple to add this loader in as you will see.

ggiraphOutput("calHeat") %>% withSpinner(color="#0dc5c1")
shiny::htmlOutput('dt') %>% withSpinner(color="#0dc5c1")
The simple withSpinner() function creates a loading icon and we can set the colour within the function as well

App Loading Screen

Similar to above, where having the icon to indicate work is being carried out server side we can also add a similar stage while the app itself is being initialised. This part does require a bit more work however thankfully Dean Attali has put it together nicely for us here.

This step will be carried out using the shinyjs package. This lets us integrate some java script into our app.
appCSS <- "loading-content {position: absolute; background: #000000 opacity: 0.9; z-index: 100; left: 0; right: 0; height: 100%; text-align: center; color: #FFFFFF; }"
This creates CSS settings for our loading screen
Alter the above will affect the aesthetics of the loading screen
In order to use this CSS we have to add a function to the start of our server
shinyjs::inlineCSS(appCSS)
Now we will add a section at the start of the server which will appear first
div(id = "loading-content",h2("Loading…"))
This creates a section that will load initially.
id sets the object name, while h2 sets the text that will appear
Finally we need to set the loading to screen to disappear once the app has loaded
hide(id = "loading-content", anim = TRUE, animType = "fade")
show("app-content")
This doesn’t remove the loading screen as such, it simply hides it so it is no longer visible.
There is an additional animation set so the screen will fade away rather than vanish

Alert Pop-Up

Finally we have one last add-in to look at, that is the ability to have a pop-up message appear when the app is opened first. Again there is a package to allow this to be carried out without too much difficulty, shinyAlerts. While there a number of alerts avaialble for you to look at, here we will cover a basic one which will be a message popup once the app has opened. In a report situation, this could inform the user the last time data within the report was refreshed or of any irregularities they should be aware of.

This has a simple function to be added to UI:

useShinyalert(),

We have a bit more to add in the server however:

shinyalert(title = "Hello", text = "This is to show annoying popups are possible here!", type = "success", confirmButtonText = "OK")
Here we set the message type, title and text, along with the text for the button to remove the message.
There are a number of optional extras available in this package for different message types.

In Closing

A long post here, hopefully I didnt lose too many of you during it and you have gained an idea of how to use a shiny app to add more to your report. Along with how to create a calendar heatmap for your own metrics. As always, the full script is available here along with the data needed to run it. The script output can be viewed here also.

If you haven’t read them yet, don’t forget to check out the earlier post from our R Markdown series:

Any comments or questions about the above please comment below, reach out through the site or twitter! Thanks for reading!