d <- read.csv("https://stats.dip.jp/01_ds/data/seiseki_jp.csv")
head(d)

##   学籍番号 国 社 数  理 音 美 体 技 英
## 1       s1 30 43 51  63 60 66 37 44 20
## 2       s2 39 21 49  56 70 72 56 63 16
## 3       s3 29 30 23  57 69 76 33 54  6
## 4       s4 95 87 77 100 77 82 78 96 87
## 5       s5 70 71 78  67 72 82 46 63 44
## 6       s6 67 53 56  61 61 76 70 66 40

library(DT)
datatable(d, caption = "成績データ")

r <- prcomp(d[, -1], scale = T)

summary(r)

## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.4508 1.0479 0.70060 0.63795 0.54796 0.47059 0.42754
## Proportion of Variance 0.6674 0.1220 0.05454 0.04522 0.03336 0.02461 0.02031
## Cumulative Proportion  0.6674 0.7894 0.84394 0.88916 0.92252 0.94713 0.96744
##                            PC8     PC9
## Standard deviation     0.41376 0.34909
## Proportion of Variance 0.01902 0.01354
## Cumulative Proportion  0.98646 1.00000

options(digits = 1) 
(variance <- r$sdev^2) 

## [1] 6.0 1.1 0.5 0.4 0.3 0.2 0.2 0.2 0.1

(proportion_variance <- variance / sum(variance)) 

## [1] 0.67 0.12 0.05 0.05 0.03 0.02 0.02 0.02 0.01

(cumulative_propotion <- cumsum(proportion_variance)) 

## [1] 0.7 0.8 0.8 0.9 0.9 0.9 1.0 1.0 1.0

evec <- r$rotation

datatable(round(evec, 2))

rownames(r$x) <- d$学籍番号

datatable(round(r$x, 2))

library(factoextra)

##  要求されたパッケージ ggplot2 をロード中です

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

fviz_screeplot(r, addlabels = T)

fviz_contrib(r, choice = "var", axes = 1, top = 5)

fviz_contrib(r, choice = "var", axes = 2, top = 5)

library("corrplot")

## corrplot 0.92 loaded

var <- get_pca_var(r)
corrplot(var$cor, is.corr = T, addCoef.col = "gray") 

fviz_pca_var(r, 
             col.var = "contrib", 
             repel = T) 

fviz_pca_biplot(r, col.ind = "contrib", repel = T)

d0 <- read.csv(file = "https://stats.dip.jp/01_ds/data/hand_writing_numbers0-9.csv")

library(DT)
datatable(d0)

d <- d0[, -1]
number <- d0$number

draw.images <- function(img, i.fr, i.to)
{
  par(mfrow = c(5, 5), 
      mar = c(0, 0, 1, 0)+0.1, 
      cex.main = 0.9)
  
  DX <- 8
  DY <- 8
  BIT <- 16
  
  for (i in i.fr:i.to)
  {
    plot(NA, type = "n",axes = F,
         xlim = c(0, DX),
         ylim = c(0, DY),
         xlab = "",
         ylab = "",
        main = paste("Fig.", i-1))
    
    m <- matrix(unlist(img[i, ])/BIT, nrow = 8, byrow = T)
    
    rasterImage(m, 0, 0, DX, DY) 
  }
}


draw.images(img = d, i.fr = 1, i.to = 20)

r <- prcomp(d, rank. = 2)

fviz_screeplot(r, addlabels = T)

fviz_contrib(r, choice = "var", axes = 1, top = 5)

fviz_contrib(r, choice = "var", axes = 2, top = 5)

fviz_pca_var(r, 
             col.var = "contrib", 
             repel = T) 
fviz_pca_ind(r, 
             label = d0$number,
             habillage = number,
             addEllipses = T,
             ellipse.level = 0.95)