機械学習

演習課題

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

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

r <- prcomp(d[, -1], scale = T) # scale = T: 相関行列， F: 分散共分散行列を利用
# 【注意】学籍番号のカラム（1番目）を除いているd[, -1]（科目データだけで分析）

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) # 表示有効数字2桁
(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))

# レコード名を入力（省くとスコア表とbiplotでレコード連番表示になる）
rownames(r$x) <- d$学籍番号

datatable(round(r$x, 2))

library(factoextra)

## Warning: パッケージ 'factoextra' はバージョン 4.3.3 の R の下で造られました

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

## Warning: パッケージ 'ggplot2' はバージョン 4.3.3 の R の下で造られました

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

library(factoextra)

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")

## Warning: パッケージ 'corrplot' はバージョン 4.3.3 の R の下で造られました

## corrplot 0.94 loaded

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

#corrplot(var$contrib, is.corr = F, addCoef.col = "gray")

fviz_pca_var(r, 
             col.var = "contrib", # 色分け 
             repel = T) # repel: テキストラベルの重なり防止

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