Exam 1

Question 1

titanic <- read.csv("ExamData.csv")

a.

Age has 177 missing values. Cabin has 687 empty strings. Embarked has 2 empty strings.

kable(colSums(is.na(titanic)))

	x
PassengerId	0
Survived	0
Pclass	0
Name	0
Sex	0
Age	177
SibSp	0
Parch	0
Ticket	0
Fare	0
Cabin	0
Embarked	0

kable(colSums(titanic == ""))

	x
PassengerId	0
Survived	0
Pclass	0
Name	0
Sex	0
Age	NA
SibSp	0
Parch	0
Ticket	0
Fare	0
Cabin	687
Embarked	2

titanic$Cabin <- na_if(titanic$Cabin, "")
titanic$Embarked<- na_if(titanic$Embarked, "")

b.

There was much more avaliable information about the first class passengers than the second and third class passengers. If class refers to wealth/status this makes sense.

titanic %>% mutate(has_na = if_any(everything(), is.na)) %>% group_by(Pclass) %>% summarise(prop_missing = mean(has_na))

# A tibble: 3 × 2
  Pclass prop_missing
   <int>        <dbl>
1      1        0.269
2      2        0.918
3      3        0.980

c.

titanic <- mutate(titanic, Deck = substr(Cabin, 1, 1))

d.

titanic <- titanic %>% select(-PassengerId, -Name, -Cabin, -Ticket)
titanic <- titanic %>% mutate(Survived = as.factor(Survived), Pclass = as.factor(Pclass), Sex = as.factor(Sex), Embarked = as.factor(Embarked), Deck = as.factor(Deck))

e.

mice_impute <- mice(titanic, seed = 123)
titanic1 <- complete(mice_impute, 1)

f. 

Parch and SibSp have the strongest positive pairwise correlation. SibSp and Age have the strongest negative correlation.

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

	Age	SibSp	Parch	Fare
Age	1.00	-0.35	-0.22	0.09
SibSp	-0.35	1.00	0.41	0.16
Parch	-0.22	0.41	1.00	0.22
Fare	0.09	0.16	0.22	1.00

g.

0.9201 of the original variation is explained by PC1. 0.99940 of the original variation is explained by PC1 and PC2 together.

pca <- prcomp(data_num)
  summary(pca)

Importance of components:
                           PC1      PC2     PC3     PC4
Standard deviation     49.7128 14.59946 1.07082 0.67926
Proportion of Variance  0.9201  0.07935 0.00043 0.00017
Cumulative Proportion   0.9201  0.99940 0.99983 1.00000

h.

The summary does say PC1 -> PC4 explains 1.0000 of the original variation. We can check this by taking the variation of the original data vs PCs. They are the same.

sum(apply(data_num, 2, var))

[1] 2686.118

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

[1] 2686.118

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

	PC1	PC2	PC3	PC4
PC1	1	0	0	0
PC2	0	1	0	0
PC3	0	0	1	0
PC4	0	0	0	1

i.

Fare is the most important in PC1 and Age is the most important in PC2. SibSp and Parch have smaller scales than Age and Fare, so they have smaller variances and variables with larger variances contribute more strongly to the first components. This can be fixed with scaling.

pca$rotation[ , 1:2]

              PC1         PC2
Age   0.028757803 -0.99912343
SibSp 0.003475807  0.02752000
Parch 0.003474588  0.01330037
Fare  0.999574327  0.02860290

j.

After scaling, the first two PCs now explain 0.7012 of the original variation.

pca2 <- prcomp(data_num, scale = TRUE)
  summary(pca2)

Importance of components:
                          PC1    PC2    PC3    PC4
Standard deviation     1.3065 1.0478 0.8034 0.7414
Proportion of Variance 0.4267 0.2745 0.1614 0.1374
Cumulative Proportion  0.4267 0.7012 0.8626 1.0000

The biplot reflects what we found in question (f). Parch and SibSp point in the same direction. SibSp and Age point in opposite directions. Fare and Parch point in similar directions. Fare and SibSp, plus Fare and Age, have very little correlation reflected by their near 90 degree angles on the biplot.

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

k.

Deck_D, Deck_E, and female are the most positively correlated variables with Survived_1. Variables Deck_T, male, and Pclass_3 are the most negatively correlated with Survived_1. Deck G A C and B, all Embarked variables, and Pclass_1 are hardly correlated with Survived_1.

