Which facet of conscientiousness predicts wealth?

TL;DR being willing to follow rules and have a fixed focus don’t predict much. Having a work ethic, being reliable, and having grit do.

Currently using the variables I created in the post https://rpubs.com/mishav/explainedvariance to avoid unnecessarily recycling code.

Data cleaning

new_data$boybadyouth <- new_data$R1487400
new_data$boybadparent <- new_data$R1487600
new_data$girlbadyouth <- new_data$R1487300
new_data$girlbadparent <- new_data$R1487500

new_data <- new_data %>%
  rename(
    "lies_cheats_female" = "R0356500",  
    "school_work_poor_female" = "R0356600",  
    "trouble_sleeping_female" = "R0356700",  
    "unhappy_sad_depressed_female" = "R0356800",  
    "trouble_concentrating_male" = "R0356900",  
    "does_not_get_along_others_male" = "R0357000",  
    "lies_cheats_male" = "R0357100",  
    "unhappy_sad_depressed_male" = "R0357200",  
    "expects_best_uncertain_times" = "R0357500",  
    "rarely_expects_good_things" = "R0357600",  
    "optimistic_about_future" = "R0357700",  
    "hardly_expects_things_to_go_well" = "R0357800",  
    "percent_chance_arrested_steal_car" = "R0443500",  
    "uncertain_times_expect_best" = "R0624000",  
    "rarely_good_things_happen" = "R0624100",  
    "optimistic_about_future_pr" = "R0624200",  
    "hardly_expect_things_go_well_pr" = "R0624300",  
    "condition_limits_school_work" = "R0681300",  
    "learning_emotional_problem_limits_performance" = "R0681500",  
    "learning_emotional_problem_detail_1" = "R0681700",  
    "learning_emotional_problem_detail_2" = "R0681701",  
    "learning_emotional_problem_detail_3" = "R0681702",  
    "learning_emotional_problem_detail_4" = "R0681703",  
    "learning_emotional_problem_detail_5" = "R0681705",  
    "age_condition_noticed_1" = "R0681800",  
    "age_condition_noticed_2" = "R0681900",  
    "age_condition_noticed_3" = "R0682000",  
    "age_condition_noticed_4" = "R0682100",  
    "age_condition_noticed_5" = "R0682200",  
    "currently_limited_by_condition_1" = "R0682300",  
    "currently_limited_by_condition_2" = "R0682400",  
    "currently_limited_by_condition_3" = "R0682500",  
    "currently_limited_by_condition_4" = "R0682600",  
    "currently_limited_by_condition_5" = "R0682700",  
    "percent_chance_in_school_next_year" = "R0688500",  
    "percent_chance_school_and_working" = "R0688600",  
    "percent_chance_high_school_diploma_by_20" = "R0688700",  
    "percent_chance_in_jail_by_20" = "R0688800",  
    "percent_chance_parent_by_20" = "R0688900",  
    "percent_chance_college_degree_by_30" = "R0689000",  
    "percent_chance_work_20_hours_by_30" = "R0689100",  
    "lies_cheats_female_2" = "R0690500",  
    "school_work_poor_female_2" = "R0690600",  
    "trouble_sleeping_female_2" = "R0690700",  
    "unhappy_sad_depressed_female_2" = "R0690800",  
    "trouble_concentrating_male_2" = "R0690900",  
    "lies_cheats_male_2" = "R0691000",  
    "does_not_get_along_others_male_2" = "R0691100",  
    "unhappy_sad_depressed_male_2" = "R0691200",  
    "disorganized" = "S0920000",  
    "conscientious" = "S0920100",  
    "undependable" = "S0920200",  
    "thorough" = "S0920300",  
    "agreeable" = "S0920400",  
    "difficult" = "S0920500",  
    "stubborn" = "S0920600",  
    "trustful" = "S0920700",  
    "personality_extraverted_enthusiastic" = "T3162500",  
    "personality_critical_quarrelsome" = "T3162501",  
    "personality_dependable_disciplined" = "T3162502",  
    "personality_anxious_upset" = "T3162503",  
    "personality_open_complex" = "T3162504",  
    "personality_reserved_quiet" = "T3162505",  
    "personality_sympathetic_warm" = "T3162506",  
    "personality_disorganized_careless" = "T3162507",  
    "personality_calm_stable" = "T3162508",  
    "personality_conventional_uncreative" = "T3162509",  
    "personality_hard_worker" = "T3162600",  
    "personality_amount_of_work" = "T3162601",  
    "personality_work_standards" = "T3162602",  
    "personality_effort_at_work" = "T3162603",  
    "personality_following_rules" = "T3162700",  
    "personality_breaking_school_rules" = "T3162701",  
    "personality_support_for_rules_traditions" = "T3162702",  
    "personality_bending_rules" = "T3162703",  
    "personality_hard_worker_2010" = "T6216400",  
    "personality_amount_of_work_2010" = "T6216401",  
    "personality_work_standards_2010" = "T6216402",  
    "personality_effort_at_work_2010" = "T6216403",  
    "personality_following_rules_2010" = "T6216500",  
    "personality_breaking_school_rules_2010" = "T6216501",  
    "personality_support_for_rules_traditions_2010" = "T6216502",  
    "personality_bending_rules_2010" = "T6216503",  
    "grit_new_ideas_distract_2013" = "T9039400",  
    "grit_setbacks_not_discourage_2013" = "T9039500",  
    "grit_short_term_obsessions_2013" = "T9039600",  
    "grit_hard_worker_2013" = "T9039700",  
    "grit_change_goals_frequently_2013" = "T9039800",  
    "grit_maintaining_focus_2013" = "T9039900",  
    "grit_ability_to_finish_projects_2013" = "T9040000",  
    "grit_diligence_2013" = "T9040100",  
    "grit_new_ideas_distract_2015" = "U1028900",  
    "grit_setbacks_not_discourage_2015" = "U1029000",  
    "grit_short_term_obsessions_2015" = "U1029100",  
    "grit_hard_worker_2015" = "U1029200",  
    "grit_change_goals_frequently_2015" = "U1029300",  
    "grit_maintaining_focus_2015" = "U1029400",  
    "grit_ability_to_finish_projects_2015" = "U1029500",  
    "grit_diligence_2015" = "U1029600",  
    "grit_new_ideas_distract_2017" = "U2969100",  
    "grit_setbacks_not_discourage_2017" = "U2969200",  
    "grit_short_term_obsessions_2017" = "U2969300",  
    "grit_hard_worker_2017" = "U2969400",  
    "grit_change_goals_frequently_2017" = "U2969500",  
    "grit_maintaining_focus_2017" = "U2969600",  
    "grit_ability_to_finish_projects_2017" = "U2969700",  
    "grit_diligence_2017" = "U2969800"
  )

