#load("E:/Dropbox/ICPSRML2020_admin/data/VB.RData")
#dta$ukpartyid
#dta$uspartyid
#dta$uspartyid7
#btp <- dta[,c("country", "ukpartyid", "uspartyid7", "authsub1", "authsub2", "authsub3", "authsub4", "authtrad1_1", "authtrad1_2", "authtrad1_3", "authtrad1_4", "authaggression_1", "authaggression_2", "authaggression_3", "authaggression_4", "roughedup", "sdo_1", "sdo_2", "sdo_3", "sdo_4", "egalitarianism_1", "egalitarianism_2", "egalitarianism_3", "egalitarianism_4", "suspicion_1", "suspicion_2", "suspicion_3", "suspicion_4", "lwa_1", "lwa_2", "lwa_3", "lwa_4", "lwa_5", "lwa_6", "populism_1", "populism_2", "populism_3", "populism_4", "happybrexit_1", "happytrump_1")]
#btp <- btp[complete.cases(btp[,c(-2,-3)]),]
#btp[,-c(1,2,3)] <- mapply(as.numeric, btp[,-c(1,2,3)])
#table(btp$uspartyid7)
#btp$uspartyid7[btp$uspartyid7 %in% 1:3] <- "1"
#btp$uspartyid7[btp$uspartyid7 == 4] <- "2"
#btp$uspartyid7[btp$uspartyid7 %in% 5:7] <- "3"
#
#btp$uspartyid7 <- factor(btp$uspartyid7, labels = c("Democrat", "Independent", "Republican"))
#colnames(btp)[3] <- "uspartyid"
# btp$pid.merge <- rep(NA, nrow(btp))
#
# unique(btp$ukpartyid)
# unique(btp$uspartyid)
#
# btp$pid.merge[btp$ukpartyid == "Conservative Party"] <- "Conservative"
# btp$pid.merge[btp$uspartyid == "Republican"] <- "Conservative"
#
# btp$pid.merge[btp$ukpartyid == "No - none"] <- "Independent"
# btp$pid.merge[btp$uspartyid == "Independent"] <- "Independent"
#
# btp$pid.merge[btp$ukpartyid == "Labour Party"] <- "Liberal"
# btp$pid.merge[btp$uspartyid == "Democrat"] <- "Liberal"
#
# btp$pid.merge <- factor(btp$pid.merge, levels = c("Liberal", "Independent", "Conservative"))
#
# btp <- cbind.data.frame(btp[,1:3], btp$pid.merge, btp[,-c(1,2,3,41)])
#
# colnames(btp)[4] <- "pid.merge"
#saveRDS(btp,"E:/Dropbox/ICPSRML2020_admin/data/BTP_cPCA.RDS")
#library(parallel)
#library(doParallel)
library(tidyverse)
library(ggrepel)
library(ggforce)
library(scPCA)
library(factoextra)
library(readit)
library(fastICA)
set.seed(1995)
PCA
cal <- readRDS("E:/Dropbox/ICPSRML2020_admin/data/cal_voters.RDS")
cal.pca <- prcomp(cal[,-1], center=T, scale=T)
cal.pca$rotation[rev(order(abs(cal.pca$rotation[,1]))), 1:3]
## PC1 PC2 PC3
## approve_trump -0.282937920 -0.032175056 0.116244411
## party 0.279404924 -0.030960656 0.012499770
## favor_kavanaugh -0.277073944 -0.012418419 0.086464889
## favor_borderwall -0.265821729 -0.063672032 0.073184115
## house_trump -0.259230391 -0.011741356 0.028396734
## approve_brown 0.249510200 -0.009722059 0.197286925
## favor_localrules 0.247859490 0.019258243 0.017240886
## favor_direction -0.241777885 -0.046857165 0.279004164
## favor_obamacare 0.241512612 -0.012177865 0.086295160
## view_republicans -0.239267618 0.043445322 0.173462971
## view_democrats 0.234410496 0.027585695 0.140412210
## approve_stateleg 0.231547345 -0.029765130 0.261358943
## ideology 0.227100002 -0.078323995 0.001777398
## size_govt -0.220401677 -0.028420446 -0.225419294
## favor_gunregs 0.206142668 -0.081001376 0.023860158
## us_econ -0.173708331 -0.107814861 0.342014750
## approve_congress -0.151919403 0.108367968 0.319014201
## cal_econ 0.110888324 -0.134489164 0.484474444
## race 0.070284757 0.343994993 0.120441277
## gender -0.058645683 -0.024112916 -0.024887836
## house_enthused 0.048871904 -0.364769370 0.256522430
## age 0.034938029 0.287813975 -0.066780424
## income 0.021506910 0.405996392 0.221631887
## education -0.017415657 0.453256040 0.275061542
## interest 0.003286214 -0.476734742 0.122699172
cal.pca$rotation[rev(order(abs(cal.pca$rotation[,2]))), 1:3]
## PC1 PC2 PC3
## interest 0.003286214 -0.476734742 0.122699172
## education -0.017415657 0.453256040 0.275061542
## income 0.021506910 0.405996392 0.221631887
## house_enthused 0.048871904 -0.364769370 0.256522430
## race 0.070284757 0.343994993 0.120441277
## age 0.034938029 0.287813975 -0.066780424
## cal_econ 0.110888324 -0.134489164 0.484474444
## approve_congress -0.151919403 0.108367968 0.319014201
## us_econ -0.173708331 -0.107814861 0.342014750
## favor_gunregs 0.206142668 -0.081001376 0.023860158
## ideology 0.227100002 -0.078323995 0.001777398
## favor_borderwall -0.265821729 -0.063672032 0.073184115
## favor_direction -0.241777885 -0.046857165 0.279004164
## view_republicans -0.239267618 0.043445322 0.173462971
## approve_trump -0.282937920 -0.032175056 0.116244411
## party 0.279404924 -0.030960656 0.012499770
## approve_stateleg 0.231547345 -0.029765130 0.261358943
## size_govt -0.220401677 -0.028420446 -0.225419294
## view_democrats 0.234410496 0.027585695 0.140412210
## gender -0.058645683 -0.024112916 -0.024887836
## favor_localrules 0.247859490 0.019258243 0.017240886
## favor_kavanaugh -0.277073944 -0.012418419 0.086464889
## favor_obamacare 0.241512612 -0.012177865 0.086295160
## house_trump -0.259230391 -0.011741356 0.028396734
## approve_brown 0.249510200 -0.009722059 0.197286925
cal.pca$rotation[order(abs(cal.pca$rotation[,3])), 1:3]
## PC1 PC2 PC3
## ideology 0.227100002 -0.078323995 0.001777398
## party 0.279404924 -0.030960656 0.012499770
## favor_localrules 0.247859490 0.019258243 0.017240886
## favor_gunregs 0.206142668 -0.081001376 0.023860158
## gender -0.058645683 -0.024112916 -0.024887836
## house_trump -0.259230391 -0.011741356 0.028396734
## age 0.034938029 0.287813975 -0.066780424
## favor_borderwall -0.265821729 -0.063672032 0.073184115
## favor_obamacare 0.241512612 -0.012177865 0.086295160
## favor_kavanaugh -0.277073944 -0.012418419 0.086464889
## approve_trump -0.282937920 -0.032175056 0.116244411
## race 0.070284757 0.343994993 0.120441277
## interest 0.003286214 -0.476734742 0.122699172
## view_democrats 0.234410496 0.027585695 0.140412210
## view_republicans -0.239267618 0.043445322 0.173462971
## approve_brown 0.249510200 -0.009722059 0.197286925
## income 0.021506910 0.405996392 0.221631887
## size_govt -0.220401677 -0.028420446 -0.225419294
## house_enthused 0.048871904 -0.364769370 0.256522430
## approve_stateleg 0.231547345 -0.029765130 0.261358943
## education -0.017415657 0.453256040 0.275061542
## favor_direction -0.241777885 -0.046857165 0.279004164
## approve_congress -0.151919403 0.108367968 0.319014201
## us_econ -0.173708331 -0.107814861 0.342014750
## cal_econ 0.110888324 -0.134489164 0.484474444
cal.pca$rotation[order(abs(cal.pca$rotation[,4])), 1:4]
## PC1 PC2 PC3 PC4
## favor_obamacare 0.241512612 -0.012177865 0.086295160 0.007068891
## favor_localrules 0.247859490 0.019258243 0.017240886 -0.010949977
## house_trump -0.259230391 -0.011741356 0.028396734 0.012140154
## favor_gunregs 0.206142668 -0.081001376 0.023860158 0.026534001
## party 0.279404924 -0.030960656 0.012499770 0.034948492
## favor_kavanaugh -0.277073944 -0.012418419 0.086464889 -0.036328379
## ideology 0.227100002 -0.078323995 0.001777398 -0.036967293
## race 0.070284757 0.343994993 0.120441277 -0.049541506
## approve_trump -0.282937920 -0.032175056 0.116244411 0.054213307
## view_republicans -0.239267618 0.043445322 0.173462971 0.061848085
## approve_congress -0.151919403 0.108367968 0.319014201 -0.062560376
## favor_direction -0.241777885 -0.046857165 0.279004164 -0.062835565
## size_govt -0.220401677 -0.028420446 -0.225419294 -0.075338770
## view_democrats 0.234410496 0.027585695 0.140412210 0.096013212
## approve_brown 0.249510200 -0.009722059 0.197286925 -0.100646931
## approve_stateleg 0.231547345 -0.029765130 0.261358943 -0.105586086
## favor_borderwall -0.265821729 -0.063672032 0.073184115 0.125657790
## interest 0.003286214 -0.476734742 0.122699172 0.198577626
## education -0.017415657 0.453256040 0.275061542 0.239855518
## us_econ -0.173708331 -0.107814861 0.342014750 -0.289685588
## house_enthused 0.048871904 -0.364769370 0.256522430 0.338881988
## cal_econ 0.110888324 -0.134489164 0.484474444 -0.354976678
## gender -0.058645683 -0.024112916 -0.024887836 -0.382935838
## income 0.021506910 0.405996392 0.221631887 0.409348270
## age 0.034938029 0.287813975 -0.066780424 -0.435994109
PCA Plots
scree.plot.cal <- fviz_eig(cal.pca)
scree.plot.cal
component.plot.cal <- fviz_pca_var(cal.pca,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), #Choose gradient colors
title = "Component Loadings Plot - PCA", #Change plot title
legend.title = "Contribution", #Change legend title
repel = TRUE) # Repel labels away from each other
component.plot.cal
## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
ind.plot.cal <- fviz_pca_ind(cal.pca,
col.ind = cal$vote_house,
palette = c("#FC4E07", "#00AFBB"), #Choose colors for Dems v. Reps
addEllipses = TRUE, #Add group ellipses
legend.title = "Congressional\nVote Choice",
title = "Individual Plot - PCA",
geom = "point",
repel = F)
ind.plot.cal
biplot.cal <- fviz_pca_biplot(cal.pca,
addEllipses = TRUE,
title = "Bi-Plot (Individual and Variable) - PCA",
geom = "point",
gradient.cols = c("springgreen3", "#E7B800", "orchid3"),
palette = c("#FC4E07", "#00AFBB"),
col.var = "contrib",
fill.ind = cal$vote_house, col.ind = "white",
pointshape = 21,
pointsize = 2,
repel = T) +
labs(fill = "Congressional\nVote Choice",
color = "Variable\nContribution")
biplot.cal
## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps