Time series charts by the Economist in R using Plotly

July 11, 2016
By

[This article was first published on R – Modern Data, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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/[email protected]/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:", trends$Date, "
", "From US:", trends$From.US, "
") hovertext2 <- paste0("Date:", trends$Date, "
", "From Britain:", trends$From.Britain, "
") 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("1", "3"), 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("2", "4"), 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("1", "2", "3", "4"), 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 = "Your home and native land?", 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 = "Google search volume for 'Move to Canada'
100 is peak volume
Note that monthly averages are used
", 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 = "George W. Bush is re-elected", 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 = "Canadian minister visits Britain, ecourages skilled workers to move", 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 = "Super tuesday: Donald Trump wins 7 out of 11 republican primaries", 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 = "Britain votes 52-48% to leave the Europen Union", 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 = "Annual immigration to Canada", 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 = "Source: 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 The economist', 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("Year: ", plot.df$Time.Period, "
", "Est.: ", round(plot.df$All.ages.estimate/1e6,2),"M
", "Lower est.: ", round(plot.df$All.ages.lower.estimate/1e6,2),"M
", "Upper est.: ", 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("Year: ", plot.df$Time.Period, "
", "Est.: ", round(plot.df$All.ages.estimate/1e6,2),"M
", "Lower est.: ", round(plot.df$All.ages.lower.estimate/1e6,2),"M
", "Upper est.: ", 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("Year:", x, "
", "Est.: ", 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 = "Keeping the pressure up
Worldwide, (in millions)
", 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 = "Source: UNAIDS", 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 = "New HIV Infections(per year)", 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 = "AIDS related deaths (per year)", 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 = "People receving Anti-
Retroviral Therapy (total)
", 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 The economist', 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 = "Lower bound", 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 = "Higher bound", 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 = "Estimate", 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)

To leave a comment for the author, please follow the link and comment on their blog: R – Modern Data.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers

Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)