new_data$grit_diligence_2013[is.na(new_data$grit_diligence_2013)] <- new_data$grit_diligence_2015[is.na(new_data$grit_diligence_2013)]
new_data$grit_diligence_2013[is.na(new_data$grit_diligence_2013)] <- new_data$grit_diligence_2017[is.na(new_data$grit_diligence_2013)]

new_data$grit_ability_to_finish_projects_2013[is.na(new_data$grit_ability_to_finish_projects_2013)] <- new_data$grit_ability_to_finish_projects_2015[is.na(new_data$grit_ability_to_finish_projects_2013)]
new_data$grit_ability_to_finish_projects_2013[is.na(new_data$grit_ability_to_finish_projects_2013)] <- new_data$grit_ability_to_finish_projects_2017[is.na(new_data$grit_ability_to_finish_projects_2013)]

new_data$grit_maintaining_focus_2013[is.na(new_data$grit_maintaining_focus_2013)] <- new_data$grit_maintaining_focus_2015[is.na(new_data$grit_maintaining_focus_2013)]
new_data$grit_maintaining_focus_2013[is.na(new_data$grit_maintaining_focus_2013)] <- new_data$grit_maintaining_focus_2017[is.na(new_data$grit_maintaining_focus_2013)]

new_data$grit_change_goals_frequently_2013[is.na(new_data$grit_change_goals_frequently_2013)] <- new_data$grit_change_goals_frequently_2015[is.na(new_data$grit_change_goals_frequently_2013)]
new_data$grit_change_goals_frequently_2013[is.na(new_data$grit_change_goals_frequently_2013)] <- new_data$grit_change_goals_frequently_2017[is.na(new_data$grit_change_goals_frequently_2013)]

