R/incremental.R

In schifferl/LagSelectionBias:

.simulation_age_group <- function(simulation_age) {
    if(simulation_age == 000){
        "< 1 year"
    } else if(between(simulation_age, 001, 004)) {
        "1-4 years"
    } else if(between(simulation_age, 005, 009)) {
        "5-9 years"
    } else if(between(simulation_age, 010, 014)) {
        "10-14 years"
    } else if(between(simulation_age, 015, 019)) {
        "15-19 years"
    } else if(between(simulation_age, 020, 024)) {
        "20-24 years"
    } else if(between(simulation_age, 025, 034)) {
        "25-34 years"
    } else if(between(simulation_age, 035, 044)) {
        "35-44 years"
    } else if(between(simulation_age, 045, 054)) {
        "45-54 years"
    } else if(between(simulation_age, 055, 064)) {
        "55-64 years"
    } else if(between(simulation_age, 065, 074)) {
        "65-74 years"
    } else if(between(simulation_age, 075, 084)) {
        "75-84 years"
    } else if(simulation_age >= 085) {
        "85+ years"
    } else {
        "Not Stated"
    }
}

################################################################################
################################################################################

library(magrittr)
library(dplyr)

################################################################################
################################################################################

simulation_years <- seq.int(1910, 2015)
simulation_races <- c("Black or African American", "Other Race", "White")
simulation_sexes <- c("Female", "Male")

set.seed(1)

theta_education <- rnorm(1000)
theta_mortality <- rnorm(1000)

simulation_cohorts <-
    length(simulation_years) *
    length(simulation_races) *
    length(simulation_sexes)

simulation_data <- vector("list", simulation_cohorts)

cohort_number <- 1

for(i in simulation_years) {
    for(j in simulation_races) {
        for(k in simulation_sexes) {
            date_of_birth <- rep(i, 1000)
            race <- rep(j, 1000)
            sex <- rep(k, 1000)
            simulation_data[[cohort_number]] <- data.frame(date_of_birth, race,
                                                           sex, theta_education,
                                                           theta_mortality,
                                                           education = NA,
                                                           date_of_death = NA)
            cohort_number <- cohort_number + 1
        }
    }
}

simulation_data %<>%
    bind_rows()

################################################################################
################################################################################

for(i in simulation_years) {
    for(j in simulation_races) {
        for(k in simulation_sexes) {
            cohort_surviving <-
                simulation_data %>%
                filter(date_of_birth <= i) %>%
                filter(race == j) %>%
                filter(sex == k) %>%
                filter(is.na(date_of_death)) %>%
                mutate(age_group = sapply(i - date_of_birth, .simulation_age_group))

            simulation_data <-
                cohort_surviving %>%
                .educate_cohort() %>%
                .mortify_cohort() %>%
                full_join(simulation_data, ., c("date_of_birth", "race", "sex",
                                                "theta_education",
                                                "theta_mortality")) %>%
                mutate(education = education.y) %>%
                mutate(date_of_death = date_of_death.y) %>%
                select(date_of_birth, race, sex, theta_education,
                       theta_mortality, education, date_of_death)

        }
    }
}