Sudden Adult Death Syndrome (SADS) Deaths by ICD-10 Code [USA]

.chart_usa_sads.r

library(tidyverse)
library(scales)
library(tsibble)
library(fable)

sf <- 2
width <- 600 * sf
height <- 335 * sf
options(vsc.dev.args = list(width = width, height = height, res = 72 * sf))

# Read data
df <- read_csv("mcd.csv")

# Define the ICD-10 codes and their labels
sads_icd10_codes <- tibble(
  name = c(
    "Instantaneous Death",
    "Death Less Than 24 Hours",
    "Sudden Cardiac Death",
    "Unspecified Cardiac Arrhythmia",
    "Cardiac Arrest Unspecified",
    "Ventricular Fibrillation",
    "Ventricular Flutter",
    "Other Unspecified Causes"
  ),
  code = c("R960", "R961", "I461", "I499", "I469", "I4901", "I4902", "R99")
)

# UCD
ts <- df |>
  filter(ucd %in% sads_icd10_codes$code) |>
  group_by(year, ucd) |>
  summarize(n = n(), .groups = "drop") |>
  left_join(sads_icd10_codes, by = c("ucd" = "code")) |>
  as_tsibble(index = year, key = name)

# Simple 3y mean prepandemic model
model <- ts |>
  filter(year >= 2017 & year <= 2019) |>
  model(baseline_model = MEAN(n))
fc <- model |>
  forecast(h = 3) |>
  hilo(level = 95) |>
  unpack_hilo("95%")

chart1 <- ts |>
  left_join(fc, by = c("name", "year")) |>
  ggplot(aes(x = year, y = n.x)) +
  geom_line() +
  geom_ribbon(aes(ymin = `95%_lower`, ymax = `95%_upper`),
    alpha = 0.2, fill = "blue"
  ) +
  geom_hline(
    data = model |> augment(),
    aes(yintercept = .fitted), linetype = "dashed", size = 0.8
  ) +
  scale_y_continuous(labels = comma) +
  scale_x_continuous(breaks = seq(2017, 2022, by = 1)) +
  facet_wrap(vars(name), scales = "free") +
  labs(
    title =
      "Sudden Adult Death Syndrome (SADS) UCOD Deaths by ICD-10 Code [USA]",
    subtitle = "Source: CDC",
    x = "Year",
    y = "Number of Cases"
  )

# MCD
ts <- df |>
  filter(mcd %in% sads_icd10_codes$code) |>
  group_by(year, mcd) |>
  summarize(n = n(), .groups = "drop") |>
  left_join(sads_icd10_codes, by = c("mcd" = "code")) |>
  as_tsibble(index = year, key = name)

# Simple 3y mean prepandemic model
model <- ts |>
  filter(year >= 2017 & year <= 2019) |>
  model(baseline_model = MEAN(n))
fc <- model |>
  forecast(h = 3) |>
  hilo(level = 95) |>
  unpack_hilo("95%")

chart2 <- ts |>
  left_join(fc, by = c("name", "year")) |>
  ggplot(aes(x = year, y = n.x)) +
  geom_line() +
  geom_ribbon(aes(ymin = `95%_lower`, ymax = `95%_upper`),
    alpha = 0.2, fill = "blue"
  ) +
  geom_hline(
    data = model |> augment(),
    aes(yintercept = .fitted), linetype = "dashed", size = 0.8
  ) +
  scale_y_continuous(labels = comma) +
  scale_x_continuous(breaks = seq(2017, 2022, by = 1)) +
  facet_wrap(vars(name), scales = "free") +
  labs(
    title =
      "Sudden Adult Death Syndrome (SADS) MCOD Deaths by ICD-10 Code [USA]",
    subtitle = "Source: CDC",
    x = "Year",
    y = "Number of Cases"
  )

charts <- list(chart1, chart2)
for (i in seq_along(charts)) {
  ggsave(
    filename = paste0("chart", i, ".png"), plot = charts[[i]],
    width = width, height = height, units = "px", dpi = 72 * sf
  )
}