new_data$grit_hard_worker_2013[is.na(new_data$grit_hard_worker_2013)] <- new_data$grit_hard_worker_2015[is.na(new_data$grit_hard_worker_2013)]
new_data$grit_hard_worker_2013[is.na(new_data$grit_hard_worker_2013)] <- new_data$grit_hard_worker_2017[is.na(new_data$grit_hard_worker_2013)]

new_data$grit_short_term_obsessions_2013[is.na(new_data$grit_short_term_obsessions_2013)] <- new_data$grit_short_term_obsessions_2015[is.na(new_data$grit_short_term_obsessions_2013)]
new_data$grit_short_term_obsessions_2013[is.na(new_data$grit_short_term_obsessions_2013)] <- new_data$grit_short_term_obsessions_2017[is.na(new_data$grit_short_term_obsessions_2013)]

new_data$grit_setbacks_not_discourage_2013[is.na(new_data$grit_setbacks_not_discourage_2013)] <- new_data$grit_setbacks_not_discourage_2015[is.na(new_data$grit_setbacks_not_discourage_2013)]
new_data$grit_setbacks_not_discourage_2013[is.na(new_data$grit_setbacks_not_discourage_2013)] <- new_data$grit_setbacks_not_discourage_2017[is.na(new_data$grit_setbacks_not_discourage_2013)]

new_data$grit_new_ideas_distract_2013[is.na(new_data$grit_new_ideas_distract_2013)] <- new_data$grit_new_ideas_distract_2015[is.na(new_data$grit_new_ideas_distract_2013)]
new_data$grit_new_ideas_distract_2013[is.na(new_data$grit_new_ideas_distract_2013)] <- new_data$grit_new_ideas_distract_2017[is.na(new_data$grit_new_ideas_distract_2013)]

new_data$personality_hard_worker[is.na(new_data$personality_hard_worker)] <- new_data$personality_hard_worker_2010[is.na(new_data$personality_hard_worker)]
new_data$personality_amount_of_work[is.na(new_data$personality_amount_of_work)] <- new_data$personality_amount_of_work_2010[is.na(new_data$personality_amount_of_work)]
new_data$personality_work_standards[is.na(new_data$personality_work_standards)] <- new_data$personality_work_standards_2010[is.na(new_data$personality_work_standards)]
new_data$personality_effort_at_work[is.na(new_data$personality_effort_at_work)] <- new_data$personality_effort_at_work_2010[is.na(new_data$personality_effort_at_work)]
new_data$personality_following_rules[is.na(new_data$personality_following_rules)] <- new_data$personality_following_rules_2010[is.na(new_data$personality_following_rules)]
new_data$personality_breaking_school_rules[is.na(new_data$personality_breaking_school_rules)] <- new_data$personality_breaking_school_rules_2010[is.na(new_data$personality_breaking_school_rules)]
new_data$personality_support_for_rules_traditions[is.na(new_data$personality_support_for_rules_traditions)] <- new_data$personality_support_for_rules_traditions_2010[is.na(new_data$personality_support_for_rules_traditions)]

Parallel analysis to decide number of factors:

fa.parallel(new_data %>% select(grit_maintaining_focus_2013, grit_change_goals_frequently_2013, grit_short_term_obsessions_2013, grit_new_ideas_distract_2013, grit_setbacks_not_discourage_2013, grit_diligence_2013, grit_ability_to_finish_projects_2013, grit_hard_worker_2013, personality_effort_at_work, personality_work_standards, personality_amount_of_work, personality_hard_worker, personality_dependable_disciplined, undependable, thorough, conscientious, personality_bending_rules, personality_support_for_rules_traditions, personality_breaking_school_rules, personality_following_rules))

Parallel analysis suggests that the number of factors =  6  and the number of components =  6 

PCA with 6 factors

pca(new_data %>% select(grit_maintaining_focus_2013, grit_change_goals_frequently_2013, grit_short_term_obsessions_2013, grit_new_ideas_distract_2013, grit_setbacks_not_discourage_2013, grit_diligence_2013, grit_ability_to_finish_projects_2013, grit_hard_worker_2013, personality_effort_at_work, personality_work_standards, personality_amount_of_work, personality_hard_worker, personality_dependable_disciplined, undependable, thorough, conscientious, personality_bending_rules, personality_support_for_rules_traditions, personality_breaking_school_rules, personality_following_rules),nfactors=6)

