Time series charts by the Economist in R using Plotly

In this post we’ll recreate two info graphics created by The Economist. The code uses the new Plotly 4.0 syntax.

Note: Plotly 4.0 has not been officially released yet. You can download the dev version using

devtools::install_github("ropensci/plotly@fix/nse")

Volume of google searches related to immigrating to Canada

library(plotly)
library(zoo)

# Trends Data
trends <- read.csv("https://cdn.rawgit.com/plotly/datasets/master/Move%20to%20Canada.csv", check.names = F, stringsAsFactors = F)
trends.zoo <- zoo(trends[,-1], order.by = as.Date(trends[,1], format = "%d/%m/%Y"))
trends.zoo <- aggregate(trends.zoo, as.yearmon, mean)

trends <- data.frame(Date = index(trends.zoo),
                     coredata(trends.zoo))

# Immigration Data
immi <- read.csv("https://cdn.rawgit.com/plotly/datasets/master/Canada%20Immigration.csv", stringsAsFactors = F)

labels <- format(as.yearmon(trends$Date), "%Y")
labels <- as.character(sapply(labels, function(x){
  unlist(strsplit(x, "20"))[2]
}))

test <- labels[1]
for(i in 2:length(labels)){
  if(labels[i] == test) {
    labels[i] <- ""
  }else{
    test <- labels[i]
  }
}
labels[1] <- "2004"
hovertext1 <- paste0("Date:<b>", trends$Date, "</b><br>",
                     "From US:<b>", trends$From.US, "</b><br>")

hovertext2 <- paste0("Date:<b>", trends$Date, "</b><br>",
                     "From Britain:<b>", trends$From.Britain, "</b><br>")


p <- plot_ly(data = trends, x = ~Date) %>%

  # Time series chart

  add_lines(y = ~From.US, line = list(color = "#00526d", width = 4),
            hoverinfo = "text", text = hovertext1, name = "From US") %>%

  add_lines(y = ~From.Britain, line = list(color = "#de6e6e", width = 4),
            hoverinfo = "text", text = hovertext2, name = "From Britain") %>%

  add_markers(x = c(as.yearmon("2004-11-01"), as.yearmon("2016-03-01")),
              y = c(24, 44),
              marker = list(size = 15, color = "#00526d"),
              showlegend = F) %>%

  add_markers(x = c(as.yearmon("2008-07-01"), as.yearmon("2016-07-01")),
              y = c(27, 45),
              marker = list(size = 15, color = "#de6e6e"),
              showlegend = F) %>%

  # Markers for legend
  add_markers(x = c(as.yearmon("2005-01-01"), as.yearmon("2005-01-01")),
              y = c(40, 33.33),
              marker = list(size = 15, color = "#00526d"),
              showlegend = F) %>%

  add_markers(x = c(as.yearmon("2005-01-01"), as.yearmon("2005-01-01")),
              y = c(36.67, 30),
              marker = list(size = 15, color = "#de6e6e"),
              showlegend = F) %>%

  add_text(x = c(as.yearmon("2004-11-01"), as.yearmon("2016-03-01")),
           y = c(24, 44),
           text = c("<b>1</b>", "<b>3</b>"),
           textfont = list(color = "white", size = 8),
           showlegend = F) %>%

  add_text(x = c(as.yearmon("2008-07-01"), as.yearmon("2016-07-01")),
           y = c(27, 45),
           text = c("<b>2</b>", "<b>4</b>"),
           textfont = list(color = "white", size = 8),
           showlegend = F) %>%

  # Text for legend
  add_text(x = c(as.yearmon("2005-01-01"), as.yearmon("2005-01-01"), as.yearmon("2005-01-01"), as.yearmon("2005-01-01")),
           y = c(40, 36.67, 33.33, 30),
           text = c("<b>1</b>", "<b>2</b>", "<b>3</b>", "<b>4</b>"),
           textfont = list(color = "white", size = 8),
           showlegend = F) %>%

  # Bar chart
  add_bars(data = immi, x = ~Year, y = ~USA, yaxis = "y2", xaxis = "x2", showlegend = F,
           marker = list(color = "#00526d"), name = "USA") %>%

  add_bars(data = immi, x = ~Year, y = ~UK, yaxis = "y2", xaxis = "x2", showlegend = F,
           marker = list(color = "#de6e6e"), name = "UK") %>%

  layout(legend = list(x = 0.8, y = 0.36, orientation = "h", font = list(size = 10),
                       bgcolor = "transparent"),

         yaxis = list(domain = c(0.4, 0.95), side = "right", title = "", ticklen = 0,
                      gridwidth = 2),

         xaxis = list(showgrid = F, ticklen = 4, nticks = 100,
                      ticks = "outside",
                      tickmode = "array",
                      tickvals = trends$Date,
                      ticktext = labels,
                      tickangle = 0,
                      title = ""),

         yaxis2 = list(domain = c(0, 0.3), gridwidth = 2, side = "right"),
         xaxis2 = list(anchor = "free", position = 0),

         # Annotations
         annotations = list(
           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = 1, showarrow = F,
                text = "<b>Your home and native land?</b>",
                font = list(size = 18, family = "Balto")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = 0.95, showarrow = F,
                align = "left",
                text = "<b>Google search volume for <i>'Move to Canada'</i></b><br><sup>100 is peak volume<br><b>Note</b> that monthly averages are used</sup>",
                font = list(size = 13, family = "Arial")),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = as.yearmon("2005-03-01"), y = 40, showarrow = F,
                align = "left",
                text = "<b>George W. Bush is re-elected</b>",
                font = list(size = 12, family = "Arial"),
                bgcolor = "white"),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = as.yearmon("2005-03-01"), y = 36.67, showarrow = F,
                align = "left",
                text = "<b>Canadian minister visits Britain, ecourages skilled workers to move</b>",
                font = list(size = 12, family = "Arial"),
                bgcolor = "white"),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = as.yearmon("2005-03-01"), y = 33.33, showarrow = F,
                align = "left",
                text = "<b>Super tuesday: Donald Trump wins 7 out of 11 republican primaries</b>",
                font = list(size = 12, family = "Arial"),
                bgcolor = "white"),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = as.yearmon("2005-03-01"), y = 30, showarrow = F,
                align = "left",
                text = "<b>Britain votes 52-48% to leave the Europen Union</b>",
                font = list(size = 12, family = "Arial"),
                bgcolor = "white"),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = 0.3, showarrow = F,
                align = "left",
                text = "<b>Annual immigration to Canada</b>",
                font = list(size = 12, family = "Arial")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = -0.07, showarrow = F,
                align = "left",
                text = "<b>Source:</b> Google trends and national statistics",
                font = list(size = 12, family = "Arial")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0.85, y = 0.98, showarrow = F,
                align = "left",
                text = 'Inspired by <a href = "http://www.economist.com/blogs/graphicdetail/2016/07/daily-chart">The economist</a>',
                font = list(size = 12, family = "Arial"))),

         paper_bgcolor = "#f2f2f2",
         margin = list(l = 18, r = 30, t = 18),
         width = 1024,height = 600)

