My submission to Posit’s Closeread Competition

Photo by Karen Penroz on Unsplash

When I saw that Posit had posted a blog post about storytelling with Quarto (see blog post here) using Closeread I became interested in trying out Closeread for this competition. This is my first time reading about Closeread and it sparked my interest in trying to tell a story using a quarto document. For my submission, I thought I would do something silly about a topic that is serious. I wanted to show the weather differences in Los Angeles from 2003 to 2023 by creating a story of global warming while showing visualizations of the temperature differences using “temperature blankets”. If you know anything about me, the first thing you recognize is art != JP so instead I thought I would create a temperature blanket using ggplot2.

For the competition I decided to do everything in R because I knew I was going to be mess around a lot using the theme() function in ggplot2. Below is going to be a walkthough of my thought process for creating the Closeread story. Then I will probably create a Closeread specific folder within a GitHub repo or its own repo.

Retrieving the Data

I originally was going to use this site to create the year of data for my location. However, I found that the website uses an API that has an R package and a Python package. Shout out for those that made the API and the packages. This post will follow the R package.

I will be using the weather_history() function, but there are some other interesting functions for forecasting in that package as well. From the documentation, the location can either be a latitutde x longitude vector or a string of a place. Figuring that LA is well known I used that for the location and then included the dates for the year of data I am interested in. The dates must follow the format of YYYY-MM-DD and when I ran the function orignally, I realized my temperatures were in Celsius. I decided to simply add a calculation to change it to Fahrenheit. To do the calculation, I used the formula below. Since all the data matched up, I decided to bind the two dataframes and check to make sure it was correct by viewing the first and last 5 rows.

\[ F = (C * 1.8) + 32 \]

# install.packages("openmeteo")

library(tidyverse)
library(openmeteo)

la23 <- weather_history(
  location = "Los Angeles",
  start = "2023-01-01",
  end = "2023-12-31",
  daily = "temperature_2m_max"
) |>
  mutate(
    avg_temp = (daily_temperature_2m_max * 1.8) + 32
  )

`geocode()` has matched "Los Angeles" to:
Los Angeles in California, United States
Population: 3971883
Co-ordinates: c(34.05223, -118.24368)

la03 <- weather_history(
  location = "Los Angeles",
  start = "2003-01-01",
  end = "2003-12-31",
  daily = "temperature_2m_max"
) |>
  mutate(
    avg_temp = (daily_temperature_2m_max * 1.8) + 32
  )

`geocode()` has matched "Los Angeles" to:
Los Angeles in California, United States
Population: 3971883
Co-ordinates: c(34.05223, -118.24368)

temp <- rbind(la03, la23)

temp |> head()

# A tibble: 6 × 3
  date       daily_temperature_2m_max avg_temp
  <date>                        <dbl>    <dbl>
1 2003-01-01                     19.4     66.9
2 2003-01-02                     22.5     72.5
3 2003-01-03                     25.1     77.2
4 2003-01-04                     26.1     79.0
5 2003-01-05                     25.9     78.6
6 2003-01-06                     22.8     73.0

temp |> tail()

# A tibble: 6 × 3
  date       daily_temperature_2m_max avg_temp
  <date>                        <dbl>    <dbl>
1 2023-12-26                     17.9     64.2
2 2023-12-27                     17.1     62.8
3 2023-12-28                     17.3     63.1
4 2023-12-29                     17.6     63.7
5 2023-12-30                     15.3     59.5
6 2023-12-31                     15.4     59.7

Okay, everything looks okay to me. I am going to focus on the average temperature to create my temperature blankets. I also just want to point out that all temperatures will be in Farenheit. Before making my visualization, I want to break down my date category into years, months, and days. This will be easier to use facet_wrap() to separate my years.

temp <- temp |>
  mutate(date2 = date) |>
  separate(
    date2,
    into = c(
      "year", "month", "day"
    ),
    sep = "-"
  )

Now, we can focus on creating our plot. Interestingly, I have never had to make one axis on my plots be set to an amount that would range across the entirety of the axis. This was definitely one of those times where I just tried something and BAM! it worked. I set my y-axis to 1 and it worked. We will not focus on the values for the y-axis because they don’t make any sense, but I did try some other values. The value that you choose on the y-axis does not matter, especially for this visualization because we are going to remove the axis titles and text.

