Principal Components For this homework, you are to use the technique of Principal Components Analysis (PCA) to perform a variable reduction of at least 5 variables. If you have an idea for latent construct, state what you believe this is. Report the summary statistics and correlation matrix for your data Report the results of the PCA, being sure to include the eigenvalues and corresponding vectors. Interpret your component(s) if possible If deemed appropriate, conduct some testing of your index/components/latent variables.

hardtoget<-haven::read_xpt("/Users/christacrumrine/Downloads/LLCP2020.XPT ")
names(hardtoget)<-tolower(gsub(pattern = "_", replacement = "",x=names(hardtoget)))
hardtogetb<-hardtoget%>%

filter(complete.cases(llcpwt, ststr, marst, stroke, hvdiab, drink, smoked))%>%

   select(llcpwt, ststr, gender, race, marst, stroke, hvdiab, drink, IADLcare, ADLcare, smoked)%>%
mutate_at(vars( stroke, hvdiab, drink, IADLcare, ADLcare), scale)
hardtoget.pc <-PCA(hardtogetb[,6:11], 
                  scale.unit = T,
                  graph = F)
## Warning in PCA(hardtogetb[, 6:11], scale.unit = T, graph = F): Missing values
## are imputed by the mean of the variable: you should use the imputePCA function
## of the missMDA package

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

eigenvalues <- hardtoget.pc$eig
head(eigenvalues[, 1:2])
##        eigenvalue percentage of variance
## comp 1  1.3020997               21.70166
## comp 2  1.1083792               18.47299
## comp 3  1.0000000               16.66667
## comp 4  0.9570000               15.95000
## comp 5  0.9341063               15.56844
## comp 6  0.6984148               11.64025
fviz_screeplot(hardtoget.pc, ncp=10)

hardtoget.pc$var
## $coord
##                  Dim.1         Dim.2         Dim.3         Dim.4         Dim.5
## stroke   -2.355482e-02  6.423210e-01  1.155517e-13 -1.919114e-01  7.416172e-01
## hvdiab    4.871519e-02  5.654530e-01 -1.706460e-13  7.954993e-01 -2.109791e-01
## drink     5.849169e-03 -6.129162e-01 -5.765369e-14  5.339944e-01  5.823545e-01
## IADLcare  8.055611e-01 -1.851281e-02  1.123509e-14 -4.526759e-02  1.346326e-02
## ADLcare   8.063553e-01  7.542398e-03  9.415966e-15 -1.231586e-02  1.673553e-02
## smoked   -5.271278e-15 -1.292833e-14  1.000000e+00  1.893347e-13 -8.842888e-14
## 
## $cor
##                  Dim.1         Dim.2         Dim.3         Dim.4         Dim.5
## stroke   -2.355482e-02  6.423210e-01  1.155517e-13 -1.919114e-01  7.416172e-01
## hvdiab    4.871519e-02  5.654530e-01 -1.706460e-13  7.954993e-01 -2.109791e-01
## drink     5.849169e-03 -6.129162e-01 -5.765369e-14  5.339944e-01  5.823545e-01
## IADLcare  8.055611e-01 -1.851281e-02  1.123509e-14 -4.526759e-02  1.346326e-02
## ADLcare   8.063553e-01  7.542398e-03  9.415966e-15 -1.231586e-02  1.673553e-02
## smoked   -5.271278e-15 -1.292833e-14  1.000000e+00  1.893347e-13 -8.842888e-14
## 
## $cos2
##                 Dim.1        Dim.2        Dim.3        Dim.4        Dim.5
## stroke   5.548297e-04 4.125763e-01 1.335219e-26 3.683000e-02 5.499960e-01
## hvdiab   2.373170e-03 3.197371e-01 2.912005e-26 6.328191e-01 4.451217e-02
## drink    3.421278e-05 3.756663e-01 3.323949e-27 2.851501e-01 3.391368e-01
## IADLcare 6.489287e-01 3.427240e-04 1.262272e-28 2.049155e-03 1.812593e-04
## ADLcare  6.502088e-01 5.688776e-05 8.866042e-29 1.516803e-04 2.800779e-04
## smoked   2.778637e-29 1.671416e-28 1.000000e+00 3.584763e-26 7.819666e-27
## 
## $contrib
##                 Dim.1        Dim.2        Dim.3        Dim.4        Dim.5
## stroke   4.261038e-02 3.722338e+01 1.335219e-24 3.848485e+00 5.887938e+01
## hvdiab   1.822572e-01 2.884726e+01 2.912005e-24 6.612530e+01 4.765214e+00
## drink    2.627509e-03 3.389330e+01 3.323949e-25 2.979624e+01 3.630602e+01
## IADLcare 4.983710e+01 3.092118e-02 1.262272e-26 2.141227e-01 1.940457e-02
## ADLcare  4.993541e+01 5.132518e-03 8.866042e-27 1.584956e-02 2.998351e-02
## smoked   2.133966e-27 1.507982e-26 1.000000e+02 3.745834e-24 8.371280e-25

