── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
A)
Explain why we need to scale this data set before performing PCA.
We need to scale this data set before performing PCA because we don’t want the events with larger units (ex: 1500m, Javelin) to dominate things just because they are measured on a larger scale than others. Scaling makes sure this doesn’t happen. It ensures that all of the events are contributing equally to our PCA.
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?
PC1 alone explains 29.13% of the total variability in these 10 variables
PC2 explains an additional 19.28%
C)
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.
+ positives: Shot Put, Discus, Pole Vault, Javelin
- negatives: Long Jump, High Jump, 1500M
PC2 increases more on strength events
Based on all of that, I would say I think that the medalists would be in the upper right quadrant (I) because of their high values.
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(ggrepel)
Warning: package 'ggrepel' was built under R version 4.4.3
ggplot(decathlon_with_PCs, aes(x = PC1, y = PC2, color = Medal, label = Athlete)) +geom_point(size =3) +geom_text_repel(max.overlaps =20, show.legend =FALSE) +theme_minimal() +labs(title ="PC1 vs PC2 for Decathlon Athletes",x ="Principal Component 1",y ="Principal Component 2" ) +scale_color_manual(values =c("Gold"="steelblue", "Silver"="steelblue","Bronze"="steelblue", "None"="gray60"))
My plot does line up with my intuition from C.
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?
ggplot(decathlon_with_PCs, aes(x = PC1, y = PC2, color = Medal, label = Athlete)) +geom_point(size =3) +geom_text_repel(max.overlaps =20, show.legend =FALSE) +geom_point(aes(x = warner_pcs[1], y = warner_pcs[2]), color ="steelblue", size =4) +geom_text_repel(aes(x = warner_pcs[1], y = warner_pcs[2], label ="Damian Warner (2020)"), color ="steelblue", show.legend =FALSE) +theme_minimal() +labs(title ="PC1 vs PC2 for Decathlon Athletes + Warner",x ="Principal Component 1",y ="Principal Component 2" ) +scale_color_manual(values =c("Gold"="steelblue", "Silver"="steelblue", "Bronze"="steelblue", "None"="gray60"))
Warning in geom_text_repel(aes(x = warner_pcs[1], y = warner_pcs[2], label = "Damian Warner (2020)"), : All aesthetics have length 1, but the data has 20 rows.
ℹ Please consider using `annotate()` or provide this layer with data containing
a single row.
Warning: ggrepel: 20 unlabeled data points (too many overlaps). Consider
increasing max.overlaps
Based on the numbers and where Warner landed on the plot, I would say I don’t think he would have been a medal winner if his 2020 performance happened in 2024. His position on the plot is pretty far to the left of the other medalists and is a good bit below them. Looking at it that way, I don’t think he would have won a medal here.
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?
library(patchwork)
Warning: package 'patchwork' was built under R version 4.4.3
plotA <-ggplot(claudedataA_scaled, aes(x = X, y = Y)) +geom_point() +coord_equal() +labs(title ="Scaled Claude A") +theme_minimal()plotB <-ggplot(claudedataB_scaled, aes(x = X, y = Y)) +geom_point() +coord_equal() +labs(title ="Scaled Claude B") +theme_minimal()plotC <-ggplot(claudedataC_scaled, aes(x = X, y = Y)) +geom_point() +coord_equal() +labs(title ="Scaled Claude C") +theme_minimal()plotA + plotB + plotC
I’m guessing you were skeptical because all three datasets look very similar and strongly linear. The plots don’t clearly show differences that match 55%, 75%, and 90% variance, so the actual variability explained by PC1 probably exceeds the values that were claimed.
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.
