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.
#We need to scale the data set before it becomes PCA #is because the data itself is sensitive to the #disparities between certain columns in their sheer magnitude#The values of the columns range from incredibly small values ####we need to make sure the data retains #explained variability before actually translating the data to a Principal Component Analysis. ##
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?
#First we gotta take the numeric columnsdecathlon_select <- decathlon %>%select(X100m, LongJump, ShotPut, HighJump, X400m, X110mHurdle, Discus, PoleVault, Javelin, X1500m) #Then we decide to take the scale of those numeric columns (decathlon_scaled <-scale(decathlon_select))
# X1 X2 X3 X4 X5 X6 X7 X8# 2.913494 1.928006 1.46543 1.404117 0.952215 0.5535841 0.4806271 .1403932# X9 X10# 0.1222556 0.03987768#Total adds to around 11. #PC1 = 2.913 and PC2 = 1.93#Rechange this# Total is 4.84, which is about 50% of the total variability explained by #these 2 PCs. #
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.
#Based on the PC1 and PC2 values from the loadings we can say#that the PC2 would bring the medalist points into the third quandrant #because of the abundance of negative values that it has (it has 7 #negatives). The PC1 would then bring the medalist points into the #fourth quadrant. So we'd be in the fourth quadrant but be very close#to the PC2 axis line. ##
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)
Loading required package: ggplot2
#PCs converting to a df. PCs_df <-as.data.frame(PCs)decathlon_with_PCs <- decathlon %>%mutate(PC1 = PCs_df[,1],PC2 = PCs_df[,2])#scatterplot of the decathlon athlets and their PCs. scatter_decathlon <-ggplot(decathlon_with_PCs, aes(x = PC1, y = PC2, color = Medal, label = Athlete)) +geom_point(size =3) +geom_text_repel(show.legend =FALSE, max.overlaps =15) +labs(title ="Principal Components of Decathlon Results (Paris 2024)",x ="Principal Component 1",y ="Principal Component 2",color ="Medal Status" ) +theme_minimal(base_size =14) +theme(plot.title =element_text(hjust =0.5, face ="bold"),legend.position ="right" )scatter_decathlon
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.
#The mean vector of the 2024 athletes: mean_vec_24 <-attr(decathlon_scaled, "scaled:center")mean_vec_24
#His coordinates are -3.422699 -0.5092531#Adding the point to the scatterplotwarner_pc <-as.data.frame(compare_2020_2024 %*% loadings[,1:2])colnames(warner_pc) <-c("PC1", "PC2")warner_pc$Athlete <-"Damian Warner (2020)"warner_pc$Medal <-"Gold (2020)"scatter_decathlon +geom_point(data = warner_pc, aes(x = PC1, y = PC2),color ="black", fill ="gold", size =5, shape=21, stroke =1.2) +geom_text_repel(data = warner_pc, aes(x = PC1, y = PC2),color ="black", fill ="gold", size =5, shape =21)
Warning in geom_text_repel(data = warner_pc, aes(x = PC1, y = PC2), color =
"black", : Ignoring unknown parameters: `fill` and `shape`
#His point has been added as a gold filled circle with black outline
Do you think his 2020 performance would have won a medal if it had happened in 2024?
#Given how far in proximity Damian Warner is from the actual medalists of the #olympics - Leo Neugebaur, Lindon Victor and Markus Rooth- I would imagine that # Warner still would not have gotten a medal for his performance in the #Decathlon. Although it seems he would've gotten quite a bit closer to doing so #when compared to his 2024 performance of the Decathlon.
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?
plotB <-ggplot(claudeB_scaled, aes(x = X, y = Y)) +geom_point(color ="darkgreen", size =2) +coord_equal() +labs(title ="Claude B (Scaled)") +theme_minimal()plotB
plotC <-ggplot(claudeC_scaled, aes(x = X, y = Y)) +geom_point(color ="firebrick", size =2) +coord_equal() +labs(title ="Claude C (Scaled)") +theme_minimal()plotC
plotA + plotB + plotC
#I think the reason you were skeptical was because of the fact that there is#we can see that with the scaling of the dataset there is indeed a whole lot #of varibility within each of the claudes. This is pontificated by the fact #that the Claude A, Claude B and Claude C are so diagonal. PCA identifies#the direction of greatest variance, which means the greatest variance sits #across a axis line. So the first principal component should explain 100% #of the variance which is a lot of variance, more than 50%, 75% and even 90% #of the variance wanted for each dataset. This would be right to be skeptical #about
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.
Dataset PC1 PC2
1 Claude A 97.56201 2.4379913
2 Claude B 95.91807 4.0819323
3 Claude C 99.49096 0.5090442
#The actual PC1s and PC2s for each claude dataset# Dataset PC1 PC2# Claude A 97.56 2.44# Claude B 95.92 4.08# Claude C 99.50 0.51#The actual values show that the PC1s explain nearly all of the variance#and the PC2s explain almost none of the variance (very low values). #far above the required threshold of 50%,75% or 90%. Hence the linear #shape of the dots.
