My Life In Months

Many of us have recently had more time to reflect. One artifact of this reflection is My Life In Months: a chart that explains each month of your life. To me, it feels like the most meta personal dashboard available.

dashboard
Published

September 20, 2020

Code 
# devtools::install_github("hrbrmstr/waffle")
library(tidyverse)
library(glue)
library(lubridate)
library(ggtext)
library(RColorBrewer)
library(waffle)


# Colours ----

add.alpha <- function(value_colour, value_alpha = 1){
  apply(
    sapply(value_colour, col2rgb)/255, 
    2, 
    function(x) 
      rgb(
        x[1], x[2], x[3], 
        alpha = value_alpha
        )
    )  
}

# values_colour <- brewer.pal(n = 8, name = 'Accent')
values_colour <- c("#FDC086", "#F0027F", "#7FC97F", "#FFFF99", "#386CB0", "#BEAED4", "#BF5B17", "#666666")
background_colour <- 'black'


# Prep data ----

birth_year <- 1972
final_year <- birth_year + 95
birth_month <- 1
current_year <- year(today())
current_month <- month(today())

# csv downloaded from https://www.ons.gov.uk/peoplepopulationandcommunity/birthsdeathsandmarriages/lifeexpectancies/datasets/lifetablesprincipalprojectionunitedkingdom
mortality_data <- read_csv(
  "mortality - Sheet1.csv", 
  col_types = cols(`lx/l48` = col_number())
)

life_expectancy <- mortality_data %>% 
  filter(
    `lx/l48` < 50
    ) %>% 
  slice(1) %>% 
  pull(`Age x`) - 1

life_25 <- mortality_data %>% 
  filter(
    `lx/l48` < 25
  ) %>% 
  slice(1) %>% 
  pull(`Age x`) - 1

life_75 <- mortality_data %>% 
  filter(
    `lx/l48` < 75
  ) %>% 
  slice(1) %>% 
  pull(`Age x`) - 1

life_data_basic <- expand_grid(
  month = month.name,
  year = birth_year:final_year
) %>%
  mutate(month = fct_relevel(month, month.name)) %>%
  arrange(year, month) %>%
  group_by(year) %>%
  mutate(month_number = row_number()) %>%
  ungroup() %>%
  filter(!(year == birth_year & month_number < birth_month))

eras <- tibble(
  year_month = c("1972,1", "1972,2", "1990,9", "1993,6", "1994,4", "2005,10", "2020,8"),
  era = c("Blank", "childhood", "university", "temp work", "Russell job", "Watsons role", "what might remain"),
  fill_colour = values_colour[c(8, 2:7)]
  )

life_data <- life_data_basic %>%
  rowwise() %>%
  mutate(year_month = paste0(c(year, month_number), collapse = ",")) %>%
  ungroup() %>%
  left_join(eras, by = "year_month") %>%
  fill(era, fill_colour) %>%
  mutate(fill_colour = fct_inorder(fill_colour)) %>% 
  left_join(mortality_data, by = c("year" = "Year")) %>% 
  rowwise() %>% 
  mutate(
    odds_survival = ifelse(year <= current_year, 1, `lx/l48`/100),
    fill_colour_final = add.alpha(
      value_colour = fill_colour, 
      value_alpha = odds_survival
      )
    ) %>% 
  ungroup() %>% 
  rownames_to_column(var = "row_number") %>% 
  group_by(fill_colour_final) %>% 
  mutate(row_number_max = max(row_number)) %>% 
  ungroup() %>% 
  mutate(fill_colour_final = as_factor(fill_colour_final)) %>% 
  select(month, year, row_number_max, era, fill_colour, odds_survival, fill_colour_final)

# Base plot ----

html_text <- glue(
  "<b  style = 'font-size:10pt; color:white;'>My life in months</b>", 
  "<br>",
  "<span style = 'font-size:8pt; color:white;'>",
  "Showing ",
  "<strong style='color:{eras$fill_colour[2]}'>{eras$era[2]}</strong> ",
  "<strong style='color:{eras$fill_colour[3]}'>{eras$era[3]}</strong> ",
  "<strong style='color:{eras$fill_colour[4]}'>{eras$era[4]}</strong> ",
  "<strong style='color:{eras$fill_colour[5]}'>{eras$era[5]}</strong> ",
  "<strong style='color:{eras$fill_colour[6]}'>{eras$era[6]}</strong> and ",
  "<strong style='color:{eras$fill_colour[7]}'>{eras$era[7]}</strong> for @p0bs",
  "</span>"
)

life_in_months_base <- life_data %>%
  count(fill_colour_final, sort = FALSE) %>% 
  ggplot(aes(fill = fill_colour_final, values = n)) +
  geom_waffle(color = background_colour, n_rows = 12, linewidth = 1, flip = FALSE) + 
  coord_equal() + 
  geom_segment(aes(x = life_25 + 1, xend = life_25 + 1, y = -0, yend = 13), linetype = 3, size = 0.5, color = '#DDDDDD') +
  geom_segment(aes(x = life_75 + 1, xend = life_75 + 1, y = -0, yend = 13), linetype = 3, size = 0.5, color = '#DDDDDD') +
  geom_segment(aes(x = life_expectancy + 1, xend = life_expectancy + 1, y = -0, yend = 13), linetype = 3, size = 0.5, color = '#DDDDDD') +
  scale_x_continuous(limits = c(-0.5, 97.5)) + 
  scale_y_continuous(limits = c(-4, 16)) +
  scale_fill_identity() +
  labs(y = NULL, x = NULL, title = html_text) + 
  theme_void() +
  theme(
    legend.position = "none",
    plot.title.position = "panel",
    plot.background = element_rect(fill = background_colour, color = background_colour),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    plot.title = element_textbox_simple(
      fill = 'black', 
      padding = margin(5.5, 5.5, 5.5, 5.5),
      margin = margin(5.5, 5.5, 5.5, 5.5), 
      box.colour = background_colour,
      linetype = 1,
      r = grid::unit(8, "pt")
      )
  )