Temperature Blanket Creation

First Attempt

temp |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = avg_temp
    )
  ) +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  NULL

For some reason, I am not a fan of the blankets being horizontal, so I’m going to change the orientation of them.

Vertical Alignment

temp |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = avg_temp
    )
  ) +
  coord_flip() +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  NULL

We need a color scale. This will be a manual scale to try and make a cool blanket style so after some googling I found this scale project sheet. This was the easiest scale to follow (for me) and the large balls of yarn allowed me to find color codes that matched the yarn fairly well.

Some quick coding of the temperature ranges and the months should set up the template for my blanket design.

Color Scale

temp <- temp |>
  mutate(
    temp_color = case_when(
      avg_temp > 96 ~ "96+", #cherry red
      avg_temp >= 89 & avg_temp < 96 ~ "89-95", #really red
      avg_temp >= 82 & avg_temp < 89 ~ "82-88", #carrot
      avg_temp >= 75 & avg_temp < 82 ~ "75-81", #canary
      avg_temp >= 68 & avg_temp < 75 ~ "68-74", #yellow
      avg_temp >= 61 & avg_temp < 68 ~ "61-67", #green apple
      avg_temp >= 54 & avg_temp < 61 ~ "54-60", #porcelain blue
      avg_temp >= 47 & avg_temp < 54 ~ "47-53", #teal
      avg_temp >= 40 & avg_temp < 47 ~ "40-46", #alaskan blue
      avg_temp >= 33 & avg_temp < 40 ~ "33-39", #cobalt
      avg_temp >= 26 & avg_temp < 33 ~ "26-32", #thistle
      avg_temp < 26 ~ "Below 26" #purple
    ),
    month_name = case_when(
      month == "01" ~ "Jan",
      month == "02" ~ "Feb",
      month == "03" ~ "Mar",
      month == "04" ~ "Apr",
      month == "05" ~ "May",
      month == "06" ~ "Jun",
      month == "07" ~ "Jul",
      month == "08" ~ "Aug",
      month == "09" ~ "Sept",
      month == "10" ~ "Oct",
      month == "11" ~ "Nov",
      month == "12" ~ "Dec"
    ),
    across(
      c(
        temp_color,
        month_name
      ),
      ~as.factor(.x)
    ),
    temp_color = fct_relevel(
      temp_color,
      "96+",
      "89-95",
      "82-88",
      "75-81",
      "68-74",
      "61-67",
      "54-60",
      "47-53",
      "40-46",
      "33-39",
      "26-32",
      "Below 26"
    )
  ) |>
  rowid_to_column()

Blanket With New Color Scale

This is now how the full blanket for both 2003 and 2023. I still need to clean up the axis labels, the legend, and the facet titles.

temp |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = temp_color
    )
  ) +
  coord_flip() +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  scale_fill_manual(
    values = c(
      "96+" = "#D2042D",
      "89-95" = "#C41E3A",
      "82-88" = "#ED9121",
      "75-81" = "#FFFF99",
      "68-74" = "#FFD700",
      "61-67" = "#7CFC00",
      "54-60" = "#AFDBF5",
      "47-53" = "#008080",
      "40-46" = "#A2C2E0",
      "33-39" = "#0047AB",
      "26-32" = "#D8BFD8",
      "Below 26" = "#800080"
    )
  ) +
  NULL

Day One Only

I was thinking about how to show the progress of the blanket. I decided to use the dplyr::first() function, which was a first for me. Here I have the first day of the year with the temperature range values for 2003 and 2023.

temp |>
  group_by(year) |>
  mutate(
    first = first(rowid)
  ) |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = temp_color
    )
  ) +
  coord_flip() +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  labs(
    fill = ""
  ) +
  scale_fill_manual(
    values = c(
      "96+" = "#D2042D",
      "89-95" = "#C41E3A",
      "82-88" = "#ED9121",
      "75-81" = "#FFFF99",
      "68-74" = "#FFD700",
      "61-67" = "#7CFC00",
      "54-60" = "#AFDBF5",
      "47-53" = "#008080",
      "40-46" = "#A2C2E0",
      "33-39" = "#0047AB",
      "26-32" = "#D8BFD8",
      "Below 26" = "#800080"
    )
  ) +
  NULL

Prepping the Loop

