DATA_PREP.Rmd

---
title: "Mortality Data Prep"
author: "Thomas Benacci"
date: "2025-12-31"
output: html_document
---

# Introduction

This is the first of three .Rmd files that constitute the mortality prediction project I am undertaking. This project is inspired by *Predicting Mortality From 57 Economic, Behavioral, Social, and Psychological Factors* by Puterman et al. (2020) and uses their methodology to construct features from the Midlife in the United States Core Survey data. The authors graciously provide their R code, but I want this exercise to double as a refresher for my R abilities. 

# Libraries

```{r, include=FALSE}
library(haven)
library(tidyverse)
```

# Read in Data

In 1995/96, the MacArthur Midlife Research Network conducted the MIDUS 1 (M1) survey on a national sample of over 7,000 Americans aged 25 to 74. This sample included sub-samples of Siblings and Twin Pairs. In 2004/05, MIDUS 2 (M2) Project 1 provided follow-up on the psychosocial, sociodemographic, and health variables assessed in MIDUS 1. In 2013, MIDUS began the 3rd wave (M3) of survey data collection on MIDUS longitudinal participants. Project 1 provided follow up on the demographic, psychosocial, and health measures assessed at M1 and M2, while adding new measures to examine the impact of the Great Recession.

In 2011, MIDUS began data collection on a new national sample of American adults aged 25-74 to "refresh" the Core MIDUS cohort and to examine the health impacts of the Great Recession. This dataset contains survey data for the MIDUS Refresher baseline (MR1) sample. In 2022, MIDUS began the 2nd wave (MR2) of survey data collection on MIDUS Refresher participants. This dataset provided follow up on the demographic, psychosocial, and health measures assessed at MR1, while adding new measures to examine the impact of the COVID-19 pandemic.

MIDUS regularly updates the mortality status of MIDUS Refresher sample participants. The mortality 1 dataset is a flat file containing 2,533 deceased cases, and it contains 55 variables that can be linked to other Core MIDUS data sets via the M2ID. The mortality 2 dataset is a flat file containing 364 confirmed decedents and 46 variables that can be combined with or linked to other MIDUS Refresher data sets via the MRID variable. 

```{r}
# MIDUS Core Surveys
Survey_1 <-        read_sav("F:/PredictingMortality/MIDUS/MIDUS 1 Core/M1_P1_SURVEY_N7108_20190116.sav")
Survey_2 <-        read_sav("F:/PredictingMortality/MIDUS/MIDUS 2 Core/M2_P1_SURVEY_N4963_20200720.sav")
Survey_3 <-        read_sav("F:/PredictingMortality/MIDUS/MIDUS 3 Core/M3_P1_SURVEY_N3294_20181219.sav")
# MIDUS Refresher Surveys
RefreshSurvey_1 <- read_sav("F:/PredictingMortality/MIDUS/MIDUS Refresher 1/MR1_P1_SURVEY_N3577_20250407.sav")
RefreshSurvey_2 <- read_sav("F:/PredictingMortality/MIDUS/MIDUS Refresher 2/MR2_P1_SURVEY_N2154_20251003.sav")
# MIDUS Mortality
Mortality_1 <-     read_sav("F:/PredictingMortality/MIDUS/MIDUS Mortality/MIDUS_Core_MortalityCauseData_N2533_20250204.sav")
Mortality_2 <-     read_sav("F:/PredictingMortality/MIDUS/MIDUS Mortality/MIDUS_Refresher_MortalityCauseData_N364_20250219.sav")
```

# Merge Survey 1 with Mortality 1

For our purposes, we will only be using the data collected (1995/96) and re-visited (2011) concerning the first MIDUS survey.

```{r}
# merge mortality data with original survey data
data <- merge(
  zap_labels(Survey_1), 
  zap_labels(Mortality_1),
  all.x = T
  )
# remove unnecessary data
rm(Survey_2); rm(Survey_3)
rm(RefreshSurvey_1); rm(RefreshSurvey_2)
rm(Mortality_2)
```

# Columns to Keep

Using Table S7 located in the Appendix of Puterman et al. (2020), I create a list of the columns that are used as unique identifiers and used to create the dependent/independent variables. 