# Initial annotations ----

annotation_base_size <- 3
annotation_lineheight <- 1
initial_annotations_colour <- values_colour[1]

initial_text <- function(x, y, label, size = annotation_base_size, colour = initial_annotations_colour, ...) {
  annotate("text", x = x, y = y, label = label, size = size, colour = colour, ...)
}

initial_segment <- function(x, xend, y, yend, colour = initial_annotations_colour) {
  geom_segment(aes(x = x, xend = xend, y = y, yend = yend), colour = colour)
}

life_in_months_initial_annotations <- life_in_months_base +
  initial_text(x = 0, y = 6.5, label = "1 year", angle = 0, size = annotation_base_size * 0.8, hjust = 1) +
  initial_segment(x = 0, xend = 0, y = 1, yend = 5) +
  initial_segment(x = -0.25, xend = 0.25, y = 1, yend = 1) +
  initial_segment(x = 0, xend = 0, y = 8, yend = 12) +
  initial_segment(x = -0.25, xend = 0.25, y = 12, yend = 12) +
  initial_text(x = 1, y = 14.5, label = "1 square = 1 month", size = annotation_base_size * 0.8, lineheight = annotation_lineheight, hjust = 0.4) +
  geom_segment(aes(x = 5, xend = 5, y = 13.5, yend = 12), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) +
  initial_text(x = 16, y = -2, label = "Years", size = annotation_base_size * 0.8, hjust = 0) +
  geom_segment(aes(x = 20.5, xend = 22.5, y = -2.2, yend = -2.2), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = 47.6, y = -2, label = "2020", size = annotation_base_size * 0.8, hjust = 0, lineheight = annotation_lineheight) +
  geom_segment(aes(x = 49, xend = 49, y = -1.2, yend = 0.2), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = 0, y = -2, label = "Born (Feb 1972)", size = annotation_base_size * 0.8, hjust = 0, lineheight = annotation_lineheight) +
  geom_segment(aes(x = 1, xend = 1, y = -1.2, yend = 1.8), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = 21.6, y = 14.5, label = "Mr & Mrs", size = annotation_base_size * 0.8, lineheight = annotation_lineheight, hjust = 0) +
  geom_segment(aes(x = 25, xend = 25, y = 13.5, yend = 12), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = 35.6, y = 14.5, label = "Parenthood", size = annotation_base_size * 0.8, lineheight = annotation_lineheight, hjust = 0) +
  geom_segment(aes(x = 39, xend = 39, y = 13.5, yend = 8), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) +
  initial_text(x = 29.4, y = 14.6, label = "Seattle", size = annotation_base_size * 0.8, lineheight = annotation_lineheight, hjust = 0) +
  geom_segment(aes(x = 30, xend = 31, y = 13, yend = 13), colour = initial_annotations_colour) +
  geom_segment(aes(x = 32, xend = 33, y = 13, yend = 13), colour = initial_annotations_colour) +
  initial_segment(x = 30, xend = 30, y = 12.5, yend = 13.5, colour = initial_annotations_colour) +
  initial_segment(x = 33, xend = 33, y = 12.5, yend = 13.5, colour = initial_annotations_colour) +  
  initial_text(x = 79.5, y = 14.5, label = "Will I still be alive?", size = annotation_base_size * 0.8, lineheight = annotation_lineheight, hjust = 0) +
  geom_segment(aes(x = 79, xend = 78, y = 14.1, yend = 14.1), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  geom_segment(aes(x = 93, xend = 94, y = 14.1, yend = 14.1), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) +
  initial_text(x = life_25 -1, y = -2, label = "1 in 4 chance", size = annotation_base_size * 0.8, hjust = 0, lineheight = annotation_lineheight) +
  geom_segment(aes(x = life_25 + 1, xend = life_25 + 1, y = -1.2, yend = 0.2), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = life_expectancy - 4.5, y = -2, label = "1 in 2 chance", size = annotation_base_size * 0.8, hjust = 0, lineheight = annotation_lineheight) +
  geom_segment(aes(x = life_expectancy + 1, xend = life_expectancy + 1, y = -1.2, yend = 0.2), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour) + 
  initial_text(x = life_75 -5.9, y = -2, label = "3 in 4 chance", size = annotation_base_size * 0.8, hjust = 0, lineheight = annotation_lineheight) +
  geom_segment(aes(x = life_75 + 1, xend = life_75 + 1, y = -1.2, yend = 0.2), arrow = arrow(length = unit(0.0175, "npc")), colour = initial_annotations_colour)

life_in_months_initial_annotations

You can see my version of the chart above.

This work is inspired by (and benefits from) similar analysis by Sharla Gelfand and Isabella Benabaye. As Isabella says, this type of chart can really provide perspective.

That said, the amount of available months in these previous charts seems almost endless. As this is sadly not going to be the case, I also reflect the likelihood of my demise, by making the ‘what might remain’ colour fade over time at a given rate, corresponding with my likelihood of still being alive at that point1.

Whilst that’s clearly morbid, using this data makes for a better personal dashboard!

Footnotes

  1. To do this, I reflect my Britishness and use the actuarial projections from the Office of National Statistics. Specifically, they provide cohort mortality for a 48 year-old British man that is living in 2020. (I use cohort mortality so as to reflect projected mortality improvements, but didn’t over-egg it to include health or postcode details.)↩︎