Shortlisted TUS 2024 Graphs

1 Average Sleep Over the Ages

This chart shows how our average sleep duration changes as we age. Notice the decline during adolescence, followed by a more gradual change throughout adulthood.

sleep_vs_age_plot <- timeuse_df %>%
  filter(activity == "Sleep", age < 90, age >= 6) %>%
  group_by(person_id, age, mult) %>%
  summarise(total_sleep_mins = sum(duration_mins, na.rm = TRUE),
            .groups = 'drop') %>%
  group_by(age) %>%
  summarise(avg_sleep_weighted_mins = weighted.mean(total_sleep_mins, w = mult, na.rm = TRUE)) %>%
  mutate(avg_sleep_hours = avg_sleep_weighted_mins / 60) %>%
  ggplot(aes(x = age, y = avg_sleep_hours)) +
  geom_smooth(
    method = "loess",
    se = TRUE,
    color = "black",
    fill = "gray80",
    linewidth = 0.8
  ) +
  scale_y_continuous(limits = c(0, 12), breaks = seq(0, 12, by = 2)) +
  scale_x_continuous(breaks = seq(10, 90, by = 20), limits = c(6, 95)) +
  labs(
    title = "Average daily sleep across ages",
    x = "Age (years)",
    y = "Sleep (hours/day)",
    caption = "Source: National Time Use Survey 2024"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "ath", size = 9),
    plot.title = element_text(
      family = "ath",
      face = "bold",
      size = 10,
      margin = margin(b = 8)
    ),
    plot.caption = element_text(
      family = "ath",
      size = 7,
      color = "gray50",
      hjust = 0
    ),
    axis.title = element_text(family = "ath", size = 9),
    axis.text = element_text(size = 8),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "gray90", linewidth = 0.3),
    plot.margin = margin(10, 10, 10, 10)
  )

sleep_vs_age_plot

## `geom_smooth()` using formula = 'y ~ x'

# --- Essential Sleep Only ---

night_sleep_vs_age_plot <- timeuse_df %>%
  filter(activity_code == "Night sleep/essential sleep", age < 90, age >= 6) %>%
  group_by(person_id, age, mult) %>%
  summarise(total_sleep_mins = sum(duration_mins, na.rm = TRUE),
            .groups = 'drop') %>%
  group_by(age) %>%
  summarise(avg_sleep_weighted_mins = weighted.mean(total_sleep_mins, w = mult, na.rm = TRUE)) %>%
  mutate(avg_sleep_hours = avg_sleep_weighted_mins / 60) %>%
  ggplot(aes(x = age, y = avg_sleep_hours)) +
  geom_smooth(
    method = "loess",
    se = TRUE,
    color = "navy",
    fill = "lightblue",
    linewidth = 0.8
  ) +
  scale_y_continuous(limits = c(0, 12), breaks = seq(0, 12, by = 2)) +
  scale_x_continuous(breaks = seq(10, 90, by = 20), limits = c(6, 95)) +
  labs(
    title = "Night sleep across ages",
    x = "Age (years)",
    y = "Sleep (hours/day)",
    caption = "Source: National Time Use Survey 2024"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "ath", size = 9),
    plot.title = element_text(
      family = "ath",
      face = "bold",
      size = 12,
      margin = margin(b = 8)
    ),
    plot.caption = element_text(
      family = "ath",
      size = 7,
      color = "gray50",
      hjust = 0
    ),
    axis.title = element_text(family = "ath", size = 9),
    axis.text = element_text(size = 10),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "gray90", linewidth = 0.3),
    plot.margin = margin(10, 10, 10, 10)
  )

night_sleep_vs_age_plot

## `geom_smooth()` using formula = 'y ~ x'

2 A Day in the Life Across Age Groups