print(p)

AIDS related Visualization

library(plotly)
library(zoo)
library(tidyr)
library(dplyr)

# Aids Data
df <- read.csv("https://cdn.rawgit.com/plotly/datasets/master/Aids%20Data.csv", stringsAsFactors = F)

# AIDS Related Deaths ####
plot.df <- df %>%
  filter(Indicator == "AIDS-related deaths") %>%
  filter(Subgroup %in% c("All ages estimate",
                         "All ages upper estimate",
                         "All ages lower estimate"))

# Munge
plot.df <- plot.df %>%
  select(Subgroup, Time.Period, Data.Value) %>%
  spread(Subgroup, Data.Value) %>%
  data.frame()

hovertxt <- paste0("<b>Year: </b>", plot.df$Time.Period, "<br>",
                   "<b>Est.: </b>", round(plot.df$All.ages.estimate/1e6,2),"M<br>",
                   "<b>Lower est.: </b>", round(plot.df$All.ages.lower.estimate/1e6,2),"M<br>",
                   "<b>Upper est.: </b>", round(plot.df$All.ages.upper.estimate/1e6,2), "M")

# Plot
p <- plot_ly(plot.df, x = ~Time.Period, showlegend = F) %>%
  add_lines(y = ~All.ages.estimate/1e6, line = list(width = 4, color = "#1fabdd"),
            hoverinfo = "text", text = hovertxt) %>%
  add_lines(y = ~All.ages.lower.estimate/1e6, line = list(color = "#93d2ef"),
            hoverinfo = "none") %>%
  add_lines(y = ~All.ages.upper.estimate/1e6, line = list(color = "#93d2ef"),
            fill = "tonexty",
            hoverinfo = "none")

# New HIV Infections ####
plot.df <- df %>%
  filter(Indicator == "New HIV Infections") %>%
  filter(Subgroup %in% c("All ages estimate",
                         "All ages upper estimate",
                         "All ages lower estimate"))

# Munge
plot.df <- plot.df %>%
  select(Subgroup, Time.Period, Data.Value) %>%
  spread(Subgroup, Data.Value) %>%
  data.frame()

hovertxt <- paste0("<b>Year: </b>", plot.df$Time.Period, "<br>",
                   "<b>Est.: </b>", round(plot.df$All.ages.estimate/1e6,2),"M<br>",
                   "<b>Lower est.: </b>", round(plot.df$All.ages.lower.estimate/1e6,2),"M<br>",
                   "<b>Upper est.: </b>", round(plot.df$All.ages.upper.estimate/1e6,2), "M")