```{r}
# columns from survey 1 to keep
# see Predicting mortality from 57 economic, behavioral, social, and psychological factors variable description file for details
data_cols <- c(
  # Participant Identification
  "M2ID", "M2FAMNUM", "SAMPLMAJ", 
  # Demographic
  "A1PAGE_M2", # Age at time of 1995/96 survey
  "DECEASED", # Deceased status
  "A1PBYEAR_2019", # Birth Year
  "DOD_Y", # Mortality Year
  "A1PRSEX", # Sex
  "A1SS7", # Race
  "A1SE2", # Foreign Born
  # Childhood Adversity
  "A1POCDMJ", # Lower Father Occupational Status
  "A1POCMMJ", # Lower Mother Occupational Status
  "A1PC2", # Lower Education Father
  "A1PC8", # Lower Education Mother
  # Adult Socioeconomic
  "A1SHHTOT", # Lower Income
  "A1SJ15", # Lower Wealth
  "A1PEDUCP", # Lower Education
  "A1POCMJ", # Lower Occupational Status
  "A1SJ7", # Recent Financial Difficulties
  "A1PB3C", "A1SI1I1", # History of Unemployment
  "A1SL4", # History of Renting
  "A1SC1G", # History of Medicaid
  "A1SHOMET", # Lower Neighborhood Cohesion
  # Adult Health Behaviors
  "A1SA9U", # Alcohol Abuse
  "A1PA43", # Current Smoker
  "A1PA40", # History of Smoking
  "A1SMODER", # Low/No Moderate Activity
  "A1SVIGOR", # Low/No Vigorous Activity
  "A1SA12G", # Sleep Problems
  # Adulthood Social Connections
  "A1PB17", # History of Divorce, Never Married
  "A1PB20", # History of Divorce
  "A1SKINPO", # Lower Positive Interactions with Family
  "A1SKINNE", # Negative Interactions with Family
  "A1SFDSPO", # Lower Positive Interactions with Friends
  "A1SFDSNE", # Negative Interactions with Friends
  # Adulthood Psychological
  "A1SAGREE", # Lower Agreeableness
  "A1SEXTRA", # Lower Extroversion
  "A1SNEURO", # Lower Neuroticism
  "A1SCONS", # Lower Conscientiousness
  "A1SOPEN", # Lower Openness to Experiences
  "A1SA13D", #Hopelessness
  "A1PD1", # Lower Life Satisfaction
  "A1PD7", # Lower Optimism
  "A1SPOSAF", # Lower Positive Affectivity
  "A1SNEGAF", # Negative Affectivity
  "A1SPWBU", # Lower Purpose in Life
  "A1SR2A", # Lower Religiosity
  "A1SPWBE", # Lower Sense of Mastery
  # Adulthood Adverse Experiences
  "A1SS14A", "A1SS14B", "A1SS14C", "A1SS14D", "A1SS14E", "A1SS14I", # Daily Discrimination
  "A1SS13E", "A1SS13C", "A1SS13D", "A1SS13F", "A1SS13I", "A1SS13H" # Major Discrimination
)
# select only necessary columns
data <- data %>%
  select(all_of(data_cols))
```

# Raw Varaible Creation

Again referring to Appendix Table S7, raw variables are computed. In this chunk, reverse-coding is done for relevant variables, but z-scoring is not. 

Reverse-coding is done unto variables whose data is collected in a way where greater values intuitively correlate to earlier mortality. Since the authors want all variables coded such that lower values intuitively correlate to earlier mortality for more uniform interpretation, reverse-coding is done such that: 

$$\text{Reversed value} = (\text{Maximum} + \text{Minimum}) - \text{Original value}$$.

A raw version of the data is saved in the next chunk so individual user responses to the same survey questions can be z-scored against the collected data and a prediction may be made. 