data_cat <- titanic1 %>% select(where(is.factor))
he_ca <- MCA(data_cat, graph = FALSE) 
fviz_mca_var(he_ca, col.var = "cos2",
             geom.var = c("arrow", "text"),
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

l.

Sex, Embarked, Fare, and Pclass seem to be the most associated with Survived.

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

m.

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"))

n. 

I would keep 7 dimensions because the first 7 components all have eigenvalues greater than 1. Dimensions with eigenvalues above 1 are typically retained since they explain more variance than a single original standardized variable. After the 7th component, the eigenvalues drop below 1, so those dimensions contribute less individual information.

dat_famd$eig

        eigenvalue percentage of variance cumulative percentage of variance
comp 1   2.8483875              16.755221                          16.75522
comp 2   2.3249385              13.676109                          30.43133
comp 3   1.6170617               9.512128                          39.94346
comp 4   1.2736722               7.492189                          47.43565
comp 5   1.1718818               6.893422                          54.32907
comp 6   1.0944684               6.438050                          60.76712
comp 7   1.0131719               5.959835                          66.72695
comp 8   0.9894587               5.820345                          72.54730
comp 9   0.8480019               4.988247                          77.53554
comp 10  0.7381362               4.341977                          81.87752

o.

dat_famd_n <-  dat_famd$ind$coord[,1:7]

p. 

Observation 1’s nearest neighbor was observation 443 with a euclidean distance of 0.1233653. Observation 2’s nearest neighbor was observation 850 with a euclidean distance of 0.5523195.

dist_mat <- as.matrix(dist(dat_famd_n))

n1 <- which.min(dist_mat[1, -1]) + 1 #had to look this code up
d1 <- min(dist_mat[1, -1])

n2 <- which.min(dist_mat[2, -2]) + 1
d2 <- min(dist_mat[2, -2])

n1

443 
443 

d1

[1] 0.1233653

n2

850 
850 

d2

[1] 0.5523195

The observations are nearly identical. Observation 1 and 443 have a shorter distance than observation 2 and 850 because their Fare and Age values are closer.

kable(titanic1[c(1, 443), ])

	Survived	Pclass	Sex	Age	SibSp	Parch	Fare	Embarked	Deck
1	0	3	male	22	1	0	7.250	S	F
443	0	3	male	25	1	0	7.775	S	F

kable(titanic1[c(2, 850), ])

	Survived	Pclass	Sex	Age	SibSp	Parch	Fare	Embarked	Deck
2	1	1	female	38	1	0	71.2833	C	C
850	1	1	female	25	1	0	89.1042	C	C

q.

The average silhouette score peaks at 7 clusters. Since silhouette scores measure how well and observation fits inside its cluster compared to other clusters, 7 clusters is optimal.

fviz_nbclust(dat_famd_n, kmeans, method = "silhouette") +
  labs(subtitle = "Elbow Method")

r.

Cluster 1 has 331 observations, cluster 2 has 75 observations, cluster 3 has 42 observations, cluster 4 has 95 observations, cluster 5 has 98 observations, cluster 6 has 66 observations, and cluster 7 has 184 observations.

set.seed(123)
km <- kmeans(dat_famd_n, centers = 7, nstart = 20) 
kable(table(km$cluster))

Var1	Freq
1	331
2	75
3	42
4	95
5	98
6	66
7	184

s.

Dimension 1 is highly driven by Fare and Pclass. This suggests that Dimension 1 reflects differences related to passenger status or wealth. Dimension 2 is primarily influenced by Age, Sex, SibSp, Parch, and Deck G, so this dimension captures differences more related to gender and family structure rather than social class. Looking at the cluster centers, clusters with positive values on Dimension 1 represent passengers with higher status (wealth), while clusters with negative values represent lower status passengers. Clusters with large positive values on Dimension 2 likely correspond to passengers traveling with family or particular gender groupings, while clusters with negative values represent passengers traveling alone or with different demographic characteristics. Cluster 1 likely consists of lower status passengers traveling alone. Cluster 2 likely consists of wealthier passengers traviling with family or alone.

km$centers

       Dim.1        Dim.2      Dim.3      Dim.4       Dim.5      Dim.6
1 -1.2354444 -0.746043890  0.2042022  0.4293120  0.03721878 -0.2848594
2  2.6697002 -0.100977627  1.2756206  0.2387800  1.65426806 -0.6341549
3  0.6395448 -1.543079232  1.2256454 -0.6648678 -2.31807260  2.3088748
4 -0.8414501  0.264443391 -0.4700905 -2.1122662  0.06177521 -0.8428592
5 -1.0706037  3.222036273  0.7714037  0.2665500  0.04532345  0.7600625
6  2.9494175 -0.006510214  0.9580438 -0.1710747 -1.02497425 -0.9433299
7  0.9349950 -0.114830572 -1.6788557  0.2921088  0.09949721  0.6126227
        Dim.7
1  0.22222162
2 -1.46984995
3 -1.70774293
4 -0.32609953
5  0.01917922
6  2.10649283
7 -0.00826109

dat_famd$quanti.var$contrib

           Dim.1     Dim.2     Dim.3     Dim.4       Dim.5      Dim.6
Age    3.8319377 13.140730 1.2344929 0.6218446 6.937460352 10.1265362
SibSp  0.2308333 23.455453 2.6700077 3.3486761 0.020888435  0.1364451
Parch  0.2574612 22.358643 0.1766317 3.8400644 0.008368628  2.4162196
Fare  18.6054948  1.967104 4.1447774 1.3601240 1.033096747  4.0627168
           Dim.7       Dim.8      Dim.9     Dim.10
Age   0.01226043 0.001022794 20.6136111 4.39266305
SibSp 0.95868881 0.002832248  0.4960558 1.11151132
Parch 0.50583804 0.305892423  0.4396809 1.39951123
Fare  0.28158397 0.002863466  1.3254382 0.00954473

dat_famd$quali.var$contrib

            Dim.1        Dim.2       Dim.3        Dim.4       Dim.5
0       4.3834091  0.648395299  7.65225642  1.956584632  0.02353650
1       7.0365251  1.040845084 12.28388531  3.140833224  0.03778228
1      18.9123021  0.433783992  3.48675779  0.059298285  0.62490410
2       0.2082099  0.492316978 18.52713720 16.474958454  0.05424638
3       6.7864836  0.750592813  1.95006365  7.002635542  0.44474759
female  2.9872200  6.713946838  9.02451118  3.315337189  0.08392846
male    1.6256275  3.653690307  4.91108581  1.804186962  0.04567338
C       6.7327787  0.114849039  0.68671546  1.336569985 23.82347812
Q       1.1233996  0.091834086  0.03787727 32.839376861  2.17603013
S       0.9254043  0.004728778  0.12740437  6.613993484  3.95509951
A       0.2376377  2.076467286  2.70799649  1.284478614 18.44412495
B       7.7219589  0.002110787  2.73170229  0.129845680  5.67637045
C       6.7590757  0.027236324  5.18657941  0.035842583 18.49375740
D       1.7848341  0.053311880  9.87182214  7.238742325  6.00926187
E       0.5414346  0.341010996  8.05729660  6.853051100  9.46689115
F       6.6421595  2.071173424  0.46032200  0.614694062  0.38131185
G       2.2867329 19.357708399  2.68753996  0.127113562  0.12163299
T       0.3790797  1.204067876  1.38313690  0.001748341  2.13740874
              Dim.6        Dim.7        Dim.8        Dim.9      Dim.10
0       0.005258125  0.006535272 1.752960e-03  2.622525843  0.22422425
1       0.008440675  0.010490832 2.813963e-03  4.209844116  0.35993893
1       0.023865061  0.182870395 1.332688e-01  0.414461142  0.09926839
2       0.495615961  0.028574913 9.292527e-06  0.208429265  8.80552037
3       0.107912734  0.149857792 5.953458e-02  0.021762810  2.58427903
female  0.018323778  0.022769740 4.474536e-01  0.002803039  6.96060302
male    0.009971692  0.012391158 2.435016e-01  0.001525397  3.78791915
C       0.134378450  0.085540414 1.309119e+00  1.493320597 10.43038961
Q       3.912120787  1.556119809 8.444520e+00 10.189847109  4.97976865
S       0.758703692  0.337234686 2.527193e+00  0.227925296  0.77814948
A      20.978087315 13.392150512 3.294228e+00  5.084483705 19.52049030
B       5.474063129 33.071928881 3.638573e+00  6.039545833  3.38576538
C       3.315000727 19.953836790 2.469010e+00  4.382518419  0.10749412
D       1.928575329  2.695435537 2.207356e+01 14.457201742 10.05035704
E      12.165846643  2.460513044 1.674581e+01  0.511390540 18.36125692
F      19.622388016  0.120984663 1.048925e+00  1.306805786  0.95501712
G       5.917572434  0.002323440 6.324857e-02  6.093210334  0.37379283
T       8.381957765 24.152070871 3.718486e+01 19.857613035  1.32253509