R Shiny Highcharts - How to Create Interactive and Animated Shiny Dashboards

Estimated time:
time
min

Welcome to the third (and final) part of our R Highcharts article series. So far, you've learned how to make basic interactive charts, and how to make drilldown charts. These two articles are a must-read before going over this one, since today the focus will be on code rather than explanations.

After reading today's piece, you'll know how to create interactive and animated dashboards with the R Shiny Highcharts module - both through basic charts and drill-downs. We'll also go over some basics of R Shiny, such as filtering and styling. Let's dig in!

Are your R/Shiny team skills up to date? Take them to next level by reading our ebook.

Table of contents:

Exploring R Shiny Highcharts Dashboard Elements

The application we're about to create will contain a couple of elements, so it's a good idea to explain what's where and what does what. It will be based on the Gapminder datatset, and will show information such as life expectancy, population, and GDP per continent, year, and country.

Here's a sketch of the application:

Image 1 - Sketch of our application
Image 1 - Sketch of our application

As you can see, the application starts with a couple of filters. These allow the user to control the continent and start/end years. Not all values and charts will be affected by the year filters, as some of them will show only the most recent values (2007).

In the Latest stats section, you'll see four boxes showing information on the number of countries and other various statistics for a given continent. The year filters won't do anything to these boxes, as only the most recent values will be shown.

Below, we have two Summary stats charts. These will be a bar chart showing median life expectancy by year, and a line chart showing population by year. These two are affected by both the continent and year filter values. It's also worth noting that they show an average across all countries in a continent, so some degree of skew is to be expected.

And finally, we have the Drilldown section. It contains only one chart which shows the most recent population across the country for a given continent. When you click on an individual bar, you'll see the population stats across years only for the given country. Neat!

Let's start building the thing!

Building the R Shiny Highcharts Dashboard

This section will be quite code-intensive and will require fundamental R Shiny knowledge. If you're a complete beginner, we recommend checking our library of Shiny articles first.

Let's start with the easiest part - summary stats.

Summary Stats Cards

Truth be told, filters and summary stats have nothing to do with R Highcharts, but will take our dashboard to the next level. As mentioned before, we're working with the Gapminder dataset, and the idea is to allow the user to select a continent and a year range from which the dashboard contents will get updated.

The Shiny app's UI is divided into two parts - sidebarPanel() and mainPanel(). The first one contains all UI controls (filters), while the second one renders the contents.

Regarding filters, R's unique() function is quite useful here, as it allows us to grab only distinct elements from a categorical variable. For the years filters, we'll remove the highest year from the min filter and the lowest year from the max filter.

The contents of mainPanel() are organized in a way that we have one container with four containers inside it - each of which contains one summary statistic.

As for the server(), we're simply creating a reactive dataset that calculates the summary statistics based on the selected continent and then using renderText() to display the values for each summary statistics card.

Here's the full code snippet:

library(shiny)
library(dplyr)
library(purrr)
library(gapminder)
library(highcharter)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      titlePanel("R Shiny Highcharts"),
      selectInput(
        inputId = "inContinent",
        label = "Continent:",
        choices = unique(gapminder$continent),
        selected = "Europe"
      ),
      selectInput(
        inputId = "inYearMin",
        label = "Start year:",
        choices = unique(gapminder$year)[1:length(unique(gapminder$year)) - 1],
        selected = min(gapminder$year)
      ),
      selectInput(
        inputId = "inYearMax",
        label = "End year:",
        choices = unique(gapminder$year)[2:length(unique(gapminder$year))],
        selected = max(gapminder$year)
      ),
      width = 3
    ),
    mainPanel(
      tags$h3("Latest stats:"),
      tags$div(
        tags$div(
          tags$p("#Countries"),
          textOutput(outputId = "outNCountries")
        ),
        tags$div(
          tags$p("Median life exp."),
          textOutput(outputId = "outMedLifeExp")
        ),
        tags$div(
          tags$p("Median population"),
          textOutput(outputId = "outMedPop")
        ),
        tags$div(
          tags$p("Median GDP"),
          textOutput(outputId = "outMedGDP")
        )
      ),
      width = 9
    )
  )
)

server <- function(input, output) {
  data_cards <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        year == max(year)
      ) %>%
      summarise(
        nCountries = n_distinct(country),
        medianLifeExp = median(lifeExp),
        medianPopM = median(pop / 1e6),
        medianGDP = median(gdpPercap)
      )
  })
  
  output$outNCountries <- renderText({
    data_cards()$nCountries
  })
  output$outMedLifeExp <- renderText({
    paste(round(data_cards()$medianLifeExp, 1), "years")
  })
  output$outMedPop <- renderText({
    paste0(round(data_cards()$medianPopM, 2), "M")
  })
  output$outMedGDP <- renderText({
    paste0("$", round(data_cards()$medianGDP, 2))
  })
}


