cohort_years <- c(
1979,
1980,
1981,
1982,
1983,
1984,
1985,
1986,
1987,
1988,
1989,
1990,
1991,
1992,
1993,
1994,
1996,
1998,
2000,
2002,
2004,
2006,
2008,
2010,
2012,
2014,
2016,
2018,
2020
)
df <- read.csv("data.csv") %>% rename(
id = R0000100,
sample_id = R0173600,
household_id = R0000149,
race = R0214700,
sex = R0214800,
birth_year = R0000500,
birth_month = R0000300,
asvab_ar = R0648309,
asvab_wk = R0648343,
asvab_pc = R0648382,
asvab_mk = R0648402,
rel_with_household_r_1 = R0000151,
rel_with_household_r_2 = R0000153,
rel_with_household_r_3 = R0000155,
rel_with_household_r_4 = R0000157,
rel_with_household_r_5 = R0000159,
height_feet = T0897400,
height_inches = T0897500,
highest_grade_1979 = R0017300,
highest_grade_1980 = R0229200,
highest_grade_1981 = R0417400,
highest_grade_1982 = R0664500,
highest_grade_1983 = R0905900,
highest_grade_1984 = R1205800,
highest_grade_1985 = R1605100,
highest_grade_1986 = R1905600,
highest_grade_1987 = R2306500,
highest_grade_1988 = R2509000,
highest_grade_1989 = R2908100,
highest_grade_1990 = R3110200,
highest_grade_1991 = R3510200,
highest_grade_1992 = R3710200,
highest_grade_1993 = R4137900,
highest_grade_1994 = R4526500,
highest_grade_1996 = R5221800,
highest_grade_1998 = R5821800,
highest_grade_2000 = R6540400,
highest_grade_2002 = R7103600,
highest_grade_2004 = R7810500,
highest_grade_2006 = T0014400,
highest_grade_2008 = T1214300,
highest_grade_2010 = T2272800,
highest_grade_2012 = T3212900,
highest_grade_2014 = T4201100,
highest_grade_2016 = T5176100,
highest_grade_2018 = T7743900,
highest_grade_2020 = T8355300,
) %>% mutate(
height_feet = if_else(height_feet < 0, NA, height_feet),
height_inches = if_else(height_inches < 0, NA, height_inches),
asvab_ar = if_else(asvab_ar < 0, NA, asvab_ar),
asvab_wk = if_else(asvab_wk < 0, NA, asvab_wk),
asvab_pc = if_else(asvab_pc < 0, NA, asvab_pc),
asvab_mk = if_else(asvab_mk < 0, NA, asvab_mk),
sex = sex - 1,
birth_date = 1900 + birth_year + (birth_month / 12), # birth year is given as the last two digits of the year
height_inches = height_inches + (height_feet * 12),
)
for (year in cohort_years) {
# Highest grade
# Values less than 0 or equal to 95 get transformed into NA
highest_grade_column_name <- paste0("highest_grade_", year)
df[[highest_grade_column_name]] = if_else(
df[[highest_grade_column_name]] == 95,
NA,
if_else(
df[[highest_grade_column_name]] < 0,
NA,
df[[highest_grade_column_name]]
)
)
}
df <- df %>%
mutate(
edu_attainment = pmax(
highest_grade_1979,
highest_grade_1980,
highest_grade_1981,
highest_grade_1982,
highest_grade_1983,
highest_grade_1984,
highest_grade_1985,
highest_grade_1986,
highest_grade_1987,
highest_grade_1988,
highest_grade_1989,
highest_grade_1990,
highest_grade_1991,
highest_grade_1992,
highest_grade_1993,
highest_grade_1994,
highest_grade_1996,
highest_grade_1998,
highest_grade_2000,
highest_grade_2002,
highest_grade_2004,
highest_grade_2006,
highest_grade_2008,
highest_grade_2010,
highest_grade_2012,
highest_grade_2014,
highest_grade_2016,
highest_grade_2018,
highest_grade_2020,
na.rm = TRUE
)
)
df <- df %>% select(
id,
household_id,
sample_id,
race,
sex,
edu_attainment,
birth_date,
asvab_ar,
asvab_wk,
asvab_pc,
asvab_mk,
rel_with_household_r_1,
rel_with_household_r_2,
rel_with_household_r_3,
rel_with_household_r_4,
rel_with_household_r_5,
height_inches
)
# Create IQ score with a white mean of 100 and a white SD of 15
df <- df %>% mutate(
full_sample_asvab_z_score = scale(scale(asvab_ar) + scale(asvab_wk) + scale(asvab_pc) + scale(asvab_mk))[,1]
)
white_df <- df %>% filter(sample_id <= 8, race == 3)
white_asvab_z_score_mean <- mean(white_df$full_sample_asvab_z_score, na.rm = T)
white_asvab_z_score_sd <- sd(white_df$full_sample_asvab_z_score, na.rm = T)
df <- df %>% mutate(
iq = (((full_sample_asvab_z_score - white_asvab_z_score_mean) / white_asvab_z_score_sd) * 15) + 100
) %>% select(
-c(full_sample_asvab_z_score, asvab_ar, asvab_wk, asvab_pc, asvab_mk)
)
# Remove the influence of birth date from IQ
iq_model <- lm(iq ~ birth_date, data = df)
iq_mean <- mean(df$iq, na.rm = T)
iq_sd <- sd(df$iq, na.rm = T)
adjusted_iq_df <- df %>% filter(
!is.na(iq)
) %>% mutate(
scaled_iq_residual = scale(iq_model$residuals)[,1],
adjusted_iq = iq_mean + (scaled_iq_residual * iq_sd)
) %>% select(
id,
adjusted_iq
)
df <- df %>% left_join(adjusted_iq_df, by = "id")
# Remove influence of sex on height
height_model <- lm(height_inches ~ sex, data = df)
height_mean <- mean(df$height_inches, na.rm = T)
height_sd <- sd(df$height_inches, na.rm = T)
adjusted_height_df <- df %>% filter(
!is.na(height_inches)
) %>% mutate(
scaled_height_inches_residual = scale(height_model$residuals)[,1],
adjusted_height_inches = height_mean + (scaled_height_inches_residual * height_sd)
) %>% select(
id,
adjusted_height_inches
)
df <- df %>% left_join(adjusted_height_df, by = "id")
# Remove respondents from households with non-sibling respondents
df <- df %>%
filter(
rel_with_household_r_1 %in% c(-4, 6, 7), # -4 = valid skip, 6 = brother, 7 = sister
rel_with_household_r_2 %in% c(-4, 6, 7),
rel_with_household_r_3 %in% c(-4, 6, 7),
rel_with_household_r_4 %in% c(-4, 6, 7),
rel_with_household_r_5 %in% c(-4, 6, 7)
) %>% select(
-c(rel_with_household_r_1, rel_with_household_r_2, rel_with_household_r_3, rel_with_household_r_4, rel_with_household_r_5)
)
# IQ and parental age
m1_df <- df %>%
filter(!is.na(adjusted_iq), !is.na(birth_date)) %>%
group_by(household_id) %>%
filter(n() > 1) %>% # Only keep groups with more than one respondent
mutate(
birth_date_delta = birth_date - mean(birth_date),
adjusted_iq_delta = adjusted_iq - mean(adjusted_iq)
)
m1 <- lm(adjusted_iq_delta ~ birth_date_delta, data = m1_df)
summary(m1)
##
## Call:
## lm(formula = adjusted_iq_delta ~ birth_date_delta, data = m1_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.2749 -4.9205 0.0054 4.7481 26.6407
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.089e-16 1.040e-01 0.000 1
## birth_date_delta 5.367e-01 6.839e-02 7.847 5.14e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.457 on 5142 degrees of freedom
## Multiple R-squared: 0.01183, Adjusted R-squared: 0.01164
## F-statistic: 61.58 on 1 and 5142 DF, p-value: 5.14e-15
# IQ and educational attainment
m2_df <- df %>%
filter(!is.na(adjusted_iq), !is.na(edu_attainment)) %>%
group_by(household_id) %>%
filter(n() > 1) %>% # Only keep groups with more than one respondent
mutate(
edu_attainment_delta = edu_attainment - mean(edu_attainment),
adjusted_iq_delta = adjusted_iq - mean(adjusted_iq)
)
m2 <- lm(adjusted_iq_delta ~ edu_attainment_delta, data = m2_df)
summary(m2)
##
## Call:
## lm(formula = adjusted_iq_delta ~ edu_attainment_delta, data = m2_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.996 -4.387 -0.011 4.440 23.961
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.249e-16 9.717e-02 0.0 1
## edu_attainment_delta 1.925e+00 6.730e-02 28.6 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.969 on 5141 degrees of freedom
## Multiple R-squared: 0.1372, Adjusted R-squared: 0.1371
## F-statistic: 817.7 on 1 and 5141 DF, p-value: < 2.2e-16
# Height and educational attainment
m3_df <- df %>%
filter(!is.na(adjusted_iq), !is.na(adjusted_height_inches)) %>%
group_by(household_id) %>%
filter(n() > 1) %>% # Only keep groups with more than one respondent
mutate(
edu_attainment_delta = edu_attainment - mean(edu_attainment),
adjusted_height_inches_delta = adjusted_height_inches - mean(adjusted_height_inches)
)
m3 <- lm(adjusted_height_inches_delta ~ edu_attainment_delta, data = m3_df)
summary(m3)
##
## Call:
## lm(formula = adjusted_height_inches_delta ~ edu_attainment_delta,
## data = m3_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -25.222 -1.450 0.000 1.429 25.222
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.920e-17 4.178e-02 0.000 1.00000
## edu_attainment_delta 8.982e-02 2.901e-02 3.096 0.00198 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.378 on 3238 degrees of freedom
## Multiple R-squared: 0.002952, Adjusted R-squared: 0.002644
## F-statistic: 9.588 on 1 and 3238 DF, p-value: 0.001976