How to animate a scatterplot with R Shiny and highcharts

In my work for the OECD, I had to visualize the change over time of two-dimensional data depicted in a scatterplot. The time dimension effectively adds a third, continuous, variable, which is always a bit tricky to visualize. As the plot will be published online, I decided to animate it. The solution I came up with uses R Shiny and highcharter (an R wrapper for the Highcharts javascript library).

The plot in the following example depicts GDP and life satisfaction by country over time. The size of each dot represents population size. The data, which I sourced from Our World in Data, can be downloaded here. The example app can also be viewed here.

To create this plot, let us first load the packages and data:

rm(list=ls()) 

library(dplyr) 
library(shiny) 
library(highcharter) 

gdp_satis <- readRDS("gdp_satis.rds")

R Shiny applications consist of two objects – the UI and the server object. I refer readers to Hadley Wickham’s book Mastering Shiny for more details. In the UI object, we create the frontend that users get to see:

ui <-
  fluidPage(
    
    highchartOutput("scatter"),
    
    sliderInput(
      inputId = "slider",
      label = NULL,
      min = 2005,
      max = 2020,
      value = 2005,
      step = 1,
      sep = "",
      width = "100%",
      animate = animationOptions(
        interval = 1000,
        loop = FALSE,
        playButton = actionButton("play", "Play", icon = icon("play"), width = "100px", style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4"),
        pauseButton = actionButton("pause", "Pause", icon = icon("pause"), width = "100px", style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4")
      )),
    
    actionButton("reset", "Reset", icon = icon("rotate-left"), width = "100px", style = "margin-left: 650px; margin-top: -87px")
    
  )

The first object in UI, highchartOutput("scatter"), will plot the scatterplot. I use the javascript library highcharts and the R package highcharter for plotting. The second object in UI, sliderInput(), is the slider with which users input the year they want to see. The option animate creates a play/pause button that automates the input. The third object in UI, actionButton(), is an additional reset button.

In the server object, we define both the plot itself and the update mechanism:

server <- function(input, output, session) {
  
  # (1) Initialize Plot 
  output$scatter <- renderHighchart({ 
    
    isolate({
      
      highchart() %>% 
        hc_add_series(
          id="hc_scatter",
          data = gdp_satis %>% filter(year==input$slider),
          type = "scatter",
          mapping = 
            hcaes(
              id=id,
              x=gdp,
              y=satisfaction,
              size=population,
              name=country
            )
        ) %>% 
        hc_plotOptions(
          series = list(
            point = list(
              events = list(
                click = JS("function(event) { this.update({color: (this.color === '#7cb5ec' ? 'red' : '#7cb5ec') }) }") 
              )))) %>% 
        hc_title(text = paste0("Showing year: ", input$slider)) %>% 
        hc_xAxis(
          title = list(text = "GDP"),
          plotLines = list(list(value = gdp_satis %>% filter(year==input$slider) %>% pull(gdp) %>% mean(), width = 1)),
          min=gdp_satis %>% pull(gdp) %>% min(), 
          max=gdp_satis %>% pull(gdp) %>% max()
        ) %>%
        hc_yAxis(
          title = list(text = "Satisfaction"),
          plotLines = list(list(value = gdp_satis %>% filter(year==input$slider) %>% pull(satisfaction) %>% mean(), width = 1)),
          min=gdp_satis %>% pull(satisfaction) %>% min(),
          max=gdp_satis %>% pull(satisfaction) %>% max()
        ) %>%
        hc_legend(enabled = FALSE) %>% 
        hc_tooltip(
          useHTML = TRUE,
          pointFormat = tooltip_table(c("Country", "GDP", "Satisfaction"), sprintf("{point.%s}", c("country", "gdp", "satisfaction"))),
          headerFormat = ""
        ) %>%
        hc_credits(enabled = TRUE, text = "Benjamin Rosche - benrosche.com") %>%
        hc_exporting(
          enabled = TRUE,
          filename = "gdp_satis"
        )
      
    })
    
  })
  
  # (2) Update Plot
  observeEvent(input$slider, {
    
    highchartProxy("scatter") %>%
      hcpxy_set_data(
        type = "scatter",
        data = gdp_satis %>% filter(year==input$slider),
        mapping = 
          hcaes(
            id=id,
            x=gdp,
            y=satisfaction,
            size=population,
            name=country
          )
      ) %>% 
      hcpxy_update(
        title = list(text = paste0("Showing year: ", input$slider))
      )
    
  })

  # (3) Reset button 
  observeEvent(input$reset, {
    
    updateSliderInput(
      session = session,
      inputId = "slider",
      value = 2005
    )
    
    highchartProxy("scatter") %>%
      hcpxy_update_series(
        id="hc_scatter",
        data= gdp_satis %>% filter(year==input$slider),
        color="#7cb5ec"
      )
    
  })
  
}

The first object, output$scatter <- renderHighchart({...}), creates the nonanimated scatterplot. For more details on how to use highcharter to create highchart plots, I refer to the author’s website. It is important to give the scatterplot id="hc_scatter", so that we can refer back to it in the update mechanism. Moreover, in the mapping, we pass a unique id for each datapoint so that they are linked over time. In the options, I added some Javascript that allows users to color the points (and reverse it) JS("function(event) { this.update({color: (this.color === '#7cb5ec' ? 'red' : '#7cb5ec') }) }"). Note that the entire plot is encapsulated by isolate({....}) so that the initial plot is not re-rendered after each update.

The second object, observeEvent(input$slider, {...}), continuously checks whether the slider was updated. If this is the case, we update the data with highchartProxy("scatter") (which refers to the Shiny output object) and hcpxy_set_data() (which refers to the highchart plot). We pass the mapping again so that so that the updating looks smooth and colored datapoints retain their colors after an update. Shiny’s functionality to animate the slider then calls this update mechanism every second until the end of the slider is reached.

Finally, the third object, observeEvent(input$reset, {...}), controls the reset button. The hcpxy_update_series() requires the highchart plot id and the original data so that the plot is re-rendered. 

Altogether, the code looks like this:

rm(list=ls())

library(dplyr)
library(shiny)
library(highcharter)

gdp_satis <- readRDS("gdp_satis.rds")

ui <-
  fluidPage(
    
    highchartOutput("scatter"),
    
    sliderInput(
      inputId = "slider",
      label = NULL,
      min = 2005,
      max = 2020,
      value = 2005,
      step = 1,
      sep = "",
      width = "100%",
      animate = animationOptions(
        interval = 800,
        loop = FALSE,
        playButton = actionButton("play", "Play", icon = icon("play"), width = "100px", style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4"),
        pauseButton = actionButton("pause", "Pause", icon = icon("pause"), width = "100px", style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4")
      )),
    
    actionButton("reset", "Reset", icon = icon("rotate-left"), width = "100px", style = "margin-left: 650px; margin-top: -87px")
    
  )

server <- function(input, output, session) {
    
  # (1) Initialize Plot
  output$scatter <- renderHighchart({ 
    
    isolate({
      
      highchart() %>% 
        hc_add_series(
          id="hc_scatter",
          data = gdp_satis %>% filter(year==input$slider),
          type = "scatter",
          animation=TRUE,
          mapping = 
            hcaes(
              id=id,
              x=gdp,
              y=satisfaction,
              size=population,
              name=country
            )
        ) %>% 
        hc_plotOptions(
          series = list(
            point = list(
              events = list(
                click = JS("function(event) { this.update({color: (this.color === '#7cb5ec' ? 'red' : '#7cb5ec') }) }") 
              )))) %>% 
        hc_title(text = paste0("Showing year: ", input$slider)) %>% 
        hc_xAxis(
          title = list(text = "GDP"),
          plotLines = list(list(value = gdp_satis %>% filter(year==input$slider) %>% pull(gdp) %>% mean(), width = 1)),
          min=gdp_satis %>% pull(gdp) %>% min(), 
          max=gdp_satis %>% pull(gdp) %>% max()
        ) %>%
        hc_yAxis(
          title = list(text = "Satisfaction"),
          plotLines = list(list(value = gdp_satis %>% filter(year==input$slider) %>% pull(satisfaction) %>% mean(), width = 1)),
          min=gdp_satis %>% pull(satisfaction) %>% min(),
          max=gdp_satis %>% pull(satisfaction) %>% max()
        ) %>%
        hc_legend(enabled = FALSE) %>% 
        hc_tooltip(
          useHTML = TRUE,
          pointFormat = tooltip_table(c("Country", "GDP", "Satisfaction"), sprintf("{point.%s}", c("country", "gdp", "satisfaction"))),
          headerFormat = ""
        ) %>%
        hc_credits(enabled = TRUE, text = "Benjamin Rosche - benrosche.com") %>%
        hc_exporting(
          enabled = TRUE,
          filename = "gdp_satis"
        )
      
    })
    
  })
  
  # (2) Update Plot
  observeEvent(input$slider, {
    
    highchartProxy("scatter") %>%
      hcpxy_set_data(
        type = "scatter",
        data = gdp_satis %>% filter(year==input$slider),
        mapping = 
          hcaes(
            id=id,
            x=gdp,
            y=satisfaction,
            size=population,
            name=country
          )
      ) %>% 
      hcpxy_update(
        title = list(text = paste0("Showing year: ", input$slider))
      )
    
  })

  # (3) Reset button 
  observeEvent(input$reset, {
    
    updateSliderInput(
      session = session,
      inputId = "slider",
      value = 2005
    )
    
    highchartProxy("scatter") %>%
      hcpxy_update_series(
        id="hc_scatter",
        data= gdp_satis %>% filter(year==input$slider),
        color="#7cb5ec"
      )
    
  })
  
}

shinyApp(ui, server)

References

Esteban Ortiz-Ospina and Max Roser (2013) – “Happiness and Life Satisfaction”. Published online at OurWorldInData.org. Retrieved from: ‘https://ourworldindata.org/happiness-and-life-satisfaction‘.