According to the results I would remove smoked and stroke because of the negative results. This is telling me that there is no relationship between those and the other variables.

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

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

Report the summary statistics and correlation matrix for your data

desc<- dimdesc(hardtoget.pc)
desc$Dim.1
## $quanti
##          correlation      p.value
## ADLcare   0.80635526 0.000000e+00
## IADLcare  0.80556110 0.000000e+00
## hvdiab    0.04871519 4.599201e-16
## stroke   -0.02355482 8.665847e-05
## 
## attr(,"class")
## [1] "condes" "list"
desc$Dim.2
## $quanti
##          correlation   p.value
## stroke    0.64232100 0.0000000
## hvdiab    0.56545299 0.0000000
## IADLcare -0.01851281 0.0020367
## drink    -0.61291620 0.0000000
## 
## attr(,"class")
## [1] "condes" "list"
hardtogetb$pc1 <- hardtoget.pc$ind$coord[, 1]

options(survey.lonely.psu = "adjust")
des<- svydesign( ids= ~1,
                 strata = ~ststr,
                 weights= ~llcpwt,
                 data= hardtogetb)
library(ggplot2)
ggplot(aes(x=race, y=pc1, group=race),
       data=hardtogetb) +
  geom_boxplot()

ggplot(aes(x=gender, y=pc1, group=gender),
       data=hardtogetb) +
  geom_boxplot()

ggplot(aes(x=marst, y=pc1),
       data=hardtogetb) +
  geom_boxplot()

#If deemed appropriate, conduct some testing of your index/components/latent variables.

fit.1 <- svyglm(pc1~  marst + race, 
              des,
              family= gaussian)