Next, I decided to do a quick loop where I used two different seq() functions. The first sequence was to creatte a row for each day of the year from 1 to 365 by each day. I was able to create rows called year_row for both years. There is probably a better way of doing this but I decided on using a filter() where I looped through each day and put that each day was less than the year_row column created. For instance, in the code chunk below you can see it as filter(year_row < .x). So when the loop starts at 2 it will filter for values that are lower than 2, with the only value being 1. This will be important later on because I am not sure if I want to present a story of the weather and a creation of my blanket for every single day or if there is another metric to go by.

map(
  seq(2, 10, 1),
  ~temp |>
  select(
    rowid,
    date,
    year,
    temp_color,
    avg_temp
  ) |>
  group_by(year) |>
  mutate(
    year_row = seq(1, 365, 1)
  ) |>
  ungroup() |>
  filter(year_row < .x) |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = temp_color
    ),
    color = "white"
  ) +
  coord_flip() +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  labs(
    fill = "Temperatures"
  ) +
  scale_fill_manual(
    values = c(
      "96+" = "#D2042D",
      "89-95" = "#C41E3A",
      "82-88" = "#ED9121",
      "75-81" = "#FFFF99",
      "68-74" = "#FFD700",
      "61-67" = "#7CFC00",
      "54-60" = "#AFDBF5",
      "47-53" = "#008080",
      "40-46" = "#A2C2E0",
      "33-39" = "#0047AB",
      "26-32" = "#D8BFD8",
      "Below 26" = "#800080"
    )
  ) +
  scale_y_continuous(
    expand = c(0, 0)
  ) +
  scale_x_date(
    expand = c(0, 0)
  ) +
  theme(
    axis.text.y = element_text(color = "black"),
    axis.ticks.x = element_blank(),
    axis.text.x = element_blank(),
    axis.title = element_blank(),
    strip.background = element_rect(fill = NA),
    strip.text = element_text(size = 18),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.background = element_blank(),
    axis.line = element_line(color = "black"),
    legend.position = "bottom"
  ) +
  NULL
)

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

[[7]]

[[8]]

[[9]]

Looping Through Every 30 Days

I ended up deciding on showing my blanket every week. I’m still not sure about it since there are are 52 plots to look through. Also, now that I think about it, maybe LA was not the best place to showcase temperature for a blanket. Looking at the final blanket plot, it screams “Sorry its always nice here!” and that might not be the most interesting for a temperature blanket. I’ll have to start looking at other locations for better blanket designs. At least now I have the basic design of what I’ll do for the competition.

map(
  seq(2, 365, 30),
  ~temp |>
  select(
    rowid,
    date,
    year,
    temp_color,
    avg_temp
  ) |>
  group_by(year) |>
  mutate(
    year_row = seq(1, 365, 1)
  ) |>
  ungroup() |>
  filter(year_row < .x) |>
  ggplot(
    aes(
      date,
      1
    )
  ) +
  geom_tile(
    aes(
      fill = temp_color
    ),
    color = "white"
  ) +
  coord_flip() +
  facet_wrap(
    ~year,
    scales = "free"
  ) +
  labs(
    fill = "Temperatures"
  ) +
  scale_fill_manual(
    values = c(
      "96+" = "#D2042D",
      "89-95" = "#C41E3A",
      "82-88" = "#ED9121",
      "75-81" = "#FFFF99",
      "68-74" = "#FFD700",
      "61-67" = "#7CFC00",
      "54-60" = "#AFDBF5",
      "47-53" = "#008080",
      "40-46" = "#A2C2E0",
      "33-39" = "#0047AB",
      "26-32" = "#D8BFD8",
      "Below 26" = "#800080"
    )
  ) +
  scale_y_continuous(
    expand = c(0, 0)
  ) +
  scale_x_date(
    expand = c(0, 0)
  ) +
  theme(
    axis.text.y = element_text(color = "black"),
    axis.ticks.x = element_blank(),
    axis.text.x = element_blank(),
    axis.title = element_blank(),
    strip.background = element_rect(fill = NA),
    strip.text = element_text(size = 18),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.background = element_blank(),
    axis.line = element_line(color = "black"),
    legend.position = "bottom"
  ) +
  NULL
)

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

[[7]]

[[8]]

[[9]]

[[10]]

[[11]]

[[12]]

[[13]]