How to Create an Economist Data Visualization of US Map Using R

Next, let’s create the legend plot that’s explains the area plot. Since it has additional information, we can’t use the previous function and we need to create a separate plot.

lp <- ggplot(filter(imp_data_df, state == "CA"), aes(x = stat_date, y = stat)) 
lp <- lp + geom_area(fill = "#559ab7") +
  scale_y_continuous(limits = c(0, 1100), expand = c(0, 0), labels = comma, position = "right") +
  scale_x_date(breaks = as.Date("2020-06-01") - months(0:4), 
               labels = rev(c("F", "M", "A", "M", "Jun")),
               expand = c(0, 0)) 
lp <- lp + geom_hline(yintercept = Inf, size = 0.3, color = '#578ca4') 

lp <- lp + theme(axis.ticks.length.x = unit(1.5, "points"),
                 axis.ticks.x = element_line(color = "#8aa6b6", size = 0.2),
                 axis.line.x = element_line(color = "#8aa6b6", size = 0.2),
                 axis.text = element_text(color = "black", size = 2.2),
                 axis.title = element_blank(),
                 panel.background = element_rect(fill = "#d5e4eb", linetype = 0),
                 panel.border = element_blank(),
                 plot.background = element_rect(
                   fill = "#d5e4eb",
                   colour = NA
                   ),
                 panel.grid = element_blank(),
                 axis.ticks.y = element_blank())

lp <- lp + geom_hline(yintercept = 500, size = 0.1, color = "white")

lp
Code language: R (r)

Next, let’s create the legend plot for the highlight color. In this case, we are creating a legend plot for pizza preference.

pizza_pref <- data.frame(y = 1,
                         x = 0,
                         label = c("Thin", "Deep"),
                         color = c('#cd6b61', '#578ca4'),
                         stringsAsFactors = FALSE)

pizza_pref_plot_fn <- function(what_type) {
  df <- filter(pizza_pref, label == what_type)
  label_color <- df$color
  
  g <- ggplot(data = df,
              aes(x = x, y = y, label = label, color = label)) +
    geom_segment(aes(xend = 1, yend = y), size = 0.3) 
  g <- g + geom_text(size = 1.5, color = label_color,
                     hjust = 0,
                     vjust = 1.5,
                     fontface = "bold") 
  g <- g + scale_color_manual(values = label_color) +
    theme_void() +
    theme(legend.position = "none")
  
  g
}

pizza_pref_plot_fn(what_type = "Deep")
Code language: R (r)

We need to create another legend for the error bar type of a plot, which shows the start, end and the easing dates.

range_bar_legend_plt <- filter(decision_dates_df, state == 'WY') %>% {
  rangebar_plot(df = .) + 
    scale_x_date(limits = c(as.Date("2020-02-01"), as.Date("2020-07-01")), date_breaks = "1 month") + 
    annotate("text", x = .$start_dt, label = "Start Date", y = 1, hjust = 1, size = 1) + 
    annotate("text", x = .$end_dt, label = "End Date", y = 1, hjust = 0, size = 1)  + 
    annotate("text", x = .$easing_dt, label = "Easing starts", y = 1, vjust = 1.2, size = 1)
}
  
range_bar_legend_plt
Code language: R (r)

Final Touches

We’re getting to the final finishing touches now.

Let’s create an empty vector for the 8 X 11 grid cells.

my_list <- rep(NA, 88)
Code language: R (r)

Then, in this vector let’s store the plots in their respective locations.

my_list[plots_tbl$boxnumber] <- plots_tbl$plots
Code language: R (r)

Place the legend in the first box.

my_list[[1]] <- lp
Code language: R (r)

And then the preference legends in the third and fourth box.

my_list[[3]] <- pizza_pref_plot_fn(what_type = "Thin")
my_list[[4]] <- pizza_pref_plot_fn(what_type = "Deep")
Code language: R (r)

Now, as a final step, place all the subplots in a grid using the plot_grid function from cowplot.

gridded_plots <- cowplot::plot_grid(plotlist = my_list, nrow = 8, ncol = 11)  
gridded_plots
Code language: R (r)

Finally, let’s add title, subtitle and captions.

title_pos <- 0.01


final_plot <- cowplot::ggdraw(gridded_plots, ylim = c(-0.05, 1.1)) +
  cowplot:: draw_plot(range_bar_legend_plt, x = .35, y = .915, width = .4, height = 0.04) +
  cowplot::draw_label("Important dates to remember", x = .48, y = 0.95,  hjust = 0, vjust = 0, size = 4) +
  cowplot::draw_label("States of play", x = title_pos, y = 1.1,  hjust = 0, vjust = 1, size = 8, fontface = "bold") +
  cowplot::draw_label("Random data. Change people's opinion using this chart", x = title_pos, y = 1.065,  hjust = 0, vjust = 1, size = 5.5) +
  cowplot::draw_label("https://www.nandeshwar.info. Generated using R", x = title_pos, y = -0.05,  hjust = 0, vjust = -1, size = 4) +
  cowplot::draw_label("Pizza preference surveyed in 2019", x = .186, y = 0.95,  hjust = 0, vjust = 0, size = 4)

Code language: R (r)

And save it using the ggsave function! And done!

ggsave(plot = final_plot,
       filename = "my_us_map_plot.png",
       width = 6,
       height = 4, 
       bg = "#E5EBF0") # changing the whole background color
Code language: R (r)

Compare it with the original plot. Pretty close! I am happy with these results, because now this script can be used for other data sets and additional graphic design would be minimal.

There you have it! A map-like plot with an individual area plot for each state, along with some additional details for each of the plots, legends and other keys.

Let me know what you think. And also, if anything is unclear, please let me know.

Video Walkthrough