Homework 2

dat <- read.csv("Week2Data.csv")

Questions

a.

dat_new <- dat %>%
filter(dataset == "Cleveland") %>%
select(-id, -dataset) %>%
mutate(num = ifelse(num == 0, "No", "Yes"))

b.

colSums(is.na(dat_new))

     age      sex       cp trestbps     chol      fbs  restecg   thalch 
       0        0        0        0        0        0        0        0 
   exang  oldpeak    slope       ca     thal      num 
       0        0        0        5        0        0 

c.

colSums(is.na(dat_new) | dat_new == "")

     age      sex       cp trestbps     chol      fbs  restecg   thalch 
       0        0        0        0        0        0        0        0 
   exang  oldpeak    slope       ca     thal      num 
       0        0        1        5        3        0 

dat_new$slope <- na_if(dat_new$slope, "")
dat_new$thal <- na_if(dat_new$thal, "")

d.

dat_new <- dat_new %>%
mutate(
across(where(is.character), as.factor),
across(where(is.logical), as.factor)
)

e.

mice_impute <- mice(dat_new, seed = 123)
dat_imp <- complete(mice_impute, 1)

f. 

Age and ca have the strongest positive correlation (0.37), and ca and oldpeak have the second strongest (0.30). age and thalch have the strongest negative correlation (-.40), and thalch and oldpeak have the second strongest (-0.35).

data_numeric <- dat_imp %>%
  select(where(is.numeric))
cor_mat <- cor(data_numeric)
kable(round(cor_mat, 2), format = "html") %>%
  kable_styling(full_width = F, font_size = 10)

	age	trestbps	chol	thalch	oldpeak	ca
age	1.00	0.28	0.23	-0.40	0.21	0.37
trestbps	0.28	1.00	0.13	-0.05	0.19	0.10
chol	0.23	0.13	1.00	-0.01	0.05	0.13
thalch	-0.40	-0.05	-0.01	1.00	-0.35	-0.27
oldpeak	0.21	0.19	0.05	-0.35	1.00	0.30
ca	0.37	0.10	0.13	-0.27	0.30	1.00

g.

The first PC alone explains 74.98% of the variation in the original data set. The first and second PC explain 89.92% of the variation in the original data set.

pca <- prcomp(data_numeric)
  names(pca)

[1] "sdev"     "rotation" "center"   "scale"    "x"       

  summary(pca)

Importance of components:
                           PC1     PC2      PC3     PC4     PC5     PC6
Standard deviation     52.2102 23.3079 17.48752 7.66560 1.10732 0.80797
Proportion of Variance  0.7498  0.1494  0.08412 0.01616 0.00034 0.00018
Cumulative Proportion   0.7498  0.8992  0.98332 0.99948 0.99982 1.00000

h.

Chol dominated PC1, thalch dominated PC2, and trestbps dominated PC3. Due to their larger scales, these three variables had the highest variance, resulting in them carrying more weight in PCA. You should also scale variables before running PCA.

pca$rotation[ , 1:3]

                  PC1         PC2          PC3
age      -0.041751366 -0.18400118 -0.126715579
trestbps -0.049911822 -0.10117012 -0.982293036
chol     -0.997827582  0.02252561  0.053193289
thalch    0.009920235  0.97721420 -0.126981652
oldpeak  -0.001303992 -0.01794537 -0.008982926
ca       -0.002374603 -0.01145152 -0.002999127

apply(data_numeric, 2, var)

         age     trestbps         chol       thalch      oldpeak           ca 
  83.7271908  308.7382317 2715.2728852  525.6593712    1.3472012    0.8716237 

i.

sum(apply(data_numeric, 2, var))

[1] 3635.617

sum(apply(pca$x, 2, var))

[1] 3635.617

j.

cor_mat <- cor(pca$x)
kable(round(cor_mat, 2), format = "html") %>%
  kable_styling(full_width = F, font_size = 10)

	PC1	PC2	PC3	PC4	PC5	PC6
PC1	1	0	0	0	0	0
PC2	0	1	0	0	0	0
PC3	0	0	1	0	0	0
PC4	0	0	0	1	0	0
PC5	0	0	0	0	1	0
PC6	0	0	0	0	0	1

k.

The first PC explains 34.94% of the variation in the original data set. The first and second PC explain 53.11% of the variation in the original data set. There is a large difference after scaling because the variation of the original features are now more equal, meaning a couple features can no longer have significantly larger variances than the others.

pca_sc <- prcomp(data_numeric, scale = TRUE)
  summary(pca_sc)

Importance of components:
                          PC1    PC2    PC3    PC4    PC5     PC6
Standard deviation     1.4479 1.0442 0.9492 0.8716 0.8427 0.66528
Proportion of Variance 0.3494 0.1817 0.1502 0.1266 0.1184 0.07377
Cumulative Proportion  0.3494 0.5311 0.6813 0.8079 0.9262 1.00000

l.

