Overview

Makeover Monday is a website which posts interesting data sets and related articles, each Monday. The aim is to experiment with data visualisations to extract new insights and views from the data.

In this post, I am looking at data for this makeover monday: https://www.makeovermonday.co.uk/week9-2018/.

Data is at https://data.world/makeovermonday/2018w9-world-economic-freedom. The original source and use of the data: https://www.fraserinstitute.org/economic-freedom/map?geozone=world&page=map&year=2015.

The data has 5 KPI variables, each on a scale from 0 to 10, with 10 being the best value:

  • FreedomToTradeInternationally
  • LegalSystemAndPropertyRights
  • Regulation
  • SizeOfGovernment
  • Sound Money

Each has an equal weight, to create a SummaryIndex column. Each country has a single observation for each Year, although not all countries have values for each Year. The Index started in 1970 with 53 teams, whilst 106 Countries have joined since e.g. Vietnam in 2003.

The final dashboard can be found here

Data processing

data, cleaning and plotting scripts are in the R package utils.economicfreedomvis, in my GitHub repo, if you want to play along, otherwise the repo can be forked. Load up the packages below for running the Shiny app and processing the data.

if(FALSE){
  # install pacakges
  devtools::install_github("ropensci/plotly")
  devtools::install_github("jphelps13/small.projects",
                           subdir = "2018-05-01-EconomicFreedomVis")
}

# data and script code
library(utils.economicfreedomvis)

# data manipulation 
library(stringr)
library(magrittr)
library(data.table)

# shiny and plotting libraries
library(shinythemes)
library(shiny)
library(plotly)
library(RColorBrewer)

Data is loaded from the package. Can see the head of the data, and bar plot of when each countries had their first entry in the Economic Freedom Vis.

# load data
data("evf_data")
head(evf_data)
##    Year Iso_code Countries SummaryIndex SizeOfGovernment
## 1: 2015      ALB   Albania     7.543627         7.963672
## 2: 2015      DZA   Algeria     4.842521         3.559961
## 3: 2015      AGO    Angola     5.402199         5.955686
## 4: 2015      ARG Argentina     4.877356         4.869799
## 5: 2015      ARM   Armenia     7.602355         7.117733
## 6: 2015      AUS Australia     7.993726         6.592565
##    LegalSystemAndPropertyRights SoundMoney FreedomToTradeInternationally
## 1:                     5.003489   9.585625                      8.112452
## 2:                     4.551817   6.852790                      4.008432
## 3:                     2.960264   6.885465                      5.143998
## 4:                     3.816362   6.455331                      3.730787
## 5:                     5.777804   9.481225                      8.242619
## 6:                     7.994811   9.360139                      7.600742
##    Regulation
## 1:   7.052895
## 2:   5.239606
## 3:   6.065583
## 4:   5.514501
## 5:   7.392394
## 6:   8.420373
# when did each country start:
first_year <- evf_data[, .(Year = min(Year)), keyby = Countries][, .N, by = Year]
ggplot(data = first_year, aes(x = Year, y = N)) + geom_col(fill = "darkorange") + theme_minimal()

I’m defining some lookups for ease of use in the shiny app for input sliders and for formatting graphs.

# lookups used in the shiny app
year_range    <- range(evf_data$Year)
all_countries <- sort(unique(evf_data$Countries))
all_metrics   <- c("FreedomToTradeInternationally", "LegalSystemAndPropertyRights", 
                   "Regulation", "SizeOfGovernment", "SoundMoney", "SummaryIndex")
# display in the UI with spaces
display_metrics <- stringr::str_replace_all(all_metrics,
                                            "([A-Z]{0,1}[^A-Z]*)([A-Z]*)",
                                            "\\1 \\2") %>% trimws(.)
# for radar plot, specify where line breaks are
display_metrics2 <- c("Freedom To\nTrade\nInternationally", "Legal System And\nProperty Rights", 
                      "Regulation", "Size Of\nGovernment", "Sound Money", "Summary Index"
)
# remove summary index for these lookups - metrics for comparing with summaryIndex
m <- charmatch("SummaryIndex", all_metrics)
all_metricsv2     <- all_metrics[-m]
display_metricsv2 <- display_metrics[-m]
display_metrics2v2 <- display_metrics2[-m]

Originally I did these plots with the raw data for the metrics, and SummaryIndex. I found it easier to visualise the trends by smoothing the data, and imputing any missing years. Function below does this, and renames the raw values. I’ve used natural splines to achieve this. Can see the impact below:

# Visualise when the recordings have occured. Can see from 1970 to 2000, 
# only evey 5 years
par(las = 2)
plot(table(evf_data[Countries == "Argentina", sort(unique(Year))]), ylab = "")

# smooth and impute missing values with splines
evf_data_clean <- preparePlotData(evf_data, all_metrics)

# view natural spline smoothing for data sample
ggplot(data = evf_data_clean[Countries == "Argentina"]) + 
  geom_point(aes(x = Year, y = FreedomToTradeInternationally_raw)) +
  geom_line(aes(x = Year, y = FreedomToTradeInternationally), 
            linetype = 2) + theme_minimal() + ylab("")

Data Visualisations

Firstly, I’ve defined some variables to control the graphics created.

plot_control <- list(
  palette = RColorBrewer::brewer.pal(3, "Set1"),
  font_colour = "black",
  grid_colour = "#d8d8d8",
  bg_colour = "#ffffff",
  paper_colour = "transparent"
)
countries <- c("Russia", "Argentina")
dis_metrics <- c("Freedom To Trade Internationally", "Summary Index")
years <- c(2000, 2015)

