7283_HW7

Survey Data Source: National Household Education Surveys (NHES) Program 2019: Parent and Family Involvement in Education (PFI)

Developing an Index of “Student Success” – Higher is better

Variable 1: enjoy_school; Item 50: SEENJOY “How much do you agree or disagree with ‘This child enjoys school’”

Variable 2: charter_school; Item 32: SCHRTSCHL “Is this school a charter school?”

Variable 3: magnet_school; Item 33: SCHLMAGNET “Is this school a magnet school or does he/she attend a magnet program?”

Variable 4: overall_grades; Item 51: SEGRADES “Overall, across all subjects, what grades does this child get?”

Variable 5: time_absent; Item 54: SEABSNT “Since the beginning of this school year, how many days has this child been absent from school?” (Recoded - higher value means less time absent, lower value means more time absent)

Variable 6: times_participated; Item 61: FSFREQ “During this school year, how many times has any adult in the household gone to meetings or participated in activities at this child’s school?”

Variable 7: hours_hw_perweek; Item 66: FHWKHRS “In an average week, how many hours does this child spend on homework outside of school?”

Variable 8: parent_interaction; Item 64E: FCSUPPRT “How satisfied or dissatisfied are you with the way that school staff interacts with parents?”

Categorical Variable 1: parent_educ; PARGRADEX “Parent/guardian highest education”

Categorical Variable 2: race_eth; RACEETH “Race and ethnicity of child”

Categorical Variable 3: expectation; Item 144: SEFUTUREX “How far do you expect this child to go in his or her education?”

hw7data <- pfi19 %>%
  select (enjoy_school, charter_school, magnet_school, overall_grades, time_absent, times_participated, hours_hw_perweek, parent_interaction, parent_educ, race_eth, expectation, PPSU, PSTRATUM, FPWT) %>%
  filter (complete.cases(.))

1) Use PCA to perform a variable reduction of at least 5 variables.

hw7data.pc <- PCA (hw7data[, c(1:8)], 
                   scale.unit = T, 
                   graph = F)

eigenvalues <- hw7data.pc$eig

eigenvalues

##        eigenvalue percentage of variance cumulative percentage of variance
## comp 1  1.5779411              19.724264                          19.72426
## comp 2  1.0875916              13.594895                          33.31916
## comp 3  1.0802455              13.503069                          46.82223
## comp 4  0.9599272              11.999090                          58.82132
## comp 5  0.9230543              11.538179                          70.35950
## comp 6  0.8867293              11.084116                          81.44361
## comp 7  0.7830088               9.787610                          91.23122
## comp 8  0.7015022               8.768777                         100.00000

fviz_screeplot(hw7data.pc, ncp=8)

2) Report the summary statistics and correlation matrix for your data.

summary(hw7data.pc)

## 
## Call:
## PCA(X = hw7data[, c(1:8)], scale.unit = T, graph = F) 
## 
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
## Variance               1.578   1.088   1.080   0.960   0.923   0.887   0.783
## % of var.             19.724  13.595  13.503  11.999  11.538  11.084   9.788
## Cumulative % of var.  19.724  33.319  46.822  58.821  70.359  81.444  91.231
##                        Dim.8
## Variance               0.702
## % of var.              8.769
## Cumulative % of var. 100.000
## 
## Individuals (the 10 first)
##                        Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
## 1                  |  1.432 |  0.764  0.003  0.285 | -0.713  0.004  0.248 |
## 2                  |  1.199 |  0.860  0.004  0.514 | -0.497  0.002  0.171 |
## 3                  |  1.142 |  0.893  0.004  0.612 | -0.512  0.002  0.201 |
## 4                  |  1.394 |  0.992  0.005  0.507 | -0.123  0.000  0.008 |
## 5                  |  1.431 |  0.976  0.005  0.465 | -0.115  0.000  0.007 |
## 6                  |  1.185 |  0.072  0.000  0.004 | -0.462  0.002  0.152 |
## 7                  |  2.979 | -0.907  0.004  0.093 | -0.508  0.002  0.029 |
## 8                  |  2.905 | -1.596  0.014  0.302 | -0.521  0.002  0.032 |
## 9                  |  3.488 |  0.591  0.002  0.029 |  0.949  0.007  0.074 |
## 10                 |  1.016 |  0.138  0.000  0.019 | -0.493  0.002  0.236 |
##                     Dim.3    ctr   cos2  
## 1                  -0.718  0.004  0.252 |
## 2                  -0.324  0.001  0.073 |
## 3                  -0.193  0.000  0.028 |
## 4                   0.222  0.000  0.025 |
## 5                   0.157  0.000  0.012 |
## 6                  -0.664  0.004  0.314 |
## 7                  -0.026  0.000  0.000 |
## 8                   0.030  0.000  0.000 |
## 9                   1.480  0.017  0.180 |
## 10                 -0.401  0.001  0.156 |
## 
## Variables
##                       Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
## enjoy_school       |  0.701 31.136  0.491 | -0.047  0.201  0.002 | -0.175
## charter_school     |  0.034  0.075  0.001 |  0.588 31.740  0.345 | -0.384
## magnet_school      |  0.061  0.233  0.004 |  0.733 49.363  0.537 | -0.020
## overall_grades     |  0.696 30.680  0.484 | -0.014  0.019  0.000 |  0.159
## time_absent        |  0.547 18.929  0.299 | -0.132  1.611  0.018 | -0.056
## times_participated |  0.184  2.156  0.034 | -0.073  0.487  0.005 |  0.609
## hours_hw_perweek   |  0.181  2.068  0.033 |  0.424 16.516  0.180 |  0.619
## parent_interaction |  0.482 14.724  0.232 | -0.026  0.063  0.001 | -0.345
##                       ctr   cos2  
## enjoy_school        2.838  0.031 |
## charter_school     13.659  0.148 |
## magnet_school       0.037  0.000 |
## overall_grades      2.326  0.025 |
## time_absent         0.294  0.003 |
## times_participated 34.350  0.371 |
## hours_hw_perweek   35.450  0.383 |
## parent_interaction 11.046  0.119 |

