[This article was first published on

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

**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 volumeNote 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", 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 = "^{Worldwide, (in millions)}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-", 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 = "

Retroviral Therapy (total)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.