R Script - Advanced code for Principle Component Analysis

# set wd 
# Import data (averaged) from excel 

1. library(readxl) 
2. cotton <- read_excel("C:.xlsx") 
3. View(cotton) 

# Scale the data  
4. cotton 
5. scd <- scale(cotton[,-1], center = T) 
6. scd 
?scale 

# Change the options 
7. options(max.print = 100000) 
8. options(scipen = 100)   

# Packages required for visualization 
9. install.packages("factoextra") 
10. library("factoextra") 
11. install.packages("pca3d") 
12. library(pca3d) 

# Built in functions 
# spectral decomposition approach 
13. pca1 <- princomp(scd) 
14. pca1 
15. 1.7505264^2 
16. biplot(pca1) 

# singular value decomposition approach 
17. pca2 <- prcomp(scd) 
18. pca2 
19. pca2$x 
20. summary(pca2) 
21. biplot(pca2) 
22. pca1$scores == pca2$x # only use one function 
23. fviz_pca(pca2) 
24. fviz_pca_var(pca2) 
25. fviz_pca_var(pca2, repel = T) 
26. fviz_pca_ind(pca2) 
27. fviz_screeplot(pca2) 

# 3d visualization 
28. install.packages("C:/Users/VEMALI/OneDrive/Desktop/Applications of R in 
research/Resources/R packages/pca3d_0.10.1.tar", repos = NULL, type="source") 
29. library(pca3d) 
30. pca3d(pca2) 
31. ?pca3d 
32. pca3d(pca2, show.labels = T) 
33. pca3d(pca2, show.labels = T, fancy = T) 
53 

# PCA analysis in FactoMineR based on single value decomposition 
34. install.packages("FactoMineR") 
35. library(FactoMineR) 
36. fpca <- PCA(scd, ncp=18) 
37. fpca 
38. fpca$eig 
39. fpca$ind$coord # aka scores 
40. fpca$ind$cos2 # quality of representation It shows the importance of a principal  
41. component for a given observation 
43. fpca$var$contrib # contributions  

# Biplot  
44. fviz_pca(fpca)  
45. fviz_pca_biplot(fpca, repel = T) # repulsion avoid overlap 
46. fviz_pca_biplot(fpca, repel = T, col.ind = "cos2") # quality of representation 
47. fviz_pca_biplot(fpca, repel = T, col.ind = "cos2", col.var = "red") # above line 
48. ?fviz_pca_biplot 

# scatter plot 
49. fviz_pca_ind(fpca)  
50. fviz_pca_ind(fpca, repel = T) 
60. fviz_pca_ind(fpca, repel = T, col.ind = "cos2")  

# variables 
61. fviz_pca_var(fpca) 
62. fviz_pca_var(fpca, repel = T)  
63. fviz_pca_var(fpca, repel = T, col.var = "contrib") 

# scree plot 
64. fviz_screeplot(fpca) 
65. fviz_screeplot(fpca, ncp=18) 
66. fviz_screeplot(fpca, ncp=18, geom="line") 
67. fviz_screeplot(fpca, ncp=18, geom="bar") 
68. fviz_screeplot(fpca, ncp=18, geom="bar", barfill="red") 
69. fviz_screeplot(fpca, choice="eigenvalue") 
70. fviz_screeplot(fpca, choice="eigenvalue", ncp=18) 
71. fpca$eig 
72. table1 <- fpca$eig 
73. class(table1) 
74. table1 <- as.data.frame(table1) 
75. class(table1) 

# install.packages(writexl) 
76. library(writexl) 
77. write_xlsx(table1, "table.xlsx") 

# Elbow method to find optimum number of cluster 
78. plot(table1$`cumulative percentage of variance`) 

# Rotated component matrix using psych function 
79. install.packages("psych") 
80. library("psych") 
81. rpca <- principal(scd, nfactors = 7, rotate = "varimax", scores = T) 
82. rpca 
83. rpca$loadings 
54 
84. print(rpca$loadings, digits = 3, cutoff = 0) 
85. rpca$communality 
86. barplot(rpca$loadings) 
87. barplot(rpca$loadings, beside = T) 
88. barplot(rpca$loadings, beside = T, col = "blue", main = "Rotated component matrix") 

# R colour palette 
89. install.packages("pals") 
90. library(pals) 
91. barplot(rpca$loadings, beside = T, col = brewer.accent(18), main = "Rotated component matrix") 
92. barplot(rpca$loadings, beside = T, col = brewer.greens(18), main = "Rotated component matrix") 
93. barplot(rpca$loadings, beside = T, col = brewer.spectral(18), main = "Rotated component matrix") 
94. barplot(rpca$loadings, beside = T, col = alphabet(n=18), main = "Rotated component matrix") 
?pal.bands 

# Import scores 
95. rpca$scores 
96. scores <- rpca$scores 
97. scores <- as.data.frame(scores) 
98. class(scores) 
99. write_xlsx(scores, "scores.xlsx")