hw7data.pc$var

## $coord
##                         Dim.1       Dim.2       Dim.3      Dim.4       Dim.5
## enjoy_school       0.70092924 -0.04676584 -0.17508231  0.0323651 -0.02845604
## charter_school     0.03429691  0.58754248 -0.38412224  0.3300287  0.62637469
## magnet_school      0.06069445  0.73271311 -0.02000104 -0.1260655 -0.53573266
## overall_grades     0.69577653 -0.01445093  0.15851127 -0.1057989  0.03218763
## time_absent        0.54652588 -0.13237066 -0.05639714 -0.4133403  0.28815956
## times_participated 0.18442918 -0.07275300  0.60914893  0.6629497  0.04311704
## hours_hw_perweek   0.18066033  0.42381999  0.61882989 -0.2302846  0.13013687
## parent_interaction 0.48200770 -0.02612832 -0.34543081  0.3993637 -0.37419674
## 
## $cor
##                         Dim.1       Dim.2       Dim.3      Dim.4       Dim.5
## enjoy_school       0.70092924 -0.04676584 -0.17508231  0.0323651 -0.02845604
## charter_school     0.03429691  0.58754248 -0.38412224  0.3300287  0.62637469
## magnet_school      0.06069445  0.73271311 -0.02000104 -0.1260655 -0.53573266
## overall_grades     0.69577653 -0.01445093  0.15851127 -0.1057989  0.03218763
## time_absent        0.54652588 -0.13237066 -0.05639714 -0.4133403  0.28815956
## times_participated 0.18442918 -0.07275300  0.60914893  0.6629497  0.04311704
## hours_hw_perweek   0.18066033  0.42381999  0.61882989 -0.2302846  0.13013687
## parent_interaction 0.48200770 -0.02612832 -0.34543081  0.3993637 -0.37419674
## 
## $cos2
##                          Dim.1        Dim.2        Dim.3       Dim.4
## enjoy_school       0.491301806 0.0021870436 0.0306538158 0.001047499
## charter_school     0.001176278 0.3452061714 0.1475498946 0.108918948
## magnet_school      0.003683816 0.5368685067 0.0004000415 0.015892508
## overall_grades     0.484104983 0.0002088292 0.0251258241 0.011193398
## time_absent        0.298690533 0.0175219904 0.0031806374 0.170850170
## times_participated 0.034014124 0.0052929986 0.3710624230 0.439502280
## hours_hw_perweek   0.032638154 0.1796233838 0.3829504374 0.053030981
## parent_interaction 0.232331427 0.0006826889 0.1193224421 0.159491385
##                           Dim.5
## enjoy_school       0.0008097462
## charter_school     0.3923452522
## magnet_school      0.2870094805
## overall_grades     0.0010360433
## time_absent        0.0830359328
## times_participated 0.0018590793
## hours_hw_perweek   0.0169356041
## parent_interaction 0.1400231983
## 
## $contrib
##                          Dim.1       Dim.2       Dim.3      Dim.4       Dim.5
## enjoy_school       31.13562346  0.20109052  2.83767119  0.1091228  0.08772465
## charter_school      0.07454513 31.74042235 13.65892220 11.3465846 42.50510903
## magnet_school       0.23345715 49.36306059  0.03703246  1.6555952 31.09345454
## overall_grades     30.67953400  0.01920107  2.32593644  1.1660674  0.11224077
## time_absent        18.92913041  1.61108179  0.29443653 17.7982429  8.99577950
## times_participated  2.15560161  0.48667152 34.34982303 45.7849610  0.20140518
## hours_hw_perweek    2.06840128 16.51570145 35.45031493  5.5244796  1.83473533
## parent_interaction 14.72370696  0.06277071 11.04586322 16.6149465 15.16955099

fviz_pca_var(hw7data.pc,
             col.var="contrib")+
  theme_minimal()

fviz_pca_ind(hw7data.pc,
             label="none",
             col.ind="cos2")+
  scale_color_gradient2(low="blue",
                        mid="white",
                        high="red",
                        midpoint=.5)+
  theme_minimal()

