For the purposes of this question, assume we have 10-dimensional data - that is, ignore the Overall column.
A)
Explain why we need to scale this data set before performing PCA.
All units are measured differently and in a different scale. Some are much higher and will have a greater impact on the principal components which wouldn’t allow us to see the true variations.
B)
Use svd() to find the first 2 principal component scores and their loadings. Full credit will only be granted if you use the svd() ingredients u, d, and v. What percent of the overall variability do the first two PCs explain?
# 1. Extract numeric event columns (10 events only)X <- decathlon[, 5:14]# 2. Scale the data (center + scale)X_scaled <-scale(X)# 3. Perform singular value decompositionsvd_out <-svd(X_scaled)# 4. Compute principal component scores and loadingsU <- svd_out$uD <-diag(svd_out$d)V <- svd_out$v# PC scores (new coordinates for each athlete)scores <- U %*% D# Loadings (weights of each event on each PC)loadings <- V# 5. Compute proportion of variance explainedvar_explained <- svd_out$d^2/sum(svd_out$d^2)# 6. Percent of total variability explained by first two PCspercent_first2 <-sum(var_explained[1:2]) *100percent_first2
Find and print the loadings. Based on the loadings alone, if the first two PCs are plotted in a 2D plane as shown below, which of the four quadrants will the medalists be in? Explain your reasoning.
They will be in Quadrant 1 and as both the PC1 and PC2 for the first loading is positive (PC1: 0.447, PC2: 0.017). A positive PC1 (0.447) pushes the medalist to the right, then a positive PC2 (0.017) pushes the medalist up leaving them in Q1. A positive PC1 likely relates to a higher score which would mean the medalists should lie within that quadrant.
D)
Add the PCs to the decathlon data set and create a scatterplot of these PCs, with the points labeled by the athletes’ names. Color-code the points on whether or not the athlete was a medalist. Use the ggrepel package for better labeling. Verify that your intuition from C) is correct.
library(ggplot2)
Warning: package 'ggplot2' was built under R version 4.4.3
library(ggrepel)
Warning: package 'ggrepel' was built under R version 4.4.3
# 1. Add the first two PC scores to the decathlon data framedecathlon$PC1 <- scores[, 1]decathlon$PC2 <- scores[, 2]# 2. Create a variable for medal statusdecathlon$Medalist <-ifelse(decathlon$Medal =="None", "No", "Yes")# 3. Plot PC1 vs PC2, label athletes, color-code medalistsggplot(decathlon, aes(x = PC1, y = PC2, color = Medalist, label = Athlete)) +geom_point(size =3) +geom_text_repel(size =3, max.overlaps =20) +labs(title ="Decathlon Athletes on First Two Principal Components",x ="PC1",y ="PC2",color ="Medalist" ) +theme_minimal()
In part (C) I predicted Q1 because both PC1 and PC2 loadings for the first variable were positive. After plotting the actual PC1 vs PC2 scores, the medalists appear mainly in Q2. My intuition for PC2 was correct but for PC1 it is actually the opposite.
E)
Canadian Damian Warner won the gold medal in the decathlon in the 2020 Tokyo games. He began the 2024 decathlon but bowed out after three straight missed pole vault attempts.
Would this have won a medal if it had happened in 2024? To answer this, we will compute his PCs with respect to the 2024 athletes and add it to the plot to see where his 2020 gold-medal performance compares to the 2024 athletes. To do this:
Find the mean vector from the 2024 athletes. Call it mean_vec_24.
Find the standard deviation vector from the 2024 athletes. Call it sd_vec_24.
Standardize Warner’s 2020 results with respect to the 2024 athletes: (warner-mean_vec_24)/sd_vec_24
Find Warner’s PC coordinates using the 2024 loadings.
Add his point to the scatterplot.
Do you think his 2020 performance would have won a medal if it had happened in 2024?
Damian Warner’s 2020 performance would not have resulting in a medal in 2024. His point falls right next to a ton of non medalists and he does not have a high PC2, he does have a very negative PC1 which the medalists also have but the PC2 score is the primary indicator and his is too low.
Question 2
Below is a screenshot of a conversation between me and chatbot Claude:
After looking at the graphs, I grew skeptical. So I said:
Behold, Claude’s three data sets which I’ve called claudeA, claudeB, and claudeC:
Each data set has an X and a Y column which represent 2-dimensional variables that we need to rotate.
A)
Scale each data set and plot them side-by-side using the patchwork package. Make sure the aspect ratio of each graph is 1 (i.e., make the height and width of each graph equal). At this point, explain why you think I was skeptical. Specifically, do you think the percent variability explained by the first PC of each data set appears to exceed or fall short of the variability I asked it to?
claudeA <-read.csv("Data/claude_dataA.csv")claudeB <-read.csv("Data/claude_dataB.csv")claudeC <-read.csv("Data/claude_dataC.csv")# Scale each datasetclaudeA_scaled <-scale(claudeA)claudeB_scaled <-scale(claudeB)claudeC_scaled <-scale(claudeC)
I think that you were skeptical because claudeA looks like it accounts for way more than 55% considering that it is very linear and not super spread out. Also B and C have almost the same level of linearity but have completely different estimated percentages. I think all exceed the variability that you asked for.
B)
Use SVD to find the first PC for each data set, and find the actual percent of total variability explained by each PC using aggregation methods.