```{r}
# Code all variables to their raw numeric scales and reverse-code so they are all interpreted in the same direction (intuition: lesser value -> greater risk of earlier mortality, and vice versa)
data <- data %>%
  mutate(
    # target
    DECEASED = case_when(
      DECEASED == 1 ~ 1,
      TRUE ~ 0
    ),
    Max_Age = case_when(
      DECEASED == 1 ~ DOD_Y - A1PBYEAR_2019,
      DECEASED == 0 ~ 2023 - A1PBYEAR_2019
    ),
    # demographic
    raw_Age = A1PAGE_M2,
    raw_Male = case_when(
      A1PRSEX == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_Black = case_when(
      A1SS7 == 2 ~ 1,
      TRUE ~ -1
    ),
    raw_ForeignBorn = case_when(
      A1SE2 == 1 ~ 1,
      TRUE ~ -1
    ),
    # Childhood Adversity
    raw_LowFatherOccStat = case_when(
      A1POCDMJ %in% c(3, 6, 7, 8, 9) ~ 1,
      TRUE ~ -1
    ),
    raw_LowMotherOccStat = case_when(
      A1POCMMJ %in% c(3, 6, 7, 8, 9) ~ 1,
      TRUE ~ -1
    ),
    raw_LowFatherEdu = case_when(
      A1PC2 %in% c(1, 2, 3) ~ 3,
      A1PC2 %in% c(4, 5) ~ 2,
      A1PC2 %in% c(6, 7, 8) ~ 1,
      A1PC2 %in% c(9, 10, 11, 12) ~ 0,
      TRUE ~ NA
    ),
    raw_LowMotherEdu = case_when(
      A1PC8 %in% c(1, 2, 3) ~ 3,
      A1PC8 %in% c(4, 5) ~ 2,
      A1PC8 %in% c(6, 7, 8) ~ 1,
      A1PC8 %in% c(9, 10, 11, 12) ~ 0,
      TRUE ~ NA
    ),
    # Adulthood Socioeconomic
    raw_LowerIncome = (300000 + 1) - A1SHHTOT,
    raw_LowerWealth = case_when(
      A1SJ15 == 1 ~ 36, A1SJ15 == 2 ~ 35, A1SJ15 == 3 ~ 34, A1SJ15 == 4 ~ 33,
      A1SJ15 == 5 ~ 32, A1SJ15 == 6 ~ 31, A1SJ15 == 7 ~ 30, A1SJ15 == 8 ~ 29,
      A1SJ15 == 9 ~ 28, A1SJ15 == 10 ~ 27, A1SJ15 == 11 ~ 26, A1SJ15 == 12 ~ 25,
      A1SJ15 == 13 ~ 24, A1SJ15 == 14 ~ 23, A1SJ15 == 15 ~ 22, A1SJ15 == 16 ~ 21,
      A1SJ15 == 17 ~ 20, A1SJ15 == 18 ~ 19, A1SJ15 == 19 ~ 18, A1SJ15 == 20 ~ 17,
      A1SJ15 == 21 ~ 16, A1SJ15 == 22 ~ 15, A1SJ15 == 23 ~ 14, A1SJ15 == 24 ~ 13,
      A1SJ15 == 25 ~ 12, A1SJ15 == 26 ~ 11, A1SJ15 == 27 ~ 10, A1SJ15 == 28 ~ 9,
      A1SJ15 == 29 ~ 8, A1SJ15 == 30 ~ 7, A1SJ15 == 31 ~ 6, A1SJ15 == 32 ~ 5,
      A1SJ15 == 33 ~ 4, A1SJ15 == 34 ~ 3, A1SJ15 == 35 ~ 2, A1SJ15 == 36 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerEdu = case_when(
      A1PEDUCP == 1 ~ 4, A1PEDUCP == 2 ~ 3, A1PEDUCP == 3 ~ 2, A1PEDUCP == 4 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerOccStat = case_when(
      A1POCMJ %in% c(3, 6, 7, 8, 9) ~ 1,
      TRUE ~ -1
    ),
    raw_RecentFinDiff = case_when(
      A1SJ7 == 1 ~ 4, A1SJ7 == 2 ~ 3, A1SJ7 == 3 ~ 2, A1SJ7 == 4 ~ 1,
      TRUE ~ NA
    ),
    raw_HistOfUnemployment = case_when(
      A1PB3C == 1 | A1SI1I1 == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_HistOfRenting = case_when(
      A1SL4 == 3 ~ 1,
      TRUE ~ -1
    ),
    raw_HistOfMedicaid = case_when(
      A1SC1G == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_LowNeighborCohesion = (4 + 1) - A1SHOMET,
    raw_AlcoholAbuse = case_when(
      A1SA9U == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_CurrentSmoker = case_when(
      A1PA43 == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_HistOfSmoking = case_when(
      A1PA40 == 1 ~ 1,
      TRUE ~ -1
    ),
    raw_LowNoModActivity = case_when(
      A1SMODER <= 4 ~ 1,
      TRUE ~ -1
    ),
    raw_LowNoVigActivity = case_when(
      A1SVIGOR <= 4 ~ 1,
      TRUE ~ -1
    ),
    raw_SleepProblems = case_when(
      A1SA12G == 1 ~ 6, A1SA12G == 2 ~ 5, A1SA12G == 3 ~ 4,
      A1SA12G == 4 ~ 3, A1SA12G == 5 ~ 2, A1SA12G == 6 ~ 1,
      TRUE ~ NA
    ),
    # Adulthood Social Connections
    raw_HistOfDivorce = case_when(
      A1PB17 == 3 | A1PB20 == 2 ~ 1,
      TRUE ~ -1
    ),
    raw_NeverMarried = case_when(
      A1PB17 == 5 ~ 1,
      TRUE ~ -1
    ),
    raw_LowerPosIntWithFamily = (4 + 1) - A1SKINPO,
    raw_NegIntWithFamily = A1SKINNE,
    raw_LowerPosIntWithFriends = (4 + 1) - A1SFDSPO,
    raw_NegIntWithFriends = A1SFDSNE,
    # Adulthood Psychological
    raw_LowerAgreeableness = (4 + 1) - A1SAGREE,
    raw_LowerExtroversion = (4 + 1) - A1SEXTRA,
    raw_LowerNeuroticism = (4 + 1) - A1SNEURO,
    raw_LowerConscientiousness = (4 + 1) - A1SCONS,
    raw_LowerOpennessToExperiences = (4 + 1) - A1SOPEN,
    raw_Hopelessness = case_when(
      A1SA13D == 1 ~ 5, A1SA13D == 2 ~ 4, A1SA13D == 3 ~ 3,
      A1SA13D == 4 ~ 2, A1SA13D == 5 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerLifeSatisfaction = case_when(
      A1PD1 == 4 ~ 4, A1PD1 == 3 ~ 3, A1PD1 == 2 ~ 2, A1PD1 == 1 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerOptimism = case_when(
      A1PD7 == 4 ~ 4, A1PD7 == 3 ~ 3, A1PD7 == 2 ~ 2, A1PD7 == 1 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerPosAffectivity = (5 + 1) - A1SPOSAF,
    raw_NegAffectivity = A1SNEGAF,
    raw_LowerPurposeInLife = (21 + 1) - A1SPWBU,
    raw_LowerReligiosity = case_when(
      A1SR2A == 4 ~ 4, A1SR2A == 3 ~ 3, A1SR2A == 2 ~ 2, A1SR2A == 1 ~ 1,
      TRUE ~ NA
    ),
    raw_LowerSenseOfMastery = (21 + 1) - A1SPWBE
  )
# Daily and Major Discrimination (need group_by for sum)
data <- data %>%
  mutate(
    rev_A1SS14A = (4 + 1) - A1SS14A,
    rev_A1SS14B = (4 + 1) - A1SS14B,
    rev_A1SS14C = (4 + 1) - A1SS14C,
    rev_A1SS14D = (4 + 1) - A1SS14D,
    rev_A1SS14E = (4 + 1) - A1SS14E,
    rev_A1SS14I = (4 + 1) - A1SS14I
  ) %>%
  group_by(M2ID) %>%
  mutate(
    raw_DailyDiscrimination = sum(
      rev_A1SS14A, rev_A1SS14B, rev_A1SS14C, rev_A1SS14D, rev_A1SS14E, rev_A1SS14I,
      na.rm = TRUE
    ),
    raw_MajorDiscrimination = sum(
      pmin(A1SS13E, 5), pmin(A1SS13C, 5), pmin(A1SS13D, 5),
      pmin(A1SS13F, 5), pmin(A1SS13I, 5), pmin(A1SS13H, 5),
      na.rm = TRUE
    )
  ) %>%
  ungroup()
```