3) Report the results of the PCA, being sure to include the eigenvalues and corresponding vectors. Interpret your component(s) if possible.

eigenvalues

##        eigenvalue percentage of variance cumulative percentage of variance
## comp 1  1.5779411              19.724264                          19.72426
## comp 2  1.0875916              13.594895                          33.31916
## comp 3  1.0802455              13.503069                          46.82223
## comp 4  0.9599272              11.999090                          58.82132
## comp 5  0.9230543              11.538179                          70.35950
## comp 6  0.8867293              11.084116                          81.44361
## comp 7  0.7830088               9.787610                          91.23122
## comp 8  0.7015022               8.768777                         100.00000

The first four components account for 58.8% of the variation in the input variables.

Three eigenvalues are greater than 1, indicating three real components among these variables.

desc <- dimdesc(hw7data.pc)

desc$Dim.1

## $quanti
##                    correlation      p.value
## enjoy_school        0.70092924 0.000000e+00
## overall_grades      0.69577653 0.000000e+00
## time_absent         0.54652588 0.000000e+00
## parent_interaction  0.48200770 0.000000e+00
## times_participated  0.18442918 1.530109e-89
## hours_hw_perweek    0.18066033 6.155655e-86
## magnet_school       0.06069445 5.670152e-11
## charter_school      0.03429691 2.154719e-04
## 
## attr(,"class")
## [1] "condes" "list"

desc$Dim.2

## $quanti
##                    correlation      p.value
## magnet_school       0.73271311 0.000000e+00
## charter_school      0.58754248 0.000000e+00
## hours_hw_perweek    0.42381999 0.000000e+00
## parent_interaction -0.02612832 4.824464e-03
## enjoy_school       -0.04676584 4.496310e-07
## times_participated -0.07275300 3.930668e-15
## time_absent        -0.13237066 1.233148e-46
## 
## attr(,"class")
## [1] "condes" "list"

hw7data$pc1 <- hw7data.pc$ind$coord[, 1]

options(survey.lonely.psu = "adjust")

hw7design <- svydesign(ids = ~PPSU,
                       strata = ~PSTRATUM,
                       weights = ~FPWT,
                       data = hw7data,
                       nest = TRUE)

ggplot(aes(x=parent_educ, y=pc1, group=parent_educ),
       data = hw7data)+
  geom_boxplot()

As parent education level increases, so does the Index of Student Success.

ggplot(aes(x=race_eth, y=pc1, group=race_eth),
       data = hw7data)+
  geom_boxplot()

Minimal variation in the Index of Student Success across race/ethnicity, but the NH Asian group does show a higher Index when compared to the other four groups.

ggplot(aes(x=expectation, y=pc1, group=expectation),
       data = hw7data)+
  geom_boxplot()

In general, as parents’ expectation of child’s education potential increases, so does the Index of Student Success.

4) Conduct some testing of your index / components / latent variables (if deemed appropriate).

fit.1 <- svyglm (pc1 ~ parent_educ + race_eth + expectation,
                 hw7design,
                 family = gaussian)

summary(fit.1)

## 
## Call:
## svyglm(formula = pc1 ~ parent_educ + race_eth + expectation, 
##     design = hw7design, family = gaussian)
## 
## Survey design:
## svydesign(ids = ~PPSU, strata = ~PSTRATUM, weights = ~FPWT, data = hw7data, 
##     nest = TRUE)
## 
## Coefficients:
##                                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      -0.275053   0.213701  -1.287  0.19809    
## parent_educ0Less than HS          0.060653   0.086299   0.703  0.48218    
## parent_educ2Some College          0.003155   0.056112   0.056  0.95517    
## parent_educ3College Grad          0.131267   0.056012   2.344  0.01912 *  
## parent_educ4Grad School           0.277128   0.056019   4.947 7.64e-07 ***
## race_ethHispanic                 -0.009476   0.041120  -0.230  0.81775    
## race_ethNH Asian                  0.145571   0.068269   2.132  0.03300 *  
## race_ethNH Black                 -0.069241   0.056612  -1.223  0.22133    
## race_ethOther                    -0.150604   0.078989  -1.907  0.05659 .  
## expectation1HS Grad              -0.591335   0.233139  -2.536  0.01121 *  
## expectation2Vocational Technical -0.600834   0.221059  -2.718  0.00658 ** 
## expectation3Two Yrs College      -0.040153   0.212822  -0.189  0.85035    
## expectation4Bachelors             0.301327   0.207867   1.450  0.14719    
## expectation5Graduate Degree       0.484918   0.207057   2.342  0.01920 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.318032)
## 
## Number of Fisher Scoring iterations: 2

In general, the Index of Student Success increases with higher parent education level (significant at College Grad and Grad School levels) and parent expectation of child’s education potential (significant at HS Grad, Vocational Technical, and Graduate Degree levels). There is minimal variation in the Index of Student Success between race/ethnic groups, except for the NH Asian group, which has a significantly higher level in the Index of Student Success.