high_level_summary <- timeuse_df %>%
  filter(!is.na(activity) & activity != "Unclassified") %>%
  mutate(
    activity_group = case_when(
      activity == "Sleep" ~ "Sleep",
      activity %in% c("Eating & Drinking", "Personal Hygiene & Health", "Receiving Care") ~ "Personal Care",
      activity %in% c(
        "Formal Employment",
        "Household Enterprise (Goods)",
        "Household Enterprise (Services)",
        "Work-Related Training",
        "Seeking Employment",
        "Setting up a Business"
      ) ~ "Paid Work",
      activity %in% c(
        "Food & Meal Management",
        "Cleaning & Maintenance",
        "Childcare & Instruction",
        "Shopping",
        "Agriculture & Fishing (Own-Use)",
        "Community Volunteering",
        "Direct Volunteering"
      ) ~ "Unpaid Work & Care",
      activity %in% c("Formal Education", "Homework", "Additional Study") ~ "Learning",
      TRUE ~ "Leisure, Social & Travel"
    )
  )

person_activity_group_summary <- high_level_summary %>%
  group_by(person_id, activity_group) %>%
  summarise(total_duration = sum(duration_mins, na.rm = TRUE),
            .groups = "drop")

stacking_order <- c(
  "Sleep",
  "Personal Care",
  "Paid Work",
  "Unpaid Work & Care",
  "Learning",
  "Leisure, Social & Travel"
)

# Summary for Total Population
all_persons_age_group <- high_level_summary %>%
  mutate(age_group = cut(
    age,
    breaks = c(5, 14, 24, 59, Inf),
    labels = c(
      "Children\n(6-14)",
      "Youth\n(15-24)",
      "Adults\n(25-59)",
      "Elderly\n(60+)"
    ),
    right = TRUE,
    include.lowest = TRUE
  )) %>%
  filter(!is.na(age_group)) %>%
  distinct(person_id, age_group, mult)

age_group_summary_total <- all_persons_age_group %>%
  tidyr::crossing(activity_group = unique(person_activity_group_summary$activity_group)) %>%
  left_join(person_activity_group_summary,
            by = c("person_id", "activity_group")) %>%
  mutate(total_duration = ifelse(is.na(total_duration), 0, total_duration)) %>%
  group_by(age_group, activity_group) %>%
  summarise(avg_hours = weighted.mean(total_duration, w = mult, na.rm = TRUE) / 60,
            .groups = "drop") %>%
  mutate(activity_group = factor(activity_group, levels = stacking_order))

# Summary by Gender
all_persons_age_gender_group <- high_level_summary %>%
  filter(gender %in% c("male", "female")) %>%
  mutate(age_group = cut(
    age,
    breaks = c(5, 14, 24, 59, Inf),
    labels = c(
      "Children\n(6-14)",
      "Youth\n(15-24)",
      "Adults\n(25-59)",
      "Elderly\n(60+)"
    ),
    right = TRUE,
    include.lowest = TRUE
  )) %>%
  filter(!is.na(age_group)) %>%
  distinct(person_id, age_group, gender, mult)

age_gender_group_summary <- all_persons_age_gender_group %>%
  tidyr::crossing(activity_group = unique(person_activity_group_summary$activity_group)) %>%
  left_join(person_activity_group_summary,
            by = c("person_id", "activity_group")) %>%
  mutate(total_duration = ifelse(is.na(total_duration), 0, total_duration)) %>%
  group_by(age_group, gender, activity_group) %>%
  summarise(avg_hours = weighted.mean(total_duration, w = mult, na.rm = TRUE) / 60,
            .groups = "drop") %>%
  mutate(activity_group = factor(activity_group, levels = stacking_order))

# Summary by Sector
all_persons_age_sector_group <- high_level_summary %>%
  mutate(age_group = cut(
    age,
    breaks = c(5, 14, 24, 59, Inf),
    labels = c(
      "Children\n(6-14)",
      "Youth\n(15-24)",
      "Adults\n(25-59)",
      "Elderly\n(60+)"
    ),
    right = TRUE,
    include.lowest = TRUE
  )) %>%
  filter(!is.na(age_group)) %>%
  distinct(person_id, age_group, sector, mult)

