chart_usa_cancer_year_asmr.r

Cancer Age-Adjusted Mortality Rate [USA]

library(readr)
library(tidyr)
library(ggplot2)
library(dplyr)
library(fable)
library(tsibble)

sf <- 2
width <- 900 * sf
height <- 450 * sf

options(vsc.dev.args = list(width = width, height = height, res = 72 * sf))

# Load population data
pop <- read_csv(
  "https://s3.mortality.watch/data/population/usa/5y.csv",
  col_types = "cccciil"
) |>
  filter(iso3c == "USA")

# Function to load datasets
load_data <- function(url) {
  read_delim(url, delim = "\t", col_types = cols(.default = "c")) |>
    as_tibble() |>
    select(`Month Code`, `Five-Year Age Groups Code`, `Deaths`) |>
    setNames(c("date", "age_group", "deaths")) |>
    mutate(
      year = as.integer(substr(date, 1, 4)),
      date = make_yearmonth(year = year, month = substr(date, 6, 7)),
      deaths = as.integer(deaths)
    )
}

# Prepare time series data
prepare_ts <- function(df1, df2) {
  rbind(df1, df2) |>
    arrange(age_group, date) |>
    mutate(
      age_group = case_when(
        age_group == "1" ~ "0-4",
        age_group == "1-4" ~ "0-4",
        age_group == "85-89" ~ "85+",
        age_group == "90-94" ~ "85+",
        age_group == "95-99" ~ "85+",
        age_group == "100+" ~ "85+",
        .default = age_group
      )
    ) |>
    group_by(year, age_group) |>
    summarize(deaths = sum(deaths), .groups = "drop") |>
    inner_join(pop, by = join_by("year", "age_group")) |>
    mutate(
      age_group = factor(age_group, levels = c(
        "0-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34",
        "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69",
        "70-74", "75-79", "80-84", "85+"
      )),
      mortality = deaths / population * 100000
    ) |>
    as_tsibble(index = year, key = age_group) |>
    filter(year >= 2017)
}

# Age Standardized Rates
source(paste0(
  "https://gist.githubusercontent.com/USMortality/",
  "cbb314e8e29b2f5b5578483504dd0d9f/raw/standard_population.r"
))

# UCOD
df1 <- load_data(
  "https://apify.mortality.watch/cdc-wonder/month-5y-ucd-neoplasm.txt"
)
df2 <- load_data(paste0(
  "https://apify.mortality.watch/cdc-wonder/",
  "provisional-month-5y-ucd-neoplasm.txt"
)) |> filter(year > max(df1$year, na.rm = TRUE))
ts <- prepare_ts(df1, df2) |> mutate(deaths = ifelse(is.na(deaths), 5, deaths))

# Age Standardized
age_groups <- ts |> filter(!age_group %in% c("all", "NS", NA))
std_pop <- get_usa2000_bins(unique(age_groups$age_group))

ts <- ts |>
  inner_join(std_pop) |>
  mutate(mortality = mortality * weight) |>
  as_tibble() |>
  group_by(year) |>
  summarize(mortality = sum(mortality, na.rm = TRUE)) |>
  ungroup() |>
  as_tsibble(index = year)

ts |>
  filter(year < 2025) |>
  ggplot(aes(x = year, y = mortality)) +
  geom_col(fill = "steelblue", color = "black", width = 0.7) +
  geom_text(aes(label = round(mortality, 1)), vjust = -0.5, size = 4) +
  labs(
    x = "Year",
    y = "Age-Adjusted Rate per 100k",
    title = "Cancer Age-Adjusted Mortality Rate [USA]",
    subtitle = "Source: CDC Wonder",
    caption = "Visualization: Your Name | Data: CDC Wonder"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold", size = 16),
    plot.subtitle = element_text(size = 12, color = "gray40"),
    plot.caption = element_text(size = 10, color = "gray50"),
    panel.grid.major.x = element_blank()
  )