library(tidyverse)
five_irises <- data.frame(
row.names = 1:5,
Sepal.Length = c(0.189, 0.551, -0.415, 0.310, -0.898),
Sepal.Width = c(-1.97, 0.786, 2.62, -0.590, 1.70),
Petal.Length = c(0.137, 1.04, -1.34, 0.534, -1.05),
Petal.Width = c(-0.262, 1.58, -1.31, 0.000875, -1.05)
) %>% as.matrixActivity 3.3 - PCA implementation
SUBMISSION INSTRUCTIONS
- Render to html
- Publish your html to RPubs
- Submit a link to your published solutions
Problem 1
Consider the following 6 eigenvalues from a \(6\times 6\) correlation matrix:
\[\lambda_1 = 3.5, \lambda_2 = 1.0, \lambda_3 = 0.7, \lambda_4 = 0.4, \lambda_5 = 0.25, \lambda_6 = 0.15\]
If you want to retain enough principal components to explain at least 90% of the variability inherent in the data set, how many should you keep?
PC1 + PC2 + PC3 + PC4: \(\frac{3.5 + 1.0 + 0.7 + 0.4}{6.0} \times 100\% = 93.33\%\)
we should keep 4 principal components
Problem 2
The iris data set is a classic data set often used to demonstrate PCA. Each iris in the data set contained a measurement of its sepal length, sepal width, petal length, and petal width. Consider the five irises below, following mean-centering and scaling:
Consider also the loadings for the first two principal components:
# Create the data frame
pc_loadings <- data.frame(
PC1 = c(0.5210659, -0.2693474, 0.5804131, 0.5648565),
PC2 = c(-0.37741762, -0.92329566, -0.02449161, -0.06694199),
row.names = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
) %>% as.matrixA plot of the first two PC scores for these five irises is shown in the plot below.
Match the ID of each iris (1-5) to the correct letter of its score coordinates on the plot.
Iris1 –> b Iris2 –> d Iris3 –> a Iris4 –> c Iris5 –> e
Problem 3
These data are taken from the Places Rated Almanac, by Richard Boyer and David Savageau, copyrighted and published by Rand McNally. The nine rating criteria used by Places Rated Almanac are:
- Climate & Terrain
- Housing
- Health Care & Environment
- Crime
- Transportation
- Education
- The Arts
- Recreation
- Economics
For all but two of the above criteria, the higher the score, the better. For Housing and Crime, the lower the score the better. The scores are computed using the following component statistics for each criterion (see the Places Rated Almanac for details):
- Climate & Terrain: very hot and very cold months, seasonal temperature variation, heating- and cooling-degree days, freezing days, zero-degree days, ninety-degree days.
- Housing: utility bills, property taxes, mortgage payments.
- Health Care & Environment: per capita physicians, teaching hospitals, medical schools, cardiac rehabilitation centers, comprehensive cancer treatment centers, hospices, insurance/hospitalization costs index, flouridation of drinking water, air pollution.
- Crime: violent crime rate, property crime rate.
- Transportation: daily commute, public transportation, Interstate highways, air service, passenger rail service.
- Education: pupil/teacher ratio in the public K-12 system, effort index in K-12, accademic options in higher education.
- The Arts: museums, fine arts and public radio stations, public television stations, universities offering a degree or degrees in the arts, symphony orchestras, theatres, opera companies, dance companies, public libraries.
- Recreation: good restaurants, public golf courses, certified lanes for tenpin bowling, movie theatres, zoos, aquariums, family theme parks, sanctioned automobile race tracks, pari-mutuel betting attractions, major- and minor- league professional sports teams, NCAA Division I football and basketball teams, miles of ocean or Great Lakes coastline, inland water, national forests, national parks, or national wildlife refuges, Consolidated Metropolitan Statistical Area access.
- Economics: average household income adjusted for taxes and living costs, income growth, job growth.
In addition to these, latitude and longitude, population and state are also given, but should not be included in the PCA.
Use PCA to identify the major components of variation in the ratings among cities.
library(FactoMineR)
library(factoextra)Welcome to factoextra!Want to learn more? See two factoextra-related books at https://www.datanovia.com/library/principal-component-methodsplaces <- read.csv('Data/Places.csv')
head(places) City Climate Housing HlthCare Crime Transp Educ Arts
1 AbileneTX 521 6200 237 923 4031 2757 996
2 AkronOH 575 8138 1656 886 4883 2438 5564
3 AlbanyGA 468 7339 618 970 2531 2560 237
4 Albany-Schenectady-TroyNY 476 7908 1431 610 6883 3399 4655
5 AlbuquerqueNM 659 8393 1853 1483 6558 3026 4496
6 AlexandriaLA 520 5819 640 727 2444 2972 334
Recreat Econ Long Lat Pop
1 1405 7633 -99.6890 32.5590 110932
2 2632 4350 -81.5180 41.0850 660328
3 859 5250 -84.1580 31.5750 112402
4 1617 5864 -73.7983 42.7327 835880
5 2612 5727 -106.6500 35.0830 419700
6 1018 5254 -92.4530 31.3020 135282places_pca <- PCA(places,
quanti.sup = c('Long', 'Lat', 'Pop'),
quali.sup = 'City',
ncp = 9,
graph = FALSE)A.
Perform PCA on the data set, using columnsClimate through Econ, and create a scree plot. Interpret your findings from this plot. What percent of total variability is explained by the first two PCs?
fviz_eig(places_pca, geom = 'line') +
labs(title = 'Scree Plot - Places Rated') +
theme_classic(base_size = 14)
places_pca$eig eigenvalue percentage of variance cumulative percentage of variance
comp 1 3.4082918 37.869909 37.86991
comp 2 1.2139762 13.488624 51.35853
comp 3 1.1414791 12.683102 64.04163
comp 4 0.9209178 10.232420 74.27405
comp 5 0.7532849 8.369832 82.64389
comp 6 0.6305619 7.006243 89.65013
comp 7 0.4930477 5.478308 95.12844
comp 8 0.3180385 3.533761 98.66220
comp 9 0.1204021 1.337801 100.00000The eigenvalues show that Dim 1 explains 37.87% of the variance and Dim 2 explains 13.49%.
Together, the first two PCs explain 51.36% of the total variability in city ratings.
B.
Interpret the first two principal components by examining the loadings (plot(s) of the loadings may be helpful). Which variables will be used to separate cities along the first and second principal axes, and how? Make sure to discuss the signs of the loadings, not just their contributions!
fviz_pca_var(places_pca, axes = c(1, 2), repel = TRUE)
round(places_pca$var$coord[, 1:2], 3) Dim.1 Dim.2
Climate 0.381 0.240
Housing 0.658 0.276
HlthCare 0.850 -0.330
Crime 0.519 0.392
Transp 0.648 -0.198
Educ 0.508 -0.533
Arts 0.855 -0.215
Recreat 0.605 0.424
Econ 0.250 0.519Dimension 1 (PC1): All criteria have negative loadings on the first axis (Arts at \(-0.855\), HlthCare at \(-0.850\), Housing at \(-0.658\), and Transp at \(-0.648\)). since all loadings share the same negative sign, PC1 acts as an overall index. Cities located far in the negative PC1 direction are large metropolitan centers offering abundant arts, healthcare facilities, and transportation infrastructure, whereas cities with positive PC1 values are smaller municipalities with lower ratings across these criteria.
Dimension 2 (PC2): PC2 contrasts Education (\(+0.533\)) and Healthcare (\(+0.330\)) against Economics (\(-0.519\)), Recreation (\(-0.424\)), and Crime (\(-0.392\)). Cities with high positive PC2 values are better in educational options and health services relative to their economic activity. ## C.
Add the first two PC scores to the places data set. Create a biplot of the first 2 PCs, using repelled labeling to identify the cities. Which are the outlying cities and what characteristics make them unique?
library(ggrepel)
places_update <- bind_cols(places, places_pca$ind$coord[, 1:2])
fviz_pca(places_pca, axes = c(1, 2),
label = 'var',
repel = TRUE,
mean.point = FALSE) +
geom_text_repel(aes(x = Dim.1, y = Dim.2, label = City),
data = places_update,
max.overlaps = 12,
size = 3.5) +
labs(title = 'Biplot of Places Rated PCA') +
theme_classic(base_size = 14)
New York, NY: The most extreme outlier on the far negative side of PC1 (\(\text{Dim.1} \approx -12.43\)). It has high scores in the Arts, Healthcare, and Transportation compared to all other cities in the dataset.
Chicago, IL, Boston, MA, and Washington, DC: Large metropolitan outliers on the negative side of PC1 and positive side of PC2, characterized by top-tier universities/education and medical centers.
Problem 4
The data we will look at here come from a study of malignant and benign breast cancer cells using fine needle aspiration conducted at the University of Wisconsin-Madison. The goal was determine if malignancy of a tumor could be established by using shape characteristics of cells obtained via fine needle aspiration (FNA) and digitized scanning of the cells.
The variables in the data file you will be using are:
- ID - patient identification number (not used in PCA)
- Diagnosis determined by biopsy - B = benign or M = malignant
- Radius: mean of distances from center to points on the perimeter
- Texture: standard deviation of gray-scale values
- Smoothness: local variation in radius lengths
- Compactness: perimeter^2 / area - 1.0
- Concavity: severity of concave portions of the contour
- Concavepts: number of concave portions of the contour
- Symmetry: measure of symmetry of the cell nucleus
- FracDim: fractal dimension; “coastline approximation” - 1
bc_cells <- read.csv('Data/BreastDiag.csv')
head(bc_cells) Diagnosis Radius Texture Smoothness Compactness Concavity ConcavePts Symmetry
1 M 17.99 10.38 0.11840 0.27760 0.3001 0.14710 0.2419
2 M 20.57 17.77 0.08474 0.07864 0.0869 0.07017 0.1812
3 M 19.69 21.25 0.10960 0.15990 0.1974 0.12790 0.2069
4 M 11.42 20.38 0.14250 0.28390 0.2414 0.10520 0.2597
5 M 20.29 14.34 0.10030 0.13280 0.1980 0.10430 0.1809
6 M 12.45 15.70 0.12780 0.17000 0.1578 0.08089 0.2087
FracDim
1 0.07871
2 0.05667
3 0.05999
4 0.09744
5 0.05883
6 0.07613bc_pca <- PCA(bc_cells, quali.sup = 'Diagnosis', ncp = 8, graph = FALSE)A.
My analysis suggests 3 PCs should be retained. Support or refute this suggestion. What percent of variability is explained by the first 3 PCs?
fviz_eig(bc_pca, geom = 'line') +
theme_classic(base_size = 14)
bc_pca$eig eigenvalue percentage of variance cumulative percentage of variance
comp 1 4.28712664 53.5890830 53.58908
comp 2 1.82348458 22.7935572 76.38264
comp 3 0.82572454 10.3215568 86.70420
comp 4 0.49863192 6.2328991 92.93710
comp 5 0.37229268 4.6536586 97.59075
comp 6 0.09214368 1.1517961 98.74255
comp 7 0.06878019 0.8597524 99.60230
comp 8 0.03181576 0.3976969 100.00000The first 3 PCs explain 86.70% of the total variability (\(\text{Dim.1} = 53.59\%\), \(\text{Dim.2} = 22.79\%\), \(\text{Dim.3} = 10.32\%\)).
The suggestion to retain 3 PCs is supported looking at the scree plot elbow confirms that the cliff drops sharply after PC2 and levels out into the scree around PC3–PC4.
B.
Interpret the first 3 principal components by examining the eigenvectors/loadings. Discuss.
round(bc_pca$var$coord[, 1:3], 3) Dim.1 Dim.2 Dim.3
Radius 0.622 -0.714 -0.252
Texture 0.297 -0.478 0.816
Smoothness 0.721 0.441 -0.115
Compactness 0.949 0.097 0.027
Concavity 0.934 -0.172 -0.039
ConcavePts 0.923 -0.308 -0.159
Symmetry 0.671 0.380 0.077
FracDim 0.466 0.783 0.222PC1 (Size and Contour Irregularity): Strongly and negatively loaded on Compactness (\(-0.949\)), Concavity (\(-0.934\)), Concave Points (\(-0.923\)), and Smoothness (\(-0.721\)). High values in these measurements represent cells that are larger, more deformed, and heavily indented.
PC2 (Shape Complexity vs. Radius): Contrasts Fractal Dimension (\(+0.783\)) with Radius (\(-0.714\)). Cells with high PC2 values have high fractal dimension but smaller overall cell radius.
PC3 (Texture Dominance): Dominated entirely by Texture (\(+0.816\)), capturing variance in grayscale intensity within the cell nucleus independently of the cell outline.
C.
Examine a biplot of the first two PCs. Incorporate the third PC by sizing the points by this variable. (Hint: you might want to add all 3 PC scores to the data set. Use fviz_pca to set up a biplot, but set col.ind='white'. Then use geom_point() to maintain full control over the point mapping.) Color-code by whether the cells are benign or malignant. Answer the following:
- What characteristics distinguish malignant from benign cells?
- Of the 3 PCs, which does the best job of differentiating malignant from benign cells?
bc_update <- bind_cols(bc_cells, bc_pca$ind$coord[, 1:3])
fviz_pca(bc_pca, axes = c(1, 2),
col.ind = 'white',
label = 'var',
repel = TRUE) +
geom_point(data = bc_update,
aes(x = Dim.1, y = Dim.2, color = Diagnosis, size = Dim.3),
alpha = 0.6) +
scale_color_manual(values = c('B' = '#2b83ba', 'M' = '#d7191c')) +
labs(title = 'Breast Cancer Biplot',
size = 'PC3 (Dim.3)',
color = 'Diagnosis') +
theme_classic(base_size = 14)
Malignant (cancerous) cells are usually bigger, have rougher and more jagged edges, and are less round and smooth compared to benign (non-cancerous) cells.
PC1 does the best job of telling the two apart. On the graph, cancerous cells bunch up negative PC1 because of their larger size and irregular shapes, while healthy cells group together on the right side positive PC1.