Entering the European Space Agency's 'Little Pictures of Climate' Competition (2023)

data
 • 4 Minute Read

Litte Pictures Competition

Earlier this fall, I stumbled across a fun data visualization competition called the “Little Picture” competition, advertised with this delightful call to action:

help us transform decades of satellite climate data to compelling, impactful “Little Pictures” that spark awareness and drive action

As you might guess, I couldn’t resist putting a submission! Now - I am not sure I am technically even eligible to submit an entry to the competition, as the eligibility guidelines seems to target citizens of European Union (EU) member states and European Space Agency (ESA) contributors. But… I did some work on the graphic while I was in London, so I’m just gonna send it in and see what happens??

My Little Picture

I had a hard time choosing a dataset to work with - initially, I really wanted to visualize land surface temperatures, but I was having a hard time linking the graphics I was building with a coherent and meaningful narrative.

Ultimately, I chose to visualize carbon dioxide levels around the world as a timeseries, as the trend was so incredibly consistent. Furthermore, this might be the single best metric to track with regard to our planetary climate goals - only by flattening, and eventually reducing CO2 levels, will we be able to stop the vicious cycle of global warming.

Spiraling Atmospheric CO2 Levels

Code Reference

Import Libraries

library(readr)
library(plyr)
library(tidyverse)
library(lubridate)
library(reshape2)
library(stringr)
library(tidygeocoder)
library(RColorBrewer)
library(gridExtra)
library(grid)

Acquire Monthly Global CO2 Levels Data from Github

ghg_global_monthly <- read_csv("https://raw.githubusercontent.com/littlepictures/datasets/main/ghg/ghg_xco2_monthly_global.csv")

ghg_global_monthly$month <- parse_date_time(ghg_global_monthly$month, orders = c("my"))

ghg_global_monthly <- ghg_global_monthly %>% melt(id.vars = c("month"))

Create Monthly Timeseries

ghg_plot_df <- ghg_global_monthly %>% 
  group_by(month) %>% 
  summarize(
    observations = n(),
    average = mean(value, na.rm = TRUE)
  ) %>% 
  mutate(
    year_part = year(month),
    month_part = month(month, label = TRUE, abbr = TRUE)
  ) %>% 
  filter(between(year_part, 2015, 2020))

Insert Connector Data to make Polar Plot Work

bridges <- ghg_plot_df[ghg_plot_df$month_part == "Jan",]
bridges$year_part <- bridges$year_part - 1
bridges$month_part <- NA

Define Custom Color Opacities

# Reduce the opacity of the grid lines: Default is 255
col_grid <- rgb(235, 235, 235, 20, maxColorValue = 255)

# Reduce the opacity of the background: Default is 255
col_bg <- rgb(0, 45, 82, 220, maxColorValue = 255)

Build Primary Chart

p <- rbind(ghg_plot_df, bridges) %>% 
  ggplot(aes(x = month_part, y = average, group = year_part, color = average)) + 
    geom_line(size = 2) +
    expand_limits(y = c(396, 413)) + 
    scale_x_discrete(expand = c(0,0), breaks = month.abb) + 
    annotate("text", x = "Dec", y = 398.2, label = "398.7\nppm", size = 2.5, fontface = "bold", angle = 25, color = "grey90") + 
    annotate("text", x = "Dec", y = 413, label = "412.8 ppm", size = 2.5, fontface = "bold", hjust = -0.16, angle = 25, color = "grey90") + 
    coord_polar() +
    scale_color_distiller(palette = "YlOrBr", direction = 1, name = "CO₂ PPM") +   
    theme_minimal() +
    labs(
      x = "",
      y = ""
    ) + 
    theme(
      legend.position = "none",
      axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      axis.text.x = element_text(face = "bold", size = 10, color = "grey90"),
      panel.grid = element_line(color = col_grid)
    )

Create Title and Subtitle Header

To build the fancy title header at the bottom of the chart, I needed to create a few new grob objects and then combine them with my primary graphic.

title <- grobTree(
  rectGrob(gp = gpar(fill = "#f7f1e1", lwd = 0)),
  textGrob(
    "Spiraling Atmospheric CO₂ Levels", 
    gp = gpar(col = "black", fontface = "bold", fontsize = 20), 
    hjust = 0.53
  )
)

subtitle <- grobTree(
  rectGrob(gp = gpar(fill = "#f7f1e1", lwd = 0)),
  textGrob(
    "2015 — 2020", 
    gp = gpar(col = "black", fontface = "bold", fontsize = 12), 
    hjust = 2.29
  )
)

body <- grobTree(
  rectGrob(gp = gpar(fill = "#f7f1e1", lwd = 0)),
  textGrob(
    "Humans have yet to slow the pace of carbon emissions, resulting in\n     monotonically increasing levels of atmospheric CO₂ (parts per million)",
    gp = gpar(col = "black", fontsize = 10), 
    hjust = 0.585
  )
)

caption <- grobTree(
  rectGrob(gp = gpar(fill = "#f7f1e1", lwd = 0)),
  textGrob(
    "conormclaughlin.net", 
    #"",
    gp = gpar(col = "grey60", fontsize = 7), 
    hjust = -1.9,
    vjust = -0.5
  )
)

Put Grid of Features Together

g <- grid.arrange(
  p, title, subtitle, body, caption, 
  ncol = 1,
  heights=unit(c(5.5,0.5,0.3,0.5,0.4), c("in","in","in","in", "in")),
  clip = TRUE,
  padding = 0
)

ggsave("global_ghg_levels_by_month_spiral.png", g, height = 7, width = 6, units = "in", dpi = 500, bg = col_bg)