age_sector_group_summary <- all_persons_age_sector_group %>%
  tidyr::crossing(activity_group = unique(person_activity_group_summary$activity_group)) %>%
  left_join(person_activity_group_summary,
            by = c("person_id", "activity_group")) %>%
  mutate(total_duration = ifelse(is.na(total_duration), 0, total_duration)) %>%
  group_by(age_group, sector, activity_group) %>%
  summarise(avg_hours = weighted.mean(total_duration, w = mult, na.rm = TRUE) / 60,
            .groups = "drop") %>%
  mutate(activity_group = factor(activity_group, levels = stacking_order))



# 1. Define consistent colors and a reusable plotting function
activity_colors <- c(
  "Sleep" = "#1B9E77",
  "Personal Care" = "#D95F02",
  "Paid Work" = "#7570B3",
  "Unpaid Work & Care" = "#E7298A",
  "Learning" = "#666666",
  "Leisure, Social & Travel" = "#E6AB02"
)

create_age_strips_plot <- function(data, x_var = "age_group", main_title) {
  ggplot(data, aes(x = .data[[x_var]], y = avg_hours, fill = activity_group)) +
    geom_col(position = "fill", colour = "white", linewidth = 0.2) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    scale_fill_manual(values = activity_colors, name = "") +
    labs(
      title = main_title,
      x = NULL,
      y = "% of day",
      caption = "Source: National Time Use Survey 2024"
    ) +
    theme_minimal() +
    theme(
      text = element_text(family = "ath", size = 8),
      plot.title = element_text(
        family = "ath",
        face = "bold",
        size = 12,
        margin = margin(b = 8)
      ),
      plot.caption = element_text(
        family = "ath",
        size = 7,
        color = "gray50",
        hjust = 0
      ),
      legend.position = "bottom",
      legend.text = element_text(size = 9),
      legend.key.size = unit(0.3, "cm"),
      axis.text = element_text(size = 8),
      axis.text.x = element_text(lineheight = 0.4),
      panel.grid = element_blank(),
      plot.margin = margin(10, 10, 10, 10)
    ) +
    guides(fill = guide_legend(nrow = 2, byrow = TRUE))
}

# 2. Generate the individual plots using the function
age_strips_plot_total <- create_age_strips_plot(
  data = age_group_summary_total, 
  main_title = "Time use by age group"
)

age_strips_plot_male <- create_age_strips_plot(
  data = age_gender_group_summary %>% filter(gender == "male"),
  main_title = "Time use by age: Men"
)

age_strips_plot_female <- create_age_strips_plot(
  data = age_gender_group_summary %>% filter(gender == "female"),
  main_title = "Time use by age: Women"
)

age_strips_plot_rural <- create_age_strips_plot(
  data = age_sector_group_summary %>% filter(sector == "Rural"),
  main_title = "Time use by age: Rural"
)

age_strips_plot_urban <- create_age_strips_plot(
  data = age_sector_group_summary %>% filter(sector == "Urban"),
  main_title = "Time use by age: Urban"
)


# 3. Generate the combined plot (it's different due to faceting)
combined_gender_strips_plot <- age_gender_group_summary %>%
  mutate(gender = str_to_title(gender)) %>%
  ggplot(aes(x = gender, y = avg_hours, fill = activity_group)) +
  geom_col(
    position = "fill",
    width = 0.8,
    color = "white",
    linewidth = 0.2
  ) +
  facet_wrap( ~ age_group, nrow = 1) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_fill_manual(values = activity_colors, name = "") +
  labs(
    title = "Time use by gender and age",
    x = NULL,
    y = "% of day",
    caption = "Source: National Time Use Survey 2024"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "ath", size = 8),
    plot.title = element_text(
      family = "ath",
      face = "bold",
      size = 10,
      margin = margin(b = 8)
    ),
    plot.caption = element_text(
      family = "ath",
      size = 7,
      color = "gray50",
      hjust = 0
    ),
    legend.position = "bottom",
    legend.text = element_text(size = 7),
    legend.key.size = unit(0.3, "cm"),
    strip.text = element_text(face = "bold", size = 8, lineheight = 0.4),
    axis.text = element_text(size = 7),
    panel.grid = element_blank(),
    panel.spacing = unit(0.3, "lines"),
    plot.margin = margin(10, 10, 10, 10)
  ) +
  guides(fill = guide_legend(nrow = 2, byrow = TRUE))