shinyApp(ui = ui, server = server)

And here's what the R Shiny Highcharts application looks like:

Image 2 - R Shiny Highcharts dashboard (1)
Image 2 - R Shiny Highcharts dashboard (1)

The values are there and correct, but we'd benefit tremendously from a bit of styling. Let's introduce CSS next.

Basic Dashboard Styling

You can use both CSS and SCSS to style your R Shiny dashboards. We'll stick with the first option.

Create a www/styles.css file and paste the following inside it:

@import url('https://fonts.googleapis.com/css2?family=Poppins:ital,wght@0,700;1,400&display=swap');

* {
  margin: 0;
  padding: 0;
  box-sizing: border-box;
}

body {
  font-family: 'Poppins', sans-serif;
  font-weight: 400;
}

.main-container {
  padding-top: 1rem;
}

.stat-card-container {
  display: flex;
  justify-content: space-between;
  column-gap: 1rem;
}

.stat-card {
  border: 2px solid #f2f2f2;
  border-bottom: 2px solid #0198f9;
  width: 100%;
  padding: 0.5rem 0 0.5rem 1rem;
}

.stat-card > p {
  text-transform: uppercase;
  color: #808080;
}

.stat-card > div.shiny-text-output {
  font-size: 3rem;
  font-weight: 700;
}

Long story short, this piece of code will change the overall font, reset a couple of styles, and make our dashboard nicer to look at.

The only problem is - the CSS file isn't connected with R Shiny.

What you'll need to do is to add a link tag to the head of the application and reference our styles.css file (Shiny assumes it's located in the www folder). You'll also want to add CSS class names to HTML attributes by piping the tagAppendAttributes(class = "class-name") function at the end of it.

Only the code in ui has changed, server() is identical as before:

library(shiny)
library(dplyr)
library(purrr)
library(gapminder)
library(highcharter)


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
  ),
  sidebarLayout(
    sidebarPanel(
      titlePanel("R Shiny Highcharts"),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      width = 3
    ),
    mainPanel(
      tags$h3("Latest stats:"),
      tags$div(
        tags$div(
          tags$p("# Countries:"),
          textOutput(outputId = "outNCountries")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median life exp:"),
          textOutput(outputId = "outMedLifeExp")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median population:"),
          textOutput(outputId = "outMedPop")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median GDP:"),
          textOutput(outputId = "outMedGDP")
        ) %>% tagAppendAttributes(class = "stat-card")
      ) %>% tagAppendAttributes(class = "stat-card-container"),
      width = 9
    ) %>% tagAppendAttributes(class = "main-container")
  )
)

server <- function(input, output) {
  ...
}


shinyApp(ui = ui, server = server)

Our R Shiny application is now significantly more appealing:

Image 3 - R Shiny Highcharts dashboard (2)
Image 3 - R Shiny Highcharts dashboard (2)

We now have everything needed to introduce some visualizations with Highcharts.

Adding Basic R Highcharts

So far, we've successfully set the stage, so let's dive into the good stuff now. This section will walk you through two basic Highcharts visualizations in R Shiny, and these will show the following:

  • Median life expectancy by year: For all countries in a selected continent and a selected year range.
  • Median GDP by year: Once again, the median is calculated on a per-country level for a continent and a selected year range.

You can work with Highcharts visualizations in R Shiny by calling the highchartOutput() function in ui(). It accepts an outputId and an optional height parameter, so you can easily tweak the basic looks straight from R.

Down in server(), it's a familiar situation (if you've been following along with the series). We have a new data frame - data_charts - and it contains the filtered and aggregated life expectancy and GDP data. The renderHighchart() is used to create a Highcharts visualization, and it accepts a block of familiar functions:

library(shiny)
library(dplyr)
library(purrr)
library(gapminder)
library(highcharter)


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
  ),
  sidebarLayout(
    sidebarPanel(
      titlePanel("R Shiny Highcharts"),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      width = 3
    ),
    mainPanel(
      tags$h3("Latest stats:"),
      tags$div(
        ...
      ) %>% tagAppendAttributes(class = "stat-card-container"),
      
      tags$div(
        tags$h3("Summary stats:"),
        tags$div(
          tags$div(
            highchartOutput(outputId = "chartLifeExpByYear",  height = 500)
          ) %>% tagAppendAttributes(class = "chart-card"),
          tags$div(
            highchartOutput(outputId = "chartGDPByYear", height = 500)
          ) %>% tagAppendAttributes(class = "chart-card"),
        ) %>% tagAppendAttributes(class = "base-charts-container")
      ) %>% tagAppendAttributes(class = "card-container"),
      
      width = 9
    ) %>% tagAppendAttributes(class = "main-container")
  )
)

server <- function(input, output) {
  data_cards <- reactive({
    ...
  })
  
  data_charts <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        between(year, as.integer(input$inYearMin), as.integer(input$inYearMax))
      ) %>%
      group_by(year) %>%
      summarise(
        medianLifeExp = round(median(lifeExp), 1),
        medianGDP = round(median(gdpPercap), 2)
      )
  })
  
  
  output$outNCountries <- renderText({
    ...
  })
  output$outMedLifeExp <- renderText({
    ...
  })
  output$outMedPop <- renderText({
    ...
  })
  output$outMedGDP <- renderText({
    ...
  })
  
  output$chartLifeExpByYear <- renderHighchart({
    hchart(data_charts(), "column", hcaes(x = year, y = medianLifeExp), color = "#0198f9", name = "Median life expectancy") |>
      hc_title(text = "Median life expectancy by year", align = "left") |>
      hc_xAxis(title = list(text = "Year")) |>
      hc_yAxis(title = list(text = "Life expectancy"))
  })
  
  output$chartGDPByYear <- renderHighchart({
    hchart(data_charts(), "line", hcaes(x = year, y = medianGDP), color = "#800000", name = "Median GDP") |>
      hc_title(text = "Median GDP by year", align = "left") |>
      hc_xAxis(title = list(text = "Year")) |>
      hc_yAxis(title = list(text = "GDP"))
  })
}


shinyApp(ui = ui, server = server)

We've also added some CSS classes to app.R, so here's the corresponding CSS code for them:

.card-container {
  padding-top: 2rem;
}

.base-charts-container {
  display: flex;
  justify-content: space-between;
  column-gap: 1rem;
}

.chart-card {
  border: 2px solid #f2f2f2;
  width: 50%;
}

And this is what the application looks like now:

Image 4 - R Shiny Highcharts dashboard (3)
Image 4 - R Shiny Highcharts dashboard (3)

Both charts look amazing, are fully interactive, and have a nice animation when first loading the dashboard or when refreshing the data.

The only thing left to do is to include a drilldown chart, so let's go over that next.

Adding a Highcharts Drilldown Chart

A drilldown chart will allow the user to click on individual chart elements to see a new, drilled-down version of the visualization. In our case, we'll have a per-country column chart of the population for a selected continent (only for the latest year) by default. When a column is clicked, a new column chart appears showing only the population for the clicked country through time.

Seems easy enough, but remember - we'll need two datasets. The first one is for the default visualization, and the second is for the drilled-down chart. If you've read the previous article you already know what you need to do.

To recap, the drilled-down dataset needs a column of type list that contains the data that'll be visible when a single column is clicked. The hc_drilldown() function is then used to enable drilldown mode.

Here's the code:

library(shiny)
library(dplyr)
library(purrr)
library(gapminder)
library(highcharter)


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
  ),
  sidebarLayout(
    sidebarPanel(
      titlePanel("R Shiny Highcharts"),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      selectInput(
        ...
      ),
      width = 3
    ),
    mainPanel(
      tags$h3("Latest stats:"),
      tags$div(
        ...
      ) %>% tagAppendAttributes(class = "stat-card-container"),
      tags$div(
        ...
      ) %>% tagAppendAttributes(class = "card-container"),

      tags$div(
        tags$h3("Drilldown:"),
        tags$div(
          highchartOutput(outputId = "chartDrilldown", height = 500)
        ) %>% tagAppendAttributes(class = "chart-card chart-card-full")
      ) %>% tagAppendAttributes(class = "card-container"),
      width = 9
    ) %>% tagAppendAttributes(class = "main-container")
  )
)

server <- function(input, output) {
  data_cards <- reactive({
    ...
  })
  
  data_charts <- reactive({
    ...
  })
  
  drilldown_chart_base_data <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        year == max(year)
      ) %>%
      group_by(country) %>%
      summarise(
        pop = round(pop, 1)
      ) %>%
      arrange(desc(pop))
  })
  
  drilldown_chart_drilldown_data <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        between(year, as.integer(input$inYearMin), as.integer(input$inYearMax))
      ) %>%
      group_nest(country) %>%
      mutate(
        id = country,
        type = "column",
        data = map(data, mutate, name = year, y = pop),
        data = map(data, list_parse)
      )
  })
  
  
  output$outNCountries <- renderText({
    ...
  })
  output$outMedLifeExp <- renderText({
    ...
  })
  output$outMedPop <- renderText({
    ...
  })
  output$outMedGDP <- renderText({
    ...
  })
  
  output$chartLifeExpByYear <- renderHighchart({
    ...
  })
  
  output$chartGDPByYear <- renderHighchart({
    ...
  })
  
  output$chartDrilldown <- renderHighchart({
    hchart(
      drilldown_chart_base_data(),
      "column",
      hcaes(x = country, y = pop, drilldown = country),
      name = "Population"
    ) %>%
      hc_drilldown(
        allowPointDrilldown = TRUE,
        series = list_parse(drilldown_chart_drilldown_data())
      ) |>
      hc_colors(c("#004c5f")) |>
      hc_title(text = "Population report", align = "left") |>
      hc_xAxis(title = list(text = "")) |>
      hc_yAxis(title = list(text = "Population"))
  })
}


shinyApp(ui = ui, server = server)

There's only a slight addition needed in styles.css to make our chart card 100% wide:

.chart-card-full {
  width: 100%;
}

And that's it - we have a finished R Shiny Highcharts dashboard now:

Image 5 - R Shiny Highcharts dashboard (4)
Image 5 - R Shiny Highcharts dashboard (4)

You can probably make it look better by tweaking the styles, but it does the job perfectly even in this state. Let's make a brief recap next.

Full Source Code

In case you've missed something or just want to copy/paste the code, this section is for you.

app.R

library(shiny)
library(dplyr)
library(purrr)
library(gapminder)
library(highcharter)


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
  ),
  sidebarLayout(
    sidebarPanel(
      titlePanel("R Shiny Highcharts"),
      selectInput(
        inputId = "inContinent",
        label = "Continent:",
        choices = unique(gapminder$continent),
        selected = "Europe"
      ),
      selectInput(
        inputId = "inYearMin",
        label = "Start year:",
        choices = unique(gapminder$year)[1:length(unique(gapminder$year)) - 1],
        selected = min(gapminder$year)
      ),
      selectInput(
        inputId = "inYearMax",
        label = "End year:",
        choices = unique(gapminder$year)[2:length(unique(gapminder$year))],
        selected = max(gapminder$year)
      ),
      width = 3
    ),
    mainPanel(
      tags$h3("Latest stats:"),
      tags$div(
        tags$div(
          tags$p("# Countries:"),
          textOutput(outputId = "outNCountries")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median life exp:"),
          textOutput(outputId = "outMedLifeExp")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median population:"),
          textOutput(outputId = "outMedPop")
        ) %>% tagAppendAttributes(class = "stat-card"),
        tags$div(
          tags$p("Median GDP:"),
          textOutput(outputId = "outMedGDP")
        ) %>% tagAppendAttributes(class = "stat-card")
      ) %>% tagAppendAttributes(class = "stat-card-container"),
      tags$div(
        tags$h3("Summary stats:"),
        tags$div(
          tags$div(
            highchartOutput(outputId = "chartLifeExpByYear", height = 500)
          ) %>% tagAppendAttributes(class = "chart-card"),
          tags$div(
            highchartOutput(outputId = "chartGDPByYear", height = 500)
          ) %>% tagAppendAttributes(class = "chart-card"),
        ) %>% tagAppendAttributes(class = "base-charts-container")
      ) %>% tagAppendAttributes(class = "card-container"),
      tags$div(
        tags$h3("Drilldown:"),
        tags$div(
          highchartOutput(outputId = "chartDrilldown", height = 500)
        ) %>% tagAppendAttributes(class = "chart-card chart-card-full")
      ) %>% tagAppendAttributes(class = "card-container"),
      width = 9
    ) %>% tagAppendAttributes(class = "main-container")
  )
)

server <- function(input, output) {
  data_cards <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        year == max(year)
      ) %>%
      summarise(
        nCountries = n_distinct(country),
        medianLifeExp = median(lifeExp),
        medianPopM = median(pop / 1e6),
        medianGDP = median(gdpPercap)
      )
  })
  
  data_charts <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        between(year, as.integer(input$inYearMin), as.integer(input$inYearMax))
      ) %>%
      group_by(year) %>%
      summarise(
        medianLifeExp = round(median(lifeExp), 1),
        medianGDP = round(median(gdpPercap), 2)
      )
  })
  
  drilldown_chart_base_data <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        year == max(year)
      ) %>%
      group_by(country) %>%
      summarise(
        pop = round(pop, 1)
      ) %>%
      arrange(desc(pop))
  })
  
  drilldown_chart_drilldown_data <- reactive({
    gapminder %>%
      filter(
        continent == input$inContinent,
        between(year, as.integer(input$inYearMin), as.integer(input$inYearMax))
      ) %>%
      group_nest(country) %>%
      mutate(
        id = country,
        type = "column",
        data = map(data, mutate, name = year, y = pop),
        data = map(data, list_parse)
      )
  })
  
  
  output$outNCountries <- renderText({
    data_cards()$nCountries
  })
  output$outMedLifeExp <- renderText({
    paste(round(data_cards()$medianLifeExp, 1), "years")
  })
  output$outMedPop <- renderText({
    paste0(round(data_cards()$medianPopM, 2), "M")
  })
  output$outMedGDP <- renderText({
    paste0("$", round(data_cards()$medianGDP, 2))
  })
  
  output$chartLifeExpByYear <- renderHighchart({
    hchart(data_charts(), "column", hcaes(x = year, y = medianLifeExp), color = "#0198f9", name = "Median life expectancy") |>
      hc_title(text = "Median life expectancy by year", align = "left") |>
      hc_xAxis(title = list(text = "Year")) |>
      hc_yAxis(title = list(text = "Life expectancy"))
  })
  
  output$chartGDPByYear <- renderHighchart({
    hchart(data_charts(), "line", hcaes(x = year, y = medianGDP), color = "#800000", name = "Median GDP") |>
      hc_title(text = "Median GDP by year", align = "left") |>
      hc_xAxis(title = list(text = "Year")) |>
      hc_yAxis(title = list(text = "GDP"))
  })
  
  output$chartDrilldown <- renderHighchart({
    hchart(
      drilldown_chart_base_data(),
      "column",
      hcaes(x = country, y = pop, drilldown = country),
      name = "Population"
    ) %>%
      hc_drilldown(
        allowPointDrilldown = TRUE,
        series = list_parse(drilldown_chart_drilldown_data())
      ) |>
      hc_colors(c("#004c5f")) |>
      hc_title(text = "Population report", align = "left") |>
      hc_xAxis(title = list(text = "")) |>
      hc_yAxis(title = list(text = "Population"))
  })
}


shinyApp(ui = ui, server = server)

www/styles.css

@import url('https://fonts.googleapis.com/css2?family=Poppins:ital,wght@0,700;1,400&display=swap');

* {
  margin: 0;
  padding: 0;
  box-sizing: border-box;
}

body {
  font-family: 'Poppins', sans-serif;
  font-weight: 400;
}

.main-container {
  padding-top: 1rem;
}

.stat-card-container {
  display: flex;
  justify-content: space-between;
  column-gap: 1rem;
}

.stat-card {
  border: 2px solid #f2f2f2;
  border-bottom: 2px solid #0198f9;
  width: 100%;
  padding: 0.5rem 0 0.5rem 1rem;
}

.stat-card > p {
  text-transform: uppercase;
  color: #808080;
}

.stat-card > div.shiny-text-output {
  font-size: 3rem;
  font-weight: 700;
}

.card-container {
  padding-top: 2rem;
}

.base-charts-container {
  display: flex;
  justify-content: space-between;
  column-gap: 1rem;
}

.chart-card {
  border: 2px solid #f2f2f2;
  width: 50%;
}

.chart-card-full {
  width: 100%;
}

Summing up R Shiny Highcharts

This article concludes our three-part series on R Highcharts. You've learned how to make basic interactive visualizations, how to make drilldown charts, and today, how to tie it all together with R Shiny. You now have everything needed to leverage Highcharts on your next project or to build an impressive resume of Shiny applications.

Today's article was a bit heavier on the code and lighter on explanations - that's because you already know how things work, and our resulting app has a fair amount of reactive code. We hope it was easy enough to follow, but make sure to pop your question(s) in the comment section below if anything is not 100% clear.

As always, thanks for reading, and stay tuned to the Appsilon blog and our newsletter, Shiny Weekly to learn more about R/Shiny.

If you're wondering what else you need to start a career in R Shiny - We have a 2024-ready guide for you.

Contact us!
Damian's Avatar
Damian Rodziewicz
Head of Sales
Thank you! Your submission has been received!
Oops! Something went wrong while submitting the form.

Sign up for ShinyWeekly

Join 4,2k explorers and get the Shiny Weekly Newsletter into your mailbox
for the latest in R/Shiny and Data Science.

Thank you! Your submission has been received!
Oops! Something went wrong while submitting the form.
r