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

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.
    • 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!

Check how different reporting elements can be combined through a Shiny App as well!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.