The plan is to build a shiny dashboard to compare economic freedom metrics across countries, to see how they change over time.

The first plot I was keen to look at is one I saw used in Alberto Cairo’s book The Functional Art. He made use of a Connected Scatter Plot to show a 2d scatter plot change across time. Here is an example showing the impact of changes in "Freedom To Trade Internationally" in time against the overall "Summary Index". Can see that for Argentina, the former has been consistently dropping from 2000 to 2015, and correlates with a decrease in the Index. For Russia, it hasn’t varied that much, but the Index has increased.

metrics <- all_metrics[charmatch(dis_metrics, display_metrics)]
pdt <- evf_data_clean[CJ(countries, years[1]:years[2]),]
plotlyTimeTrackPlot(copy(pdt), countries, dis_metrics, metrics, years,
                    plot_control)

The second plot is an accompanying time series slope graph for the SummaryIndex for the same countries, across the period. This will help to identify the trends in changes, and isolate interesting time periods.

plotlySlopeGraph(copy(pdt), plot_control, countries, 
                 metric = "SummaryIndex", 
                 display_metric = "Summary Index")

The final plot is a breakdown of the Summary Index; a radar plot showing the most frequent set of values for the 5 KPI variables.

rdt <- evf_data_clean[CJ(countries, years[2]),]
plotlyRadarChart(copy(rdt), all_metrics, display_metrics2, countries,
                 plot_control)

Shiny App

I’m going to use a Shiny to bring these together. I’m experimenting with a dark theme for the app, so am changing the plot_control variable.

plot_control <- list(
  palette = RColorBrewer::brewer.pal(3, "Set1"),
  font_colour = "white",
  grid_colour = "#5f606b",
  bg_colour = "#37383d",
  paper_colour = "transparent"
)

Shiny requires both a UI and Server component:

ui <- fluidPage(
  
  # Top row with information and controls
  fluidRow(
    # app information
    column(5,
           h2("Summary Index Explorer"),
           h4("Choose 2 Metrics & 1-3 Countries", 
              a("Link to original", href="https://www.fraserinstitute.org/economic-freedom/map?geozone=world&page=map&year=2007")),
           h4("Radar chart will show the metrics for the most recent Year in the slider"),
           h4("Data shown is smoothed with natural splines, with max deviation of 0.005 to the raw observation")
    ),
    # interface control for selecting countries, metrics and year range, with defaults
    column(2, 
           HTML("<br/>"),
           selectInput("countries", "Countries", all_countries, multiple = TRUE,
                       selected = c("Peru", "Argentina", "Brazil"))
    ),
    column(2,
           HTML("<br/>"),
           selectInput("dis_metrics", "Metrics", display_metrics, multiple = TRUE,
                       selected = c("Freedom To Trade Internationally", "Summary Index"))
    ),
    column(3,
           HTML("<br/>"),
           sliderInput("years", "Years", min = year_range[1],
                       max = year_range[2], 
                       value = c(year_range[1], year_range[1]+2), step = 1)
    )
  ), 
  
  # plotly outputs in second row
  fluidRow(
    column(4,
           plotlyOutput("slopePlotly", height = "255px", width = "100%"),
           plotlyOutput("radarPlotly", height = "370px", width = "100%")
    ),
    column(8,
           plotlyOutput("plotPlotly", height = "625px", width = "100%")
    )
  ),
  theme = shinytheme("darkly") # using dark theme
)


server <- function(input, output, session) {
  
  # change year slider range based on countries selected
  observe({
    if(length(input$countries) > 0){
      check <- evf_data_clean[J(input$countries), range(Year)]
      updateSliderInput(session, "years", min = check[1], max = check[2], step = 1)
    }
  })
  
  # reactive data sets based on country, years and metrics
  dt0 <- reactive({
    evf_data_clean[J(input$countries),]
  })
  dt1 <- reactive({
    dt0()[Year %in% input$years[1]:input$years[2],]
  })
  dt2 <- reactive({
    dt0()[Year == input$years[2],]
  })
  c_length <- reactive({
    length(input$countries)
  })
  m_length <- reactive({
    length(input$dis_metrics)
  })
  dt_metrics <- reactive({
    all_metrics[charmatch(input$dis_metrics, display_metrics)]
  })
  
  
  # scatter plot with yearly "snake" trail
  output$plotPlotly <- renderPlotly({
    if(m_length() == 2 & c_length() %in% 1:3){
      plotlyTimeTrackPlot(copy(dt1()), input$countries, input$dis_metrics, dt_metrics(),
                          input$years, plot_control)
    }
  })
  # time series line plot of summary index
  output$slopePlotly <- renderPlotly({
    if(c_length() %in% 1:3){
      plotlySlopeGraph(copy(dt1()), plot_control, input$countries,
                       metric = "SummaryIndex", display_metric = "Summary Index")
    }
  })
  # radar plot of most recent values for each metric
  output$radarPlotly <- renderPlotly({
    if(c_length() %in% 1:3){
      plotlyRadarChart(dt2(), all_metricsv2, display_metrics2v2, input$countries, plot_control)
    }
  })
}

Once defined, you can run this locally in the browser.

shinyApp(ui, server, options = list(height = 800, width = 1200, scrolling = "no"))

I’m not able to run this in blogdown, without storing all the data in the site. Instead I have uploaded it to shinyapps.io with the link below. I tried to embed this in this tutorial, but it didn’t scale well to the page. Here is the ShinyApp. If this doesn’t load, it either means the App is no longer active, or I’ve run out of free minutes :)