The angle between age and ca, and the angle between ca and oldpeak are both small due to the larger positive correlation between the variables. The angle between thalch and age, and thalch and oldpeak are closer to 180 degrees due to the larger negative correlation between the variables.The angle between thalch and chol is almost 90 degrees because the variables share no correlation.

fviz_pca_var(pca_sc, col.var = "cos2",
               gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), 
               repel = TRUE)

m.

set.seed(23)
fviz_pca_ind(pca_sc, col.ind = pca_sc$x[,3], 
             select.ind = list(name = sample(1:nrow(dat_imp), 50)), 
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

n. 

Yes, they are close to each other.

scale(data_numeric)[c(51, 241), ]

           age  trestbps       chol    thalch    oldpeak         ca
[1,] -1.459191 -1.518655 -0.9272190 0.7971434 -0.8927312  0.3629102
[2,] -1.459191 -1.234094 -0.2171591 0.1429004 -0.8927312 -0.7082033

o.

Observation 3 and 51 have very different age, thalch, and oldpeak scores, and since PC1 or dim1 is heavily influenced by those variables, the observations are very far apart in dim1 of the biplot. Observation 3 is on the negative side of dim1, since its scores are the opposite sign of the weights for those variables (positive/neg score for a negative/pos weight). Observation 51 is on the positive side since its signs are the same (negative/pos score for a negative/pos weight). Observation 3 and 51 have similar chol and trestbps scores, and since PC2 or dim2 is heavily influenced by those variables, the observations aren’t super far apart in dim2 of the biplot. They’re both on the positive side since signs match.

scale(data_numeric)[c(3, 51), ]

           age   trestbps      chol     thalch    oldpeak        ca
[1,]  1.382259 -0.6649732 -0.332304 -0.9038883  1.3473157 1.4340237
[2,] -1.459191 -1.5186551 -0.927219  0.7971434 -0.8927312 0.3629102

pca_sc$rotation

                PC1        PC2        PC3         PC4         PC5        PC6
age      -0.5201885 -0.1508345 -0.1061464 -0.52689267  0.08619213  0.6405785
trestbps -0.2931992 -0.4929706  0.7427019 -0.09308449  0.09143817 -0.3199725
chol     -0.2211667 -0.6739897 -0.5153347  0.28452697 -0.36110251 -0.1410768
thalch    0.4519486 -0.4287149  0.1060637  0.35833169  0.45216554  0.5175338
oldpeak  -0.4284800  0.2840087  0.2906678  0.66220769 -0.29817699  0.3518915
ca       -0.4546105  0.1245371 -0.2753536  0.25659925  0.74863326 -0.2751458

p.

Observation 51 and 174 are on the opposite side of both dims in the biplot. This is due to them having very different scores across all variables, with the exception of thalch. Observation 51 is on the positive side in both dims, and 174 is on the negative, due to the same logic I used in question o.

scale(data_numeric)[c(51, 174), ]

            age   trestbps      chol    thalch    oldpeak         ca
[1,] -1.4591912 -1.5186551 -0.927219 0.7971434 -0.8927312  0.3629102
[2,]  0.8358265  0.4732692  2.834179 0.3173652  0.1411366 -0.7082033

q.

data_cat <- dat_imp %>%
  select(where(is.factor))

he_cont <- xtabs( ~ thal + num, data = data_cat)   
kable(he_cont)

	No	Yes
fixed defect	6	12
normal	131	37
reversable defect	28	90

r.

Reversable defect has the strongest positive relationship with having heart disease, and normal has the strongest negative relationship. Normal has the strongest positive relationship with no getting heart disease, and reversable defect has the strongest negative relationship.

chi_test <- chisq.test(he_cont)
  chi_test$residuals

                   num
thal                       No       Yes
  fixed defect      -1.206062  1.314027
  normal             4.169611 -4.542868
  reversable defect -4.504136  4.907339

s.

The angle between normal and no is extremely small since they have a strong positive relationship, the same can be said for yes and reversable defect. The angle between the opposites (normal and yes, reversable and no) are near 180 degress since those relationships are strong and negative.

he_ca <- MCA(data_cat[ , 7:8], graph = FALSE) 
fviz_mca_var(he_ca, col.var = "cos2",
             geom.var = c("arrow", "text"),
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

t.

Fixed defect is closer to reversable defect since its also positively associated with yes, and negatively associated with no, however the association isn’t as strong.

u.

The variables oldpeak and thalch seem the most associated with num. There also could be some association with ca, slope, exang, cp, and thal.

dat_famd <- FAMD(dat_imp, graph = FALSE)
fviz_famd_var(dat_famd, col.var = "cos2",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE)

v.

The really red points are observations with large positive scores on the third dimension, meaning they align strongly with the variables that load positively on Dim3. The really blue points have large negative Dim3 scores, meaning they align with the opposite pattern (variables with negative loadings on Dim3).

fviz_pca_ind(dat_famd, col.ind = dat_famd$ind$coord[,3],
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))