Principal Components Analysis
Call: principal(r = r, nfactors = nfactors, residuals = residuals, 
    rotate = rotate, n.obs = n.obs, covar = covar, scores = scores, 
    missing = missing, impute = impute, oblique.scores = oblique.scores, 
    method = method, use = use, cor = cor, correct = 0.5, weight = NULL)
Standardized loadings (pattern matrix) based upon correlation matrix

                       RC2  RC1  RC3  RC5  RC6  RC4
SS loadings           2.45 1.97 1.77 1.62 1.51 1.41
Proportion Var        0.12 0.10 0.09 0.08 0.08 0.07
Cumulative Var        0.12 0.22 0.31 0.39 0.47 0.54
Proportion Explained  0.23 0.18 0.16 0.15 0.14 0.13
Cumulative Proportion 0.23 0.41 0.58 0.73 0.87 1.00

Mean item complexity =  1.4
Test of the hypothesis that 6 components are sufficient.

The root mean square of the residuals (RMSR) is  0.07 
 with the empirical chi square  17714.45  with prob <  0 

Fit based upon off diagonal values = 0.81

Grouping together the conscientiousness items into different facets: fixed focus, rule following, reliability, quality, tendency to work hard, and grit. Factors were reverse coded if necessary. Other constructs were added as controls.

new_data$fixedfocus <- getpc(new_data %>% select(grit_maintaining_focus_2013, grit_change_goals_frequently_2013, grit_short_term_obsessions_2013, grit_new_ideas_distract_2013), dofa=F, fillmissing=F, normalizeit=T)
new_data$rulefollow <- getpc(new_data %>% select(personality_bending_rules, personality_support_for_rules_traditions, personality_breaking_school_rules, personality_following_rules), dofa=F, fillmissing=F, normalizeit=T)
new_data$reliability <- getpc(new_data %>% select(undependable, thorough, conscientious, personality_dependable_disciplined), dofa=F, fillmissing=F, normalizeit=T)
new_data$quality <- getpc(new_data %>% select(personality_effort_at_work, personality_work_standards), dofa=F, fillmissing=F, normalizeit=T)
new_data$hardwork <- -getpc(new_data %>% select(grit_hard_worker_2013, personality_hard_worker, personality_amount_of_work), dofa=F, fillmissing=F, normalizeit=T)
new_data$grit <- -getpc(new_data %>% select(grit_ability_to_finish_projects_2013, grit_diligence_2013, grit_setbacks_not_discourage_2013), dofa=F, fillmissing=F, normalizeit=T)

new_data$agreeableness <- getpc(new_data %>% select(personality_sympathetic_warm, personality_critical_quarrelsome, trustful, difficult, agreeable), dofa=F, fillmissing=F, normalizeit=T)
new_data$optimism <- -getpc(new_data %>% select(expects_best_uncertain_times, rarely_expects_good_things, optimistic_about_future, hardly_expects_things_to_go_well, uncertain_times_expect_best, rarely_good_things_happen, optimistic_about_future_pr, hardly_expects_things_to_go_well, uncertain_times_expect_best, rarely_good_things_happen, optimistic_about_future_pr, hardly_expect_things_go_well_pr), dofa=F, fillmissing=F, normalizeit=T)

new_data$boybadyouth <- new_data$R1487400
new_data$boybadparent <- new_data$R1487600
new_data$girlbadyouth <- new_data$R1487300
new_data$girlbadparent <- new_data$R1487500
new_data$bad_youthreport <- new_data$girlbadyouth
new_data$bad_youthreport[is.na(new_data$bad_youthreport)] <- new_data$boybadyouth[is.na(new_data$bad_youthreport)]
new_data$bad_parentreport <- new_data$girlbadparent
new_data$bad_parentreport[is.na(new_data$bad_parentreport)] <- new_data$boybadparent[is.na(new_data$bad_parentreport)]

Correlation matrix (data quality check).

correlation_matrix(new_data %>% select(fixedfocus, rulefollow, reliability, quality, hardwork, grit))

            fixedfocus  rulefollow  reliability quality     hardwork    grit       