age_strips_plot_rural

age_strips_plot_urban

age_strips_plot_total

age_strips_plot_male

age_strips_plot_female

combined_gender_strips_plot

2.1 Rural vs. Urban Comparison

all_persons_age_gender_sector_group <- high_level_summary %>%
  filter(gender %in% c("male", "female")) %>%
  mutate(age_group = cut(
    age,
    breaks = c(5, 14, 24, 59, Inf),
    labels = c(
      "Children\n(6-14)",
      "Youth\n(15-24)",
      "Adults\n(25-59)",
      "Elderly\n(60+)"
    ),
    right = TRUE,
    include.lowest = TRUE
  )) %>%
  filter(!is.na(age_group)) %>%
  distinct(person_id, age_group, gender, sector, mult)

age_gender_sector_group_summary <- all_persons_age_gender_sector_group %>%
  tidyr::crossing(activity_group = unique(person_activity_group_summary$activity_group)) %>%
  left_join(person_activity_group_summary,
            by = c("person_id", "activity_group")) %>%
  mutate(total_duration = ifelse(is.na(total_duration), 0, total_duration)) %>%
  group_by(age_group, gender, sector, activity_group) %>%
  summarise(avg_hours = weighted.mean(total_duration, w = mult, na.rm = TRUE) / 60,
            .groups = "drop") %>%
  mutate(activity_group = factor(activity_group, levels = stacking_order))


male_sector_strips_plot <- age_gender_sector_group_summary %>%
  filter(gender == "male") %>%
  ggplot(aes(x = sector, y = avg_hours, fill = activity_group)) +
  geom_col(
    position = "fill",
    width = 0.8,
    color = "white",
    linewidth = 0.2
  ) +
  facet_wrap( ~ age_group, nrow = 1) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_fill_manual(values = activity_colors, name = "") +
  labs(
    title = "Men: Time use by location and age",
    x = NULL,
    y = "% of day",
    caption = "Source: National Time Use Survey 2024"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "ath", size = 8),
    plot.title = element_text(
      family = "ath",
      face = "bold",
      size = 10,
      margin = margin(b = 8)
    ),
    plot.caption = element_text(
      family = "ath",
      size = 7,
      color = "gray50",
      hjust = 0
    ),
    legend.position = "bottom",
    legend.text = element_text(size = 7),
    legend.key.size = unit(0.3, "cm"),
    strip.text = element_text(face = "bold", size = 8, lineheight = 0.4),
    axis.text = element_text(size = 7),
    panel.grid = element_blank(),
    panel.spacing = unit(0.3, "lines"),
    plot.margin = margin(10, 10, 10, 10)
  ) +
  guides(fill = guide_legend(nrow = 2, byrow = TRUE))

female_sector_strips_plot <- age_gender_sector_group_summary %>%
  filter(gender == "female") %>%
  ggplot(aes(x = sector, y = avg_hours, fill = activity_group)) +
  geom_col(
    position = "fill",
    width = 0.8,
    color = "white",
    linewidth = 0.2
  ) +
  facet_wrap( ~ age_group, nrow = 1) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_fill_manual(values = activity_colors, name = "") +
  labs(
    title = "Women: Time use by location and age",
    x = NULL,
    y = "% of day",
    caption = "Source: National Time Use Survey 2024"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "ath", size = 8),
    plot.title = element_text(
      family = "ath",
      face = "bold",
      size = 10,
      margin = margin(b = 8)
    ),
    plot.caption = element_text(
      family = "ath",
      size = 7,
      color = "gray50",
      hjust = 0
    ),
    legend.position = "bottom",
    legend.text = element_text(size = 7),
    legend.key.size = unit(0.3, "cm"),
    strip.text = element_text(face = "bold", size = 8, lineheight = 0.4),
    axis.text = element_text(size = 7),
    panel.grid = element_blank(),
    panel.spacing = unit(0.3, "lines"),
    plot.margin = margin(10, 10, 10, 10)
  ) +
  guides(fill = guide_legend(nrow = 2, byrow = TRUE))