# Add to current plot
p <- p %>%
  add_lines(data = plot.df, y = ~All.ages.estimate/1e6, line = list(width = 4, color = "#00587b"),
            hoverinfo = "text", text = hovertxt) %>%
  add_lines(data = plot.df, y = ~All.ages.lower.estimate/1e6, line = list(color = "#3d83a3"),
            hoverinfo = "none") %>%
  add_lines(data = plot.df, y = ~All.ages.upper.estimate/1e6, line = list(color = "#3d83a3"),
            fill = "tonexty",
            hoverinfo = "none")

# People receiving ART ####
x <- c(2010:2015)
y <- c(7501470, 9134270, 10935600, 12936500, 14977200, 17023200)

hovertxt <- paste0("<b>Year:</b>", x, "<br>",
                   "<b>Est.:</b> ", round(y/1e6,2), "M")

p <- p %>%
  add_lines(x = x, y = y/1e6, line = list(width = 5, color = "#e61a20"),
            yaxis = "y2",
            hoverinfo = "text", text = hovertxt)

# Layout
p <- p %>%
  layout(xaxis = list(title = "", showgrid = F, ticklen = 4, ticks = "inside",
                      domain = c(0, 0.9)),
         yaxis = list(title = "", gridwidth = 2, domain = c(0, 0.9), range = c(-0.01, 4)),
         yaxis2 = list(overlaying = "y", side = "right", showgrid = F, color = "#e61a20",
                       range = c(5,18)),

         annotations = list(
           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = 1, showarrow = F, align = "left",
                text = "<b>Keeping the pressure up<br><sup>Worldwide, (in millions)</sup></b>",
                font = list(size = 18, family = "Arial")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0, y = -0.07, showarrow = F, align = "left",
                text = "<b>Source: UNAIDS</b>",
                font = list(size = 10, family = "Arial", color = "#bfbfbf")),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = 1995, y = 3.92, showarrow = F, align = "left",
                text = "<b>New HIV Infections(per year)</b>",
                font = list(size = 12, family = "Arial", color = "#00587b")),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = 1999, y = 1, showarrow = F, align = "left",
                text = "<b>AIDS related deaths (per year)</b>",
                font = list(size = 12, family = "Arial", color = "#1fabdd")),

           list(xref = "plot", yref = "plot", xanchor = "left", yanchor = "right",
                x = 2010, y = 3, showarrow = F, align = "left",
                text = "<b>People receving Anti-<br>Retroviral Therapy (total)</b>",
                font = list(size = 12, family = "Arial", color = "#e61a20")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "right",
                x = 0.85, y = 0.98, showarrow = F,
                align = "left",
                text = 'Inspired by <a href = "http://www.economist.com/blogs/graphicdetail/2016/05/daily-chart-23">The economist</a>',
                font = list(size = 12, family = "Arial")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "middle",
                x = 0.375, y = 0.9, showarrow = F, align = "left",
                text = "<b>Lower bound</b>",
                font = list(size = 10, family = "Arial", color = "#8c8c8c")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "middle",
                x = 0.375, y = 0.95, showarrow = F, align = "left",
                text = "<b>Higher bound</b>",
                font = list(size = 10, family = "Arial", color = "#8c8c8c")),

           list(xref = "paper", yref = "paper", xanchor = "left", yanchor = "middle",
                x = 0.485, y = 0.925, showarrow = F, align = "left",
                text = "<b>Estimate</b>",
                font = list(size = 10, family = "Arial", color = "#8c8c8c"))
         ),

         shapes = list(
           list(type = "rectangle",
                xref = "paper", yref = "paper",
                x0 = 0.45, x1 = 0.48, y0 = 0.9, y1 = 0.95,
                fillcolor = "#d9d9d9",
                line = list(width = 0)),

           list(type = "line",
                xref = "paper", yref = "paper",
                x0 = 0.45, x1 = 0.48, y0 = 0.9, y1 = 0.9,
                line = list(width = 2, color = "#8c8c8c")),

           list(type = "line",
                xref = "paper", yref = "paper",
                x0 = 0.45, x1 = 0.48, y0 = 0.95, y1 = 0.95,
                fillcolor = "#bfbfbf",
                line = list(width = 2, color = "#8c8c8c")),

           list(type = "line",
                xref = "paper", yref = "paper",
                x0 = 0.45, x1 = 0.48, y0 = 0.925, y1 = 0.925,
                fillcolor = "#bfbfbf",
                line = list(width = 2, color = "#404040"))),

         height = 600,width = 1024)

print(p)