fixedfocus  "NA"        "0.164 ***" "0.177 ***" "0.174 ***" "0.204 ***" "0.339 ***"
rulefollow  "0.164 ***" "NA"        "0.159 ***" "0.278 ***" "0.175 ***" "0.119 ***"
reliability "0.177 ***" "0.159 ***" "NA"        "0.262 ***" "0.251 ***" "0.207 ***"
quality     "0.174 ***" "0.278 ***" "0.262 ***" "NA"        "0.434 ***" "0.269 ***"
hardwork    "0.204 ***" "0.175 ***" "0.251 ***" "0.434 ***" "NA"        "0.32 ***" 
grit        "0.339 ***" "0.119 ***" "0.207 ***" "0.269 ***" "0.32 ***"  "NA"       

Results

Income as DV:

lr <- lm(data=new_data, logweightedincome ~ fixedfocus + rulefollow + reliability + quality + hardwork + grit)
summary(lr)

Call:
lm(formula = logweightedincome ~ fixedfocus + rulefollow + reliability + 
    quality + hardwork + grit, data = new_data)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.79140 -0.29473  0.01437  0.30120  1.75139 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.399241   0.007960  50.156  < 2e-16 ***
fixedfocus   0.004169   0.008824   0.472 0.636666    
rulefollow  -0.032447   0.008497  -3.818 0.000137 ***
reliability  0.043715   0.008626   5.068 4.23e-07 ***
quality      0.016834   0.009649   1.745 0.081120 .  
hardwork     0.072362   0.009859   7.340 2.63e-13 ***
grit         0.057080   0.009121   6.258 4.35e-10 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.4771 on 3607 degrees of freedom
  (5370 observations deleted due to missingness)
Multiple R-squared:  0.0651,    Adjusted R-squared:  0.06354 
F-statistic: 41.86 on 6 and 3607 DF,  p-value: < 2.2e-16

Net worth as DV:

lr <- lm(data=new_data, logweightednw ~ fixedfocus + rulefollow + reliability + quality + hardwork + grit)
summary(lr)

Call:
lm(formula = logweightednw ~ fixedfocus + rulefollow + reliability + 
    quality + hardwork + grit, data = new_data)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.9149 -0.8172 -0.1090  0.7431  2.8043 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -0.61959    0.01781 -34.793  < 2e-16 ***
fixedfocus  -0.03160    0.01962  -1.610 0.107473    
rulefollow  -0.02322    0.01885  -1.232 0.218066    
reliability  0.11669    0.01909   6.114 1.10e-09 ***
quality      0.04131    0.02124   1.945 0.051908 .  
hardwork     0.07093    0.02151   3.298 0.000985 ***
grit         0.08566    0.02031   4.218 2.54e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.9739 on 2995 degrees of freedom
  (5982 observations deleted due to missingness)
Multiple R-squared:  0.04058,   Adjusted R-squared:  0.03866 
F-statistic: 21.11 on 6 and 2995 DF,  p-value: < 2.2e-16

Some observations: - Tendency to work hard and grit predict both income and net worth - Wanting to follow rules negatively predicts income, and probably net worth too. The p-value is iffy, but the priors are strong given that it negatively predicts income, and income correlates positively with net worth. - Reliability predicts net worth more than income - Having a fixed focus and high standards are not that important

Trying bayesian model averaging to test for whether certain confounders (e.g. race, sex, agreeableness, optimism, parent report of bad behavior, youth report of bad behavior)

ind <- subset(new_data, select=c('fixedfocus', 'rulefollow', 'reliability', 'quality', 'grit', 'hardwork', 'logweightedincome', 'agreeableness', 'optimism', 'bad_parentreport', 'bad_youthreport', 'race', 'Female', 'IQ'))
ind <- na.omit(ind)
nrow(ind)

[1] 1782

names <- c('fixedfocus', 'rulefollow', 'reliability', 'quality', 'hardwork', 'grit', 'logweightedincome', 'agreeableness', 'optimism', 'bad_parentreport', 'bad_youthreport', 'IQ')
for(name in names) {
  ind[[name]] = normalise(ind[[name]])
}

bmalol <- bicreg(x = ind %>% select(-logweightedincome), y = ind$logweightedincome, maxCol=50, nbest=1000, strict=TRUE)
summary(bmalol)

