knitr::opts_chunk$set(echo = TRUE)
The raw annual risk of death is calculated by the proportion of people in each age, sex, ethnicity group who die each year (with those who emigrate being censored, of course). Separate survivorship curve for each year of birth, as life expectancy changes over time. There is sex differences; ethnicity doesn't make much of a difference.
ETHPOP is based on ONS data in what year?
library(readr) library(purrr) library(dplyr) library(ggplot2) library(scales) library(reshape2) library(survivorETHPOP)
We want to compare between the ONS mortality statistics and ETHPOP. From here it details their method. They calculate a central rate of mortality as the average across 3 years. $$ m_x = \sum_{y1,y2,y3} deaths_i/ \sum_{y1,y2,y3} pop_i $$
Finally, they calculate the mortality rate which is what we will be using to compare and is equivalent to the hazard. $$ q_x = 2 m_x/(2 + m_x) $$
ETHPOP_lifetable <- make_ETHPOP_lifetable() # save(ETHPOP_lifetable, file = here::here("data", "ETHPOP_lifetable.RData")) head(ETHPOP_lifetable) ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "WHO", year = 2011)) %>% haz_plot() ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "WHO", year = 2049)) %>% haz_plot(add = TRUE) ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "WHO", year = 2011)) %>% haz_plot() for (i in 2012:2043) { ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "WHO", year = i)) %>% haz_plot(add = TRUE) } par(mfrow=c(1,2)) dat <- ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "BAN", year = 2011)) %>% haz_plot() %>% surv_plot()
ethnic_grps <- c("BAN", "BLA", "BLC", "CHI", "IND", "MIX", "OAS", "OBL", "OTH", "PAK", "WBI", "WHO") ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = "BAN", year = 2011)) %>% haz_plot() for (i in ethnic_grps) { ETHPOP_lifetable %>% survivor_curve(group = list(sex = "M", ETH.group = i, year = 2011)) %>% haz_plot(add = TRUE) }
baseyr_2011 <- ETHPOP_lifetable$id[ETHPOP_lifetable$yr_age == "2011_0"][1] ETHPOP_lifetable_2011M <- ETHPOP_lifetable %>% filter(id == baseyr_2011, sex == "M") ETHPOP_lifetable_2011F <- ETHPOP_lifetable %>% filter(id == baseyr_2011, sex == "F")
## ggplot ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + # scale_y_continuous(trans='log2') + coord_trans(y = "log10") + theme_bw() ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = qx, colour = ETH.group)) + geom_line() + # scale_y_continuous(trans='log2') + coord_trans(y = "log10") + theme_bw() ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = qx, colour = ETH.group)) + geom_line() + # scale_y_continuous(trans='log2') + theme_bw() ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = S, colour = ETH.group)) + geom_line() + theme_bw()
Read in and check.
lifetables <- read_lifetables() # save(lifetables, file = here::here("data", "lifetables.RData")) ONS_lifetables <- do.call(rbind, lifetables) %>% mutate(new_yr = year < dplyr::lag(year, default = Inf), id = cumsum(new_yr)) %>% group_by(id) %>% mutate(baseyr = min(year)) %>% ungroup() %>% select(-id, -new_yr) %>% mutate(baseyr = as.factor(baseyr))
par(mfrow= c(2,3)) for (i in seq_along(lifetables)) { plot(x = lifetables[[i]]$year[lifetables[[i]]$sex == "M"], y = lifetables[[i]]$qx[lifetables[[i]]$sex == "M"], log = "y", type = "l", main = names(lifetables)[i], ylab = "h", xlab = "year") lines(x = lifetables[[i]]$year[lifetables[[i]]$sex == "F"], y = lifetables[[i]]$qx[lifetables[[i]]$sex == "F"], log = "y", type = "l", col = "red") } par(mfrow= c(1,2)) for (j in c("M","F")) { plot(x = lifetables[[1]]$age[lifetables[[1]]$sex == j], y = lifetables[[1]]$qx[lifetables[[1]]$sex == j], log = "y", type = "l", main = j, ylab = "h", xlab = "age") for (i in seq_along(lifetables)) { lines(x = lifetables[[i]]$age[lifetables[[i]]$sex == j], y = lifetables[[i]]$qx[lifetables[[i]]$sex == j], log = "y", type = "l", col = i) } }
ggplot(ONS_lifetables, aes(x = age, y = qx, colour = interaction(sex, baseyr))) + geom_line() + # scale_y_continuous(trans='log2') + coord_trans(y = "log10") + theme_bw()
2011
ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + coord_trans(y = "log10") + ggtitle("Male 2011") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2011 & ONS_lifetables$sex == "M", ], colour = "black") ggplot(ETHPOP_lifetable_2011F, aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Female 2011") + coord_trans(y = "log10") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2011 & ONS_lifetables$sex == "F", ], colour = "black")
ggplot(ETHPOP_lifetable_2011M, aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Male 2011") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2011 & ONS_lifetables$sex == "M", ], colour = "black") + ylim(0, 0.003) + xlim(0, 60) ggplot(ETHPOP_lifetable_2011F, aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Female 2011") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2011 & ONS_lifetables$sex == "F", ], colour = "black") + ylim(0, 0.003) + xlim(0, 60)
2030
baseyr_2030 <- ETHPOP_lifetable$id[ETHPOP_lifetable$yr_age == "2030_0"][1] ETHPOP_lifetable[ETHPOP_lifetable$id == baseyr_2030 & ETHPOP_lifetable$sex == "M", ] %>% ggplot(aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + coord_trans(y = "log10") + ggtitle("Male 2030") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2030 & ONS_lifetables$sex == "M", ], colour = "black") ETHPOP_lifetable[ETHPOP_lifetable$id == baseyr_2030 & ETHPOP_lifetable$sex == "F", ] %>% ggplot(aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Female 2030") + coord_trans(y = "log10") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2030 & ONS_lifetables$sex == "F", ], colour = "black")
baseyr_2030 <- ETHPOP_lifetable$id[ETHPOP_lifetable$yr_age == "2030_0"][1] ETHPOP_lifetable[ETHPOP_lifetable$id == baseyr_2030 & ETHPOP_lifetable$sex == "M", ] %>% ggplot(aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Male 2030") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2030 & ONS_lifetables$sex == "M", ], colour = "black") + ylim(0, 0.003) + xlim(0, 40) ETHPOP_lifetable[ETHPOP_lifetable$id == baseyr_2030 & ETHPOP_lifetable$sex == "F", ] %>% ggplot(aes(x = age, y = death_rate, colour = ETH.group)) + geom_line() + ggtitle("Female 2030") + theme_bw() + geom_line(aes(age, qx, colour = "ONS"), data = ONS_lifetables[ONS_lifetables$baseyr == 2030 & ONS_lifetables$sex == "F", ], colour = "black") + ylim(0, 0.003) + xlim(0, 40)
ONS
ggplot(ONS_lifetables[ONS_lifetables$sex == "M", ], aes(age, ex, colour = baseyr)) + geom_line() + theme_bw() ggplot(ONS_lifetables[ONS_lifetables$sex == "F", ], aes(age, ex, colour = baseyr)) + geom_line() + theme_bw()
rmarkdown::render("vignettes/analysis.Rmd", output_dir = "docs/", output_format = "html_document")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.