male_sector_strips_plot

female_sector_strips_plot

3 Exports and Download

dir.create("shortlisted_textbook", showWarnings = FALSE)

export_theme <- theme(
  plot.title = element_text(size = 20, face = "bold"),
  plot.subtitle = element_text(size = 16),
  plot.caption = element_text(size = 11),
  axis.title = element_text(size = 14),
  axis.text = element_text(size = 14),
  legend.text = element_text(size = 14),
  legend.title = element_text(size = 14),
  strip.text = element_text(size = 14, face = "bold"),
  legend.key.size = unit(0.4, "cm")
)

# 1. Sleep plots - compact single-column width (4" x 3.5")
ggsave(filename = "shortlisted_textbook/01_sleep_vs_age.png",
       plot = sleep_vs_age_plot + export_theme,
       width = 2, height = 2, dpi = 300, units = "in")

## `geom_smooth()` using formula = 'y ~ x'

ggsave(filename = "shortlisted_textbook/02_essential_sleep_vs_age.png",
       plot = night_sleep_vs_age_plot + export_theme,
       width = 2, height = 2, dpi = 300, units = "in")

## `geom_smooth()` using formula = 'y ~ x'

# 2. Simple strip plots - slightly wider (5" x 4")
ggsave(filename = "shortlisted_textbook/03_age_strips_total.png",
       plot = age_strips_plot_total + export_theme,
       width = 3, height = 3, dpi = 300, units = "in")

ggsave(filename = "shortlisted_textbook/04_age_strips_rural.png",
       plot = age_strips_plot_rural + export_theme,
       width = 3, height = 3, dpi = 300, units = "in")

ggsave(filename = "shortlisted_textbook/05_age_strips_urban.png",
       plot = age_strips_plot_urban + export_theme,
       width = 3, height = 3, dpi = 300, units = "in")

# 3. Gender-specific plots (5" x 4")
ggsave(filename = "shortlisted_textbook/06_age_strips_male.png",
       plot = age_strips_plot_male + export_theme,
       width = 3, height = 3, dpi = 300, units = "in")

ggsave(filename = "shortlisted_textbook/07_age_strips_female.png",
       plot = age_strips_plot_female + export_theme,
       width = 3, height = 3, dpi = 300, units = "in")

# 4. Faceted plots - wider for readability (6.5" x 4")
ggsave(filename = "shortlisted_textbook/08_combined_gender_strips.png",
       plot = combined_gender_strips_plot + export_theme,
       width = 4, height = 3, dpi = 300, units = "in")

ggsave(filename = "shortlisted_textbook/09_male_sector_strips.png",
       plot = male_sector_strips_plot + export_theme,
       width = 4, height = 3, dpi = 300, units = "in")

ggsave(filename = "shortlisted_textbook/10_female_sector_strips.png",
       plot = female_sector_strips_plot + export_theme,
       width = 4, height = 3, dpi = 300, units = "in")

zip_file <- "time_use_textbook_bundle.zip"
files_to_zip <- c(
  list.files("shortlisted_textbook", full.names = TRUE, pattern = "\\.png$"),
  "shortlisted-tus-2024.Rmd"
)

if (file.exists(zip_file)) file.remove(zip_file)
zip::zip(zipfile = zip_file, files = files_to_zip, mode = "cherry-pick")

download_file(
  path = zip_file,
  output_name = "Download Textbook Bundle (ZIP)",
  button_label = "Download Bundle",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-download",
  self_contained = TRUE
)

Download Bundle