Call:
bicreg(x = ind %>% select(-logweightedincome), y = ind$logweightedincome,     strict = TRUE, maxCol = 50, nbest = 1000)


  4  models were selected
 Best  4  models (cumulative posterior probability =  1 ): 

                  p!=0    EV       SD       model 1     model 2     model 3     model 4   
Intercept         100.0   0.25566  0.03178     0.25881     0.25383     0.25466     0.24814
fixedfocus          0.0   0.00000  0.00000       .           .           .           .    
rulefollow          0.0   0.00000  0.00000       .           .           .           .    
reliability        61.1   0.03919  0.03575     0.06074       .         0.06996       .    
quality            72.6   0.05609  0.04059     0.07260     0.08256       .           .    
grit              100.0   0.10665  0.02273     0.10061     0.10840     0.11106     0.12191
hardwork          100.0   0.11241  0.02785     0.10092     0.10704     0.13305     0.14545
agreeableness       0.0   0.00000  0.00000       .           .           .           .    
optimism            0.0   0.00000  0.00000       .           .           .           .    
bad_parentreport  100.0  -0.08858  0.02162    -0.08679    -0.08972    -0.08900    -0.09280
bad_youthreport     0.0   0.00000  0.00000       .           .           .           .    
raceBlack         100.0  -0.20417  0.05192    -0.20784    -0.20255    -0.20229    -0.19518
raceHispanic        0.0   0.00000  0.00000       .           .           .           .    
raceOther           0.0   0.00000  0.00000       .           .           .           .    
raceWhite           0.0   0.00000  0.00000       .           .           .           .    
Female            100.0  -0.41516  0.04189    -0.41969    -0.41227    -0.41408    -0.40445
IQ                100.0   0.30708  0.02391     0.30634     0.31342     0.29898     0.30612
                                                                                          
nVar                                             8           7           7           6    
r2                                             0.254       0.251       0.250       0.246  
BIC                                         -462.00833  -461.72474  -460.89265  -457.95054
post prob                                      0.389       0.337       0.223       0.051  

Largely the same results, though wanting to follow rules is no longer predictive. (Note: PIP < 90% results should not be trusted).

Looking through the regression options, it seems that controlling for sex dents the rule following the most. Then, controlling for IQ eliminates it.

lr <- lm(data=new_data, logweightedincome ~ fixedfocus + rulefollow + reliability + quality + hardwork + grit + Female)
summary(lr)

Call:
lm(formula = logweightedincome ~ fixedfocus + rulefollow + reliability + 
    quality + hardwork + grit + Female, data = new_data)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.89657 -0.27516  0.01014  0.29432  1.69089 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.5069072  0.0110758  45.767  < 2e-16 ***
fixedfocus  -0.0001291  0.0086124  -0.015   0.9880    
rulefollow  -0.0164354  0.0083706  -1.963   0.0497 *  
reliability  0.0523567  0.0084373   6.205 6.07e-10 ***
quality      0.0212911  0.0094165   2.261   0.0238 *  
hardwork     0.0748826  0.0096173   7.786 8.96e-15 ***
grit         0.0533609  0.0088998   5.996 2.22e-09 ***
Female      -0.2151049  0.0157822 -13.630  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.4653 on 3606 degrees of freedom
  (5370 observations deleted due to missingness)
Multiple R-squared:  0.1109,    Adjusted R-squared:  0.1092 
F-statistic: 64.26 on 7 and 3606 DF,  p-value: < 2.2e-16

lr <- lm(data=new_data, logweightedincome ~ fixedfocus + rulefollow + reliability + quality + hardwork + grit + Female + IQ)
summary(lr)

Call:
lm(formula = logweightedincome ~ fixedfocus + rulefollow + reliability + 
    quality + hardwork + grit + Female + IQ, data = new_data)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.94350 -0.27031  0.01621  0.27188  1.40240 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -0.8330223  0.0589837 -14.123  < 2e-16 ***