# Save Raw Data

Save the raw coded and reverse-coded variable data so questionnaire answers can be appended as a new row and z-scored relative to training data. 

```{r}
raw_data <- data %>%
  select(M2ID, M2FAMNUM, SAMPLMAJ, DECEASED, Max_Age, starts_with("raw_"))

write.csv(raw_data, "survey_1_raw_data.csv", row.names = FALSE)
cat("Saved raw data:", nrow(raw_data), "rows x", ncol(raw_data), "columns\n")
```

# Z-Score Continuous Variables

Z-score transform the continuous variables such that: 

$$\text{z-score} = \frac{\text{value} - \text{mean}}{\text{standard deviation}}$$.

NA values are imputed with the median of the z-scored data. 

```{r}
zscore_median_impute <- function(x){
  z <- (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
  med <- median(z, na.rm = TRUE)
  z[is.na(z)] <- med
  return(z)
}
# The char_ columns are the z-scored versions of the raw_ columns.
# Binary variables (-1/1) are kept as-is (no z-scoring needed).
data <- data %>%
  mutate(
    # Continuous variables: z-score
    char_Age = zscore_median_impute(raw_Age),
    char_LowFatherEdu = zscore_median_impute(raw_LowFatherEdu),
    char_LowMotherEdu = zscore_median_impute(raw_LowMotherEdu),
    char_LowerIncome = zscore_median_impute(raw_LowerIncome),
    char_LowerWealth = zscore_median_impute(raw_LowerWealth),
    char_LowerEdu = zscore_median_impute(raw_LowerEdu),
    char_RecentFinDiff = zscore_median_impute(raw_RecentFinDiff),
    char_LowNeighborCohesion = zscore_median_impute(raw_LowNeighborCohesion),
    char_SleepProblems = zscore_median_impute(raw_SleepProblems),
    char_LowerPosIntWithFamily = zscore_median_impute(raw_LowerPosIntWithFamily),
    char_NegIntWithFamily = zscore_median_impute(raw_NegIntWithFamily),
    char_LowerPosIntWithFriends = zscore_median_impute(raw_LowerPosIntWithFriends),
    char_NegIntWithFriends = zscore_median_impute(raw_NegIntWithFriends),
    char_LowerAgreeableness = zscore_median_impute(raw_LowerAgreeableness),
    char_LowerExtroversion = zscore_median_impute(raw_LowerExtroversion),
    char_LowerNeuroticism = zscore_median_impute(raw_LowerNeuroticism),
    char_LowerConscientiousness = zscore_median_impute(raw_LowerConscientiousness),
    char_LowerOpennessToExperiences = zscore_median_impute(raw_LowerOpennessToExperiences),
    char_Hopelessness = zscore_median_impute(raw_Hopelessness),
    char_LowerLifeSatisfaction = zscore_median_impute(raw_LowerLifeSatisfaction),
    char_LowerOptimism = zscore_median_impute(raw_LowerOptimism),
    char_LowerPosAffectivity = zscore_median_impute(raw_LowerPosAffectivity),
    char_NegAffectivity = zscore_median_impute(raw_NegAffectivity),
    char_LowerPurposeInLife = zscore_median_impute(raw_LowerPurposeInLife),
    char_LowerReligiosity = zscore_median_impute(raw_LowerReligiosity),
    char_LowerSenseOfMastery = zscore_median_impute(raw_LowerSenseOfMastery),
    char_DailyDiscrimination = zscore_median_impute(raw_DailyDiscrimination),
    char_MajorDiscrimination = zscore_median_impute(raw_MajorDiscrimination),
    # Binary variables: copy as-is (already -1/1)
    char_Male = raw_Male,
    char_Black = raw_Black,
    char_ForeignBorn = raw_ForeignBorn,
    char_LowFatherOccStat = raw_LowFatherOccStat,
    char_LowMotherOccStat = raw_LowMotherOccStat,
    char_LowerOccStat = raw_LowerOccStat,
    char_HistOfUnemployment = raw_HistOfUnemployment,
    char_HistOfRenting = raw_HistOfRenting,
    char_HistOfMedicaid = raw_HistOfMedicaid,
    char_AlcoholAbuse = raw_AlcoholAbuse,
    char_CurrentSmoker = raw_CurrentSmoker,
    char_HistOfSmoking = raw_HistOfSmoking,
    char_LowNoModActivity = raw_LowNoModActivity,
    char_LowNoVigActivity = raw_LowNoVigActivity,
    char_HistOfDivorce = raw_HistOfDivorce,
    char_NeverMarried = raw_NeverMarried
  )
```

# Save Transformed Variable Data

```{r}
write.csv(
  data %>% select(M2FAMNUM, SAMPLMAJ, DECEASED, Max_Age, starts_with("char_")),
  "survey_1_feature_data.csv",
  row.names = FALSE
  )
```