d <- read.csv("https://stats.dip.jp/01_ds/data/UN_jp.csv")
head(d)## 国名 地域 分類 出生数 GDP 平均寿命 都市人口率 乳児死亡率
## 1 Afghanistan Asia other 5.97 499.0 49.49 23 12.45
## 2 Albania Europe other 1.52 3677.2 80.40 53 1.66
## 3 Algeria Africa africa 2.14 4473.0 75.00 67 2.15
## 4 Angola Africa africa 5.14 4321.9 53.17 59 9.62
## 5 Argentina Latin Amer other 2.17 9162.1 79.89 93 1.23
## 6 Armenia Asia other 1.74 3030.7 77.33 64 2.43library(DT)
datatable(d, caption = "国連社会指標データ")r <- prcomp(d[, 4:ncol(d)], scale = T)
summary(r)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 1.9015 0.8551 0.63807 0.42872 0.24968
## Proportion of Variance 0.7231 0.1462 0.08143 0.03676 0.01247
## Cumulative Proportion 0.7231 0.8693 0.95077 0.98753 1.00000options(digits = 1)
(variance <- r$sdev^2)## [1] 3.62 0.73 0.41 0.18 0.06(proportion_variance <- variance / sum(variance))## [1] 0.72 0.15 0.08 0.04 0.01(cumulative_propotion <- cumsum(proportion_variance))## [1] 0.7 0.9 1.0 1.0 1.0evec <- 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/ve3WBafviz_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 loadedvar <- 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)
生活水準を示す指標であると考えられる。経済的要因を主に反映していると考えられる第2主成分は国の健康状態や福祉の水準を示す指標と考えられる。
健康指標を反映していると推測される。
d0 <- read.csv(file = "https://stats.dip.jp/01_ds/data/UN_jp.csv")
library(DT)
library(factoextra)
datatable(d0, caption = "United Nations Data")numeric_data <- d0[, sapply(d0, is.numeric)]
pca_result <- prcomp(numeric_data, scale. = TRUE)
summary(pca_result)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 1.901 0.855 0.6381 0.4287 0.2497
## Proportion of Variance 0.723 0.146 0.0814 0.0368 0.0125
## Cumulative Proportion 0.723 0.869 0.9508 0.9875 1.0000pca_scores <- as.data.frame(pca_result$x)
pca_scores$Country <- d0$Country
top_countries <- pca_scores[order(-pca_scores$PC1), ]
print(top_countries)## PC1 PC2 PC3 PC4 PC5
## 100 3.83 -3.41 -2.450 0.471 2e-01
## 130 3.24 -2.55 -1.919 0.131 9e-02
## 101 3.12 -1.36 -0.051 0.334 -2e-01
## 168 2.99 -1.67 -1.599 0.200 -8e-02
## 155 2.95 -1.15 0.162 0.147 -9e-02
## 75 2.90 -0.54 0.539 0.062 -3e-01
## 143 2.84 -2.64 -0.875 0.216 3e-01
## 8 2.83 -1.64 -0.672 -0.092 -9e-02
## 16 2.67 -1.26 0.076 -0.056 -3e-02
## 47 2.66 -1.59 -0.659 0.072 1e-01
## 167 2.59 -1.22 -0.520 -0.131 -2e-02
## 30 2.50 -1.00 -0.564 0.024 -1e-01
## 77 2.50 -1.06 0.117 -0.311 -4e-02
## 86 2.50 -0.40 -0.982 -0.050 -3e-01
## 59 2.49 -1.04 -0.363 -0.113 -2e-02
## 123 2.49 -1.10 -0.506 -0.003 -3e-02
## 60 2.44 -0.86 -0.177 -0.288 -1e-01
## 9 2.39 -0.57 -0.970 0.198 -9e-02
## 65 2.32 -0.53 -0.575 0.120 -6e-02
## 142 2.32 -0.62 0.744 -0.122 -2e-01
## 185 2.28 -1.22 -0.468 -0.074 3e-02
## 161 2.26 -0.21 -0.139 -0.058 -2e-01
## 107 2.25 -0.13 0.851 0.132 -2e-01
## 84 2.18 -0.15 -0.560 -0.017 -2e-01
## 91 2.18 -1.67 0.154 0.101 3e-01
## 184 2.16 -0.65 -0.236 -0.102 -3e-02
## 144 2.15 0.08 0.368 -0.023 -2e-01
## 183 2.11 -0.94 -0.155 0.256 2e-01
## 125 2.11 -0.68 0.102 -0.299 -5e-02
## 82 2.03 -0.72 -1.200 -0.209 6e-03
## 83 1.98 -0.86 0.395 -0.863 -5e-02
## 44 1.97 -0.04 -0.267 0.089 -6e-02
## 24 1.89 -0.49 -0.222 -0.106 9e-02
## 122 1.79 -0.42 0.805 -0.025 -1e-01
## 34 1.77 0.13 0.918 -0.231 -2e-01
## 45 1.77 0.26 0.176 0.038 2e-02
## 67 1.76 0.21 -0.514 0.009 -8e-02
## 141 1.73 0.50 -0.378 0.093 -1e-01
## 186 1.61 -0.10 1.084 -0.213 -2e-01
## 11 1.60 -0.36 0.441 0.073 -9e-02
## 124 1.57 -0.25 -0.958 -0.140 1e-01
## 157 1.52 0.64 -0.845 -0.007 -6e-02
## 43 1.51 0.77 0.663 -0.024 -9e-02
## 56 1.46 0.43 0.220 -0.045 6e-02
## 5 1.46 -0.05 1.192 -0.265 -1e-01
## 76 1.40 0.56 0.214 0.187 1e-01
## 12 1.40 -0.44 0.786 -0.221 3e-01
## 140 1.37 0.77 -0.029 0.086 -2e-02
## 189 1.34 -0.39 1.111 -0.220 -4e-02
## 42 1.31 0.74 -0.182 0.062 2e-03
## 156 1.31 0.73 -0.348 0.197 5e-02
## 94 1.31 0.61 0.294 0.138 7e-02
## 99 1.30 0.62 0.250 0.149 1e-01
## 23 1.28 -0.01 0.976 0.161 -2e-01
## 131 1.26 -0.15 0.148 -0.038 2e-01
## 15 1.23 0.63 0.730 0.224 2e-01
## 40 1.21 0.76 0.255 -0.204 -2e-01
## 25 1.16 0.63 0.601 0.179 9e-02
## 146 1.15 0.39 0.527 0.341 2e-01
## 111 1.13 0.21 0.691 -0.267 -1e-01
## 95 1.13 -0.01 1.058 0.304 -5e-02
## 61 1.10 0.23 -0.759 -0.034 2e-01
## 98 1.05 0.04 0.637 -0.276 2e-02
## 115 0.98 0.84 0.216 0.106 1e-01
## 7 0.97 0.40 -0.817 0.262 -1e-02
## 145 0.97 0.89 0.078 0.251 -4e-02
## 151 0.97 -0.37 0.653 -0.230 1e-01
## 14 0.96 0.89 -0.634 0.107 -1e-01
## 39 0.94 -0.01 0.557 -0.277 2e-01
## 135 0.92 0.24 0.652 -0.330 -1e-01
## 104 0.90 0.25 0.571 -0.411 3e-01
## 182 0.90 0.76 0.651 0.353 2e-01
## 133 0.89 -0.15 0.942 0.323 2e-01
## 172 0.88 0.97 0.231 0.296 -2e-02
## 21 0.87 1.28 -0.130 0.387 -1e-01
## 36 0.86 0.30 0.718 -0.196 -8e-02
## 178 0.84 0.26 0.432 0.079 -1e-01
## 153 0.83 0.98 0.103 0.185 7e-02
## 2 0.82 1.13 0.017 0.097 -3e-01
## 80 0.78 0.49 0.655 0.399 -2e-01
## 138 0.77 0.22 0.828 -0.215 -6e-02
## 177 0.76 0.60 0.558 0.061 -1e-01
## 51 0.68 0.50 0.543 -0.304 -2e-01
## 6 0.64 0.72 0.468 0.203 -3e-01
## 105 0.64 1.34 -0.418 0.008 5e-02
## 53 0.60 0.61 0.485 -0.091 -1e-01
## 110 0.59 1.14 -0.451 0.210 7e-02
## 165 0.57 0.26 0.571 0.031 7e-02
## 49 0.54 0.31 0.608 -0.209 -1e-01
## 31 0.54 0.66 0.381 -0.192 -1e-01
## 87 0.52 0.03 0.956 -0.406 6e-02
## 3 0.52 0.46 0.549 0.066 -4e-02
## 64 0.49 1.00 0.107 0.339 -3e-01
## 173 0.46 1.47 -0.637 0.173 2e-02
## 35 0.45 1.05 -0.109 0.352 -6e-02
## 113 0.41 1.19 0.003 0.444 2e-01
## 68 0.38 1.03 -0.522 -0.159 4e-02
## 126 0.34 0.76 0.323 -0.325 -8e-02
## 169 0.34 0.70 0.183 -0.532 5e-02
## 17 0.32 0.71 0.029 -0.446 -2e-02
## 163 0.30 0.77 -0.087 0.169 6e-04
## 85 0.27 0.73 0.012 -0.043 -9e-02
## 148 0.24 1.38 -0.905 -0.011 6e-02
## 88 0.22 0.26 0.148 0.036 9e-02
## 116 0.21 0.60 0.346 0.116 -2e-01
## 129 0.17 0.70 0.490 0.309 4e-02
## 190 0.13 1.52 -0.603 0.113 -1e-01
## 137 0.05 0.36 0.453 -0.295 -1e-01
## 114 0.04 0.39 0.536 0.081 -1e-01
## 58 0.02 0.65 0.101 -0.119 3e-01
## 10 -0.05 0.52 0.043 0.316 -3e-01
## 52 -0.07 0.86 -0.174 -0.257 -2e-02
## 74 -0.07 0.61 0.120 -0.475 -6e-02
## 79 -0.08 0.88 -0.100 0.300 9e-02
## 176 -0.11 1.19 -1.608 0.536 1e-03
## 134 -0.12 -0.17 0.891 -1.205 2e-01
## 162 -0.14 1.77 -1.244 -0.283 7e-02
## 62 -0.23 -1.03 1.104 0.295 2e-01
## 139 -0.26 0.60 0.053 -0.364 2e-01
## 108 -0.39 -0.33 0.838 -1.032 4e-01
## 69 -0.47 0.33 0.043 -0.885 -4e-03
## 20 -0.50 -0.08 0.748 -0.093 -8e-02
## 72 -0.52 1.08 -0.646 0.276 -3e-01
## 120 -0.54 -1.28 1.895 0.567 6e-01
## 179 -0.56 0.34 0.088 0.546 -3e-01
## 92 -0.60 0.93 -0.359 0.020 -9e-02
## 19 -0.66 0.88 -0.360 0.421 -9e-02
## 187 -0.66 0.86 -0.320 0.386 -4e-01
## 81 -0.71 -0.25 0.705 -1.104 2e-02
## 180 -0.73 0.20 0.180 -0.401 9e-01
## 175 -0.78 0.91 -0.879 -0.921 1e-01
## 93 -0.79 0.86 -0.354 0.259 -1e-02
## 149 -0.80 1.03 -1.018 -0.952 1e-01
## 118 -0.80 0.92 -0.318 0.773 -2e-01
## 13 -0.80 1.05 -0.516 0.492 -2e-01
## 188 -0.89 0.83 -0.761 -0.779 2e-01
## 150 -0.93 -0.19 0.687 -0.027 -4e-02
## 121 -0.97 1.23 -0.863 0.142 9e-02
## 119 -0.99 0.37 -0.251 0.227 6e-01
## 160 -1.01 -0.36 0.598 1.263 7e-01
## 22 -1.04 -0.39 0.612 1.142 1e+00
## 112 -1.08 0.87 -0.799 -0.274 2e-01
## 78 -1.13 0.77 -0.460 0.475 -2e-01
## 66 -1.26 -0.09 0.317 -0.323 1e-01
## 73 -1.29 -0.06 0.455 0.411 -2e-01
## 170 -1.30 0.75 -0.614 -0.037 -4e-01
## 28 -1.48 0.92 -0.739 0.721 -1e-01
## 158 -1.50 0.76 -0.872 -0.665 2e-01
## 90 -1.50 0.06 0.086 0.188 8e-02
## 48 -1.51 -0.91 1.262 0.542 -3e-01
## 132 -1.59 0.28 -0.197 0.323 -5e-01
## 102 -1.63 0.32 -0.405 -0.792 1e-01
## 164 -1.84 -0.14 -0.024 -0.205 -3e-02
## 191 -1.85 0.07 -0.385 -0.961 1e-01
## 38 -1.89 -0.88 0.772 0.001 1e-02
## 193 -1.89 0.11 0.071 0.875 8e-01
## 136 -1.90 0.74 -1.010 -0.190 2e-01
## 152 -1.97 -0.25 0.099 -0.376 4e-01
## 55 -2.02 0.41 -0.647 -0.364 2e-01
## 63 -2.04 -0.76 0.696 -0.211 -2e-02
## 174 -2.08 -0.25 0.196 0.327 -5e-02
## 41 -2.17 -0.57 0.439 0.223 5e-02
## 109 -2.24 -0.37 0.094 -0.008 -2e-01
## 57 -2.37 0.40 -0.752 0.174 -5e-02
## 37 -2.40 -0.05 -0.407 -0.422 -8e-02
## 29 -2.53 -1.02 0.792 0.569 -1e-01
## 96 -2.53 0.08 -0.232 1.308 8e-01
## 89 -2.56 0.03 -0.536 -0.202 3e-01
## 97 -2.62 -0.78 0.377 -0.215 -1e-01
## 50 -2.63 -0.32 -0.389 -1.229 1e-01
## 171 -2.66 -0.22 -0.408 -0.823 4e-01
## 166 -2.66 0.08 -0.551 1.262 7e-01
## 18 -2.72 -0.68 0.154 -0.240 -1e-01
## 54 -2.94 -1.56 -0.367 0.408 -1e-01
## 4 -2.96 -1.52 0.715 0.242 -3e-01
## 117 -3.00 -0.68 0.152 0.329 2e-01
## 70 -3.05 -0.66 0.003 -0.016 -2e-01
## 128 -3.11 -1.22 0.533 -0.055 -5e-02
## 26 -3.20 -0.54 -0.333 -0.611 2e-01
## 32 -3.23 -0.79 0.187 0.722 -2e-01
## 27 -3.51 -0.06 -0.779 0.854 -2e-01
## 147 -3.54 -0.47 -0.572 -0.100 -4e-01
## 154 -3.59 -1.01 0.237 0.748 -2e-01
## 181 -3.59 -0.35 -0.785 -0.605 3e-01
## 106 -3.69 -1.16 0.094 -0.397 -7e-02
## 192 -3.72 -1.18 0.060 -0.467 4e-01
## 103 -3.74 -0.66 -0.514 -0.480 -4e-02
## 71 -3.82 -0.91 -0.084 0.656 -5e-01
## 159 -3.86 -1.29 0.156 -0.419 -3e-01
## 46 -3.92 -1.18 0.133 0.293 -4e-01
## 127 -4.09 -0.85 -0.618 -1.066 1e-02
## 33 -4.33 -1.24 -0.144 0.254 -8e-01
## 1 -4.61 -1.25 -0.276 0.231 -7e-01fviz_pca_biplot(pca_result, repel = TRUE)
上記から、Luxembourgが最も豊かであると推測される。
GDPが最も高く、平均寿命も乳児死亡率も良い数値である。高いGDPと生活の質を両立している、経済的に暮らしやすい国である。