fixedfocus   0.0225964  0.0088935   2.541 0.011111 *  
rulefollow   0.0016669  0.0084701   0.197 0.843998    
reliability  0.0188497  0.0086527   2.178 0.029450 *  
quality      0.0440178  0.0097353   4.521 6.38e-06 ***
hardwork     0.0485679  0.0099188   4.897 1.03e-06 ***
grit         0.0344693  0.0091527   3.766 0.000169 ***
Female      -0.2054886  0.0159668 -12.870  < 2e-16 ***
IQ           0.0133574  0.0005688  23.485  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.4264 on 2960 degrees of freedom
  (6015 observations deleted due to missingness)
Multiple R-squared:  0.248, Adjusted R-squared:  0.246 
F-statistic:   122 on 8 and 2960 DF,  p-value: < 2.2e-16

Artefact arises out of these two correlations:

cor.test(new_data$IQ, new_data$rulefollow)

    Pearson's product-moment correlation

data:  new_data$IQ and new_data$rulefollow
t = -6.0218, df = 5933, p-value = 1.829e-09
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.10317802 -0.05260263
sample estimates:
        cor 
-0.07794047 

cor.test(new_data$rulefollow, new_data$Female)

    Pearson's product-moment correlation

data:  new_data$rulefollow and new_data$Female
t = 14.864, df = 7407, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.1479895 0.1922130
sample estimates:
      cor 
0.1701869 

I also tested what could be called the “Jensen hypothesis”, which is that the subfactors that best measure conscientiousness are also the ones that are the most predictive. Six factors is not enough power to test it, so I tested the theory at the item level.

stestlist <- c('grit_maintaining_focus_2013', 'grit_change_goals_frequently_2013', 'grit_short_term_obsessions_2013', 'grit_new_ideas_distract_2013', 'grit_setbacks_not_discourage_2013', 'grit_diligence_2013', 'grit_ability_to_finish_projects_2013', 'grit_hard_worker_2013', 'personality_effort_at_work', 'personality_work_standards', 'personality_amount_of_work', 'personality_hard_worker', 'personality_dependable_disciplined', 'undependable', 'thorough', 'conscientious', 'personality_bending_rules', 'personality_support_for_rules_traditions', 'personality_breaking_school_rules', 'personality_following_rules')
debi <- jensen_vectors(new_data, stlist=stestlist, ovector='logweightedincome')

cor.test(debi$r, debi$l)

    Pearson's product-moment correlation

data:  debi$r and debi$l
t = 5.3401, df = 18, p-value = 4.473e-05
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.5209514 0.9101447
sample estimates:
      cor 
0.7829722 

Looks good. But there is a problem:

fit2 <- lm(data=debi, r ~ l)

uzi3 <- seq(from=-0.6, to=0.6, by=0.01)
uzi4 <- data.frame(l=uzi3)
uzi4$fit = predict(fit2, uzi4, interval = "confidence")

p <- ggplot(uzi4) +
  geom_point(mapping = aes(x=l, y=r), data=debi) +
  geom_line(data = uzi4, aes(x = l, y = fit[, 1]), color = "green", size = 1) +
  geom_ribbon(data = uzi4, aes(x = l, ymin = fit[, 2], ymax = fit[, 3]), alpha = 0.45) + 
  geom_text(data = debi, aes(x = l, y = r, label = v), vjust = -.44, size = 4) + 
  labs(title = "") +
  xlab('consc-loading') +
  ylab('Correlation with Income') +
  theme_bw() +
  theme(
    axis.text.x = element_text(size = 12),
    axis.text.y = element_text(size = 12),
    axis.title.x = element_text(size = 14),
    axis.title.y = element_text(size = 14),
    legend.position = "right",
    plot.background = element_rect(fill = "white")
  )

p

Some items have negative and positive loadings, so the correlation could easily be an artefact of this. Taking the absolute values of both:

cor.test(abs(debi$r), abs(debi$l))

    Pearson's product-moment correlation

data:  abs(debi$r) and abs(debi$l)
t = 0.89854, df = 18, p-value = 0.3808
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.2590823  0.5951465
sample estimates:
     cor 
0.207193 

Little correlation, if any.

Conclusion

Hard work, reliability, and reliability seem are the three conscientiousness facets most robustly linked to income and net worth. Being willing to follow rules, having high standards (though only 2 items were used to calcualte this facet), and having a more fixed focus/longer attention span don’t predict much independent of the other facets. The method of correlated vectors suggests that the correlation is not primarily on the general factor, if at all.