summary(fit.1)
## 
## Call:
## svyglm(formula = pc1 ~ marst + race, design = des, family = gaussian)
## 
## Survey design:
## svydesign(ids = ~1, strata = ~ststr, weights = ~llcpwt, data = hardtogetb)
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)  
## (Intercept)     0.52637    0.23877   2.205   0.0275 *
## marstdivorced   0.02652    0.15055   0.176   0.8602  
## marstmarried    0.01196    0.16326   0.073   0.9416  
## marstnm        -0.05977    0.17389  -0.344   0.7311  
## marstseparated -0.08378    0.23136  -0.362   0.7173  
## marstwidowed   -1.21718    0.82101  -1.483   0.1383  
## race77         -0.52421    0.20946  -2.503   0.0124 *
## race99         -0.24079    0.29157  -0.826   0.4089  
## raceblack      -0.25434    0.22989  -1.106   0.2686  
## racenhwhite    -0.41058    0.22278  -1.843   0.0654 .
## raceother      -0.49809    0.31932  -1.560   0.1189  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 2.934168)
## 
## Number of Fisher Scoring iterations: 2
LS0tCnRpdGxlOiAiSG9tZXdvcmsgNyAiCmF1dGhvcjogIkJyeWFuIFNvbG9tb24iCmRhdGU6ICIyLzI0LzIwMjIiCm91dHB1dDoKICAgaHRtbF9kb2N1bWVudDoKICAgIGRmX3ByaW50OiBwYWdlZAogICAgZmlnX2hlaWdodDogNwogICAgZmlnX3dpZHRoOiA3CiAgICB0b2M6IHllcwogICAgdG9jX2Zsb2F0OiB5ZXMKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKLS0tCgoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgoKYGBge3IgaW5jbHVkZT1GQUxTRX0KbGlicmFyeShmYWN0b2V4dHJhLCBxdWlldGx5ID0gVCkKbGlicmFyeShGYWN0b01pbmVSLCBxdWlldGx5ID0gVCkKbGlicmFyeShzdGFyZ2F6ZXIsIHF1aWV0bHkgPSBUKQpsaWJyYXJ5KHN1cnZleSwgcXVpZXRseSA9IFQpCmxpYnJhcnkoY2FyLCBxdWlldGx5ID0gVCkKbGlicmFyeShxdWVzdGlvbnIsIHF1aWV0bHkgPSBUKQpsaWJyYXJ5KGRwbHlyLCBxdWlldGx5ID0gVCkKbGlicmFyeShmb3JjYXRzLCBxdWlldGx5ID0gVCkKbGlicmFyeSh0aWR5dmVyc2UsIHF1aWV0bHkgPSBUKQpsaWJyYXJ5KHNydnlyLCBxdWlldGx5ID0gVCkKbGlicmFyeSggZ3RzdW1tYXJ5LCBxdWlldGx5ID0gVCkKbGlicmFyeShjYXJldCwgcXVpZXRseSA9IFQpCmxpYnJhcnkoVkdBTSwgcXVpZXRseSA9IFQpCmxpYnJhcnkoZ2dwbG90MiwgcXVpZXRseSA9IFQpCmxpYnJhcnkoc3Z5VkdBTSwgcXVpZXRseSA9IFQpCmBgYAoKUHJpbmNpcGFsIENvbXBvbmVudHMKRm9yIHRoaXMgaG9tZXdvcmssIHlvdSBhcmUgdG8gdXNlIHRoZSB0ZWNobmlxdWUgb2YgUHJpbmNpcGFsIENvbXBvbmVudHMgQW5hbHlzaXMKKFBDQSkgdG8gcGVyZm9ybSBhIHZhcmlhYmxlIHJlZHVjdGlvbiBvZiBhdCBsZWFzdCA1IHZhcmlhYmxlcy4KSWYgeW91IGhhdmUgYW4gaWRlYSBmb3IgbGF0ZW50IGNvbnN0cnVjdCwgc3RhdGUgd2hhdCB5b3UgYmVsaWV2ZSB0aGlzIGlzLgpSZXBvcnQgdGhlIHN1bW1hcnkgc3RhdGlzdGljcyBhbmQgY29ycmVsYXRpb24gbWF0cml4IGZvciB5b3VyIGRhdGEKUmVwb3J0IHRoZSByZXN1bHRzIG9mIHRoZSBQQ0EsIGJlaW5nIHN1cmUgdG8gaW5jbHVkZSB0aGUgZWlnZW52YWx1ZXMgYW5kCmNvcnJlc3BvbmRpbmcgdmVjdG9ycy4gSW50ZXJwcmV0IHlvdXIgY29tcG9uZW50KHMpIGlmIHBvc3NpYmxlCklmIGRlZW1lZCBhcHByb3ByaWF0ZSwgY29uZHVjdCBzb21lIHRlc3Rpbmcgb2YgeW91ciBpbmRleC9jb21wb25lbnRzL2xhdGVudAp2YXJpYWJsZXMuCgpgYGB7cn0KaGFyZHRvZ2V0PC1oYXZlbjo6cmVhZF94cHQoIi9Vc2Vycy9jaHJpc3RhY3J1bXJpbmUvRG93bmxvYWRzL0xMQ1AyMDIwLlhQVCAiKQpgYGAKCmBgYHtyfQpuYW1lcyhoYXJkdG9nZXQpPC10b2xvd2VyKGdzdWIocGF0dGVybiA9ICJfIiwgcmVwbGFjZW1lbnQgPSAiIix4PW5hbWVzKGhhcmR0b2dldCkpKQpgYGAKCgoKYGBge3IsIGVjaG89RkFMU0V9CgoKI0hvdXJzIG9mIHRpbWUgc3BlbnQgYXMgcHJvdmlkZXIgCmhhcmR0b2dldCRob3Vyc29mY2FyZTwtUmVjb2RlKGhhcmR0b2dldCRjcmd2aHJzMSwgcmVjb2Rlcz0iMT0xOyAyPTI7IDM9MzsgND00OyBlbHNlPU5BIiwgYXMuZmFjdG9yID0gVCkKaGFyZHRvZ2V0JGhvdXJzb2ZjYXJlPC1yZWxldmVsKGhhcmR0b2dldCRob3Vyc29mY2FyZSwgcmVmID0gIjEiKQoKCiNzZXgKaGFyZHRvZ2V0JG1hbGU8LWFzLmZhY3RvcihpZmVsc2UoaGFyZHRvZ2V0JGNvbGdzZXg9PTEsICJNYWxlIiwgIkZlbWFsZSIpKQoKaGFyZHRvZ2V0JGdlbmRlcjwtYXMuZmFjdG9yKGlmZWxzZShoYXJkdG9nZXQkY29sZ3NleD09MSwgIk1hbGUiLCAiRmVtYWxlIikpCgoKI21hcml0YWwgc3RhdHVzCmhhcmR0b2dldCRtYXJzdDwtUmVjb2RlKGhhcmR0b2dldCRtYXJpdGFsLCByZWNvZGVzPSIxPSdtYXJyaWVkJzsgMj0nZGl2b3JjZWQnOyAzPSd3aWRvd2VkJzsgND0nc2VwYXJhdGVkJzsgNT0nbm0nOzY9J2NvaGFiJzsgZWxzZT1OQSIsIGFzLmZhY3Rvcj1UKQoKCiNkZXByZXNzaW9uCmhhcmR0b2dldCRkZXByZXNzaW9uPC1SZWNvZGUoaGFyZHRvZ2V0JGFkZGVwZXYzLCByZWNvZGVzPSIxPTE7IDI9MDsgZWxzZT1OQSIpCgojYXNzaXN0IHBlcnNvbmFsIGNhcmUKaGFyZHRvZ2V0JEFETGNhcmU8LVJlY29kZShoYXJkdG9nZXQkY3JndnBlcjEsIHJlY29kZXM9IjE9MTsgMj0wOyBlbHNlPU5BIikKCiNhc3Npc3QgaG9tZSB0YXNrcwpoYXJkdG9nZXQkSUFETGNhcmU8LVJlY29kZShoYXJkdG9nZXQkY3JndmhvdTEsIHJlY29kZXM9IjE9MTsgMj0wOyBlbHNlPU5BIikKCiNyYWNlL2V0aG5pY2l0eQpoYXJkdG9nZXQkcmFjZTwtUmVjb2RlKGhhcmR0b2dldCRjcHJhY2UsIHJlY29kZXM9IjE9J25od2hpdGUnOyAyPSdibGFjayc7IDM6Nj0nb3RoZXInOyBhcy5mYWN0b3IgPSBUIikKCiNEcmluayBhbGNvaG9sCmhhcmR0b2dldCRkcmluazwtUmVjb2RlKGhhcmR0b2dldCRkcm5rYW55NSwgcmVjb2Rlcz0iMT0xOyAyPTA7IGVsc2U9TkEiKQoKI1Rha2UgZHJ1Z3MgZm9yIGRpYWJldGVzCmhhcmR0b2dldCRkaWFibWVkPC1SZWNvZGUoaGFyZHRvZ2V0JGRpYWJlZHUsIHJlY29kZXM9IjE9MTsgMj0wOyBlbHNlPU5BIikKCiNoYXZlIHlvdSBiZWVuIHRvbGQgeW91IGhhdmUgZGlhYmV0ZXMKaGFyZHRvZ2V0JGh2ZGlhYjwtUmVjb2RlKGhhcmR0b2dldCRwcmVkaWFiMSwgcmVjb2Rlcz0iMToyPTE7IDM9MDsgZWxzZT1OQSIpCgojRXZlciBoYWQgYSBzdHJva2UKaGFyZHRvZ2V0JHN0cm9rZTwtUmVjb2RlKGhhcmR0b2dldCRjdmRzdHJrMywgcmVjb2Rlcz0iMT0xOyAyPTA7IGVsc2U9TkEiKQoKI1Ntb2tlZCBhdCBsZWFzdCAxMDAgZGF5cwpoYXJkdG9nZXQkc21va2VkPC1SZWNvZGUoaGFyZHRvZ2V0JHNtb2tkYXkyLCByZWNvZGVzPSIxOjI9MTsgMj0wOyBlbHNlPU5BIikKYGBgCgoKCmBgYHtyfQpoYXJkdG9nZXRiPC1oYXJkdG9nZXQlPiUKCmZpbHRlcihjb21wbGV0ZS5jYXNlcyhsbGNwd3QsIHN0c3RyLCBtYXJzdCwgc3Ryb2tlLCBodmRpYWIsIGRyaW5rLCBzbW9rZWQpKSU+JQoKICAgc2VsZWN0KGxsY3B3dCwgc3RzdHIsIGdlbmRlciwgcmFjZSwgbWFyc3QsIHN0cm9rZSwgaHZkaWFiLCBkcmluaywgSUFETGNhcmUsIEFETGNhcmUsIHNtb2tlZCklPiUKbXV0YXRlX2F0KHZhcnMoIHN0cm9rZSwgaHZkaWFiLCBkcmluaywgSUFETGNhcmUsIEFETGNhcmUpLCBzY2FsZSkKYGBgCgoKYGBge3J9CmhhcmR0b2dldC5wYyA8LVBDQShoYXJkdG9nZXRiWyw2OjExXSwgCiAgICAgICAgICAgICAgICAgIHNjYWxlLnVuaXQgPSBULAogICAgICAgICAgICAgICAgICBncmFwaCA9IEYpCmBgYAojUmVwb3J0IHRoZSByZXN1bHRzIG9mIHRoZSBQQ0EsIGJlaW5nIHN1cmUgdG8gaW5jbHVkZSB0aGUgZWlnZW52YWx1ZXMgYW5kIGNvcnJlc3BvbmRpbmcgdmVjdG9ycy4gSW50ZXJwcmV0IHlvdXIgY29tcG9uZW50KHMpIGlmIHBvc3NpYmxlCmBgYHtyfQplaWdlbnZhbHVlcyA8LSBoYXJkdG9nZXQucGMkZWlnCmhlYWQoZWlnZW52YWx1ZXNbLCAxOjJdKQpgYGAKCmBgYHtyfQpmdml6X3NjcmVlcGxvdChoYXJkdG9nZXQucGMsIG5jcD0xMCkKYGBgCgpgYGB7cn0KaGFyZHRvZ2V0LnBjJHZhcgpgYGAKQWNjb3JkaW5nIHRvIHRoZSByZXN1bHRzIEkgd291bGQgcmVtb3ZlIHNtb2tlZCBhbmQgc3Ryb2tlIGJlY2F1c2Ugb2YgdGhlIG5lZ2F0aXZlIHJlc3VsdHMuIFRoaXMgaXMgdGVsbGluZyBtZSB0aGF0IHRoZXJlIGlzIG5vIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIHRob3NlIGFuZCB0aGUgb3RoZXIgdmFyaWFibGVzLgoKYGBge3J9CmZ2aXpfcGNhX3ZhcihoYXJkdG9nZXQucGMsCiAgICAgICAgICAgICBjb2wudmFyPSAiY29udHJpYiIpKwogIHRoZW1lX21pbmltYWwoKQpgYGAKCmBgYHtyfQpmdml6X3BjYV9pbmQoaGFyZHRvZ2V0LnBjLAogICAgICAgICAgICAgbGFiZWw9ICJub25lIiwKICAgICAgICAgICAgIGNvbC5pbmQ9ICJjb3MyIikgKwogIHNjYWxlX2NvbG9yX2dyYWRpZW50Mihsb3c9ICJibHVlIiwKICAgICAgICAgICAgICAgICAgICAgICAgbWlkPSAid2hpdGUiLAogICAgICAgICAgICAgICAgICAgICAgICBoaWdoPSAicmVkIiwKICAgICAgICAgICAgICAgICAgICAgICAgbWlkcG9pbnQgPSAuNSkgKwogIHRoZW1lX21pbmltYWwoKQpgYGAKCgojIFJlcG9ydCB0aGUgc3VtbWFyeSBzdGF0aXN0aWNzIGFuZCBjb3JyZWxhdGlvbiBtYXRyaXggZm9yIHlvdXIgZGF0YQpgYGB7cn0KZGVzYzwtIGRpbWRlc2MoaGFyZHRvZ2V0LnBjKQpkZXNjJERpbS4xCmBgYAoKCmBgYHtyfQpkZXNjJERpbS4yCmBgYAoKCmBgYHtyfQpoYXJkdG9nZXRiJHBjMSA8LSBoYXJkdG9nZXQucGMkaW5kJGNvb3JkWywgMV0KCm9wdGlvbnMoc3VydmV5LmxvbmVseS5wc3UgPSAiYWRqdXN0IikKZGVzPC0gc3Z5ZGVzaWduKCBpZHM9IH4xLAogICAgICAgICAgICAgICAgIHN0cmF0YSA9IH5zdHN0ciwKICAgICAgICAgICAgICAgICB3ZWlnaHRzPSB+bGxjcHd0LAogICAgICAgICAgICAgICAgIGRhdGE9IGhhcmR0b2dldGIpCmBgYAoKYGBge3J9CmxpYnJhcnkoZ2dwbG90MikKZ2dwbG90KGFlcyh4PXJhY2UsIHk9cGMxLCBncm91cD1yYWNlKSwKICAgICAgIGRhdGE9aGFyZHRvZ2V0YikgKwogIGdlb21fYm94cGxvdCgpCmBgYAoKYGBge3J9CmdncGxvdChhZXMoeD1nZW5kZXIsIHk9cGMxLCBncm91cD1nZW5kZXIpLAogICAgICAgZGF0YT1oYXJkdG9nZXRiKSArCiAgZ2VvbV9ib3hwbG90KCkKYGBgCgoKYGBge3J9CmdncGxvdChhZXMoeD1tYXJzdCwgeT1wYzEpLAogICAgICAgZGF0YT1oYXJkdG9nZXRiKSArCiAgZ2VvbV9ib3hwbG90KCkKYGBgCgoKI0lmIGRlZW1lZCBhcHByb3ByaWF0ZSwgY29uZHVjdCBzb21lIHRlc3Rpbmcgb2YgeW91ciBpbmRleC9jb21wb25lbnRzL2xhdGVudCB2YXJpYWJsZXMuCgpgYGB7cn0KZml0LjEgPC0gc3Z5Z2xtKHBjMX4gIG1hcnN0ICsgcmFjZSwgCiAgICAgICAgICAgICAgZGVzLAogICAgICAgICAgICAgIGZhbWlseT0gZ2F1c3NpYW4pCnN1bW1hcnkoZml0LjEpCmBgYAoK