R/educate_cohort.R

In schifferl/LagSelectionBias:

educate_cohort <- function(filtered_data, current_year, education_covariance) {
  for (x in unique(filtered_data$age_group)) {
    for (y in unique(filtered_data$race)) {
      for (z in unique(filtered_data$sex)) {
        education_cohort <-
          filtered_data %>%
          filter(age_group == x) %>%
          filter(race == y) %>%
          filter(sex == z) %>%
          mutate(weighted_theta = education_covariance * theta_mortality +
                   (1 - education_covariance) * theta_education) %>%
          arrange(weighted_theta)

        education_length <- nrow(education_cohort)

        cohort_education <-
          education_data %>%
          filter(Year == ifelse(current_year < 1962, round(current_year * 0.1) * 10, current_year)) %>%
          filter(Age_Group == x) %>%
          filter(Race == y) %>%
          filter(Sex == z) %>%
          arrange(Education) %$% {
            multiply_by(Proportion, education_length * 100) %>%
              round() %>%
              mapply(rep, Education, .)
          }

        if(length(cohort_education) > education_length) {
          cohort_education <- cohort_education[1:education_length]
        }

        if(length(cohort_education) < education_length) {
          cohort_education <-
            length(cohort_education) %>%
            subtract(education_length, .) %>%
            rep(cohort_education[1], .) %>%
            c(cohort_education)
        }

        education_cohort$education <- cohort_education

        filtered_data %<>%
          merge.data.frame(education_cohort, all.y = TRUE)
      }
    }
  }
}