必要なパッケージを読み込む。
::p_load(tidyverse,
pacman
rsample,
class, gmodels)
ミンコフスキー距離を測る関数を作る。(dist()
という関数もあるが、計算内容を理解するためにあえて作る。)
<- function(x, y = NULL, p = 2) {
minkowski # y が与えられないときは、原点とxの距離を測る
if (is.null(y)) y <- rep(0, length(x))
sum(abs(x - y)^p))^(1/p)
( }
2次元ベクトルをランダムにいくつか生成し、原点からのミンコフスキー距離(ノルム)を測ってみよう。 1回目。
<- rnorm(2, mean = 0, sd = 3)
beta beta
## [1] -3.926167 -2.443105
minkowski(beta, p = 2) # L2ノルム(ユークリッド距離)
## [1] 4.624235
minkowski(beta, p = 1) # L1ノルム(マンハッタン距離)
## [1] 6.369272
2回目。
<- rnorm(2, mean = 0, sd = 3)
beta beta
## [1] 0.04625993 -3.20774908
minkowski(beta, p = 2) # L2ノルム(ユークリッド距離)
## [1] 3.208083
minkowski(beta, p = 1) # L1ノルム(マンハッタン距離)
## [1] 3.254009
3回目。
<- rnorm(2, mean = 0, sd = 3)
beta beta
## [1] -5.593775 -1.169007
minkowski(beta, p = 2) # L2ノルム(ユークリッド距離)
## [1] 5.714621
minkowski(beta, p = 1) # L1ノルム(マンハッタン距離)
## [1] 6.762782
このように、距離を測ることができる。(当たり前だが)\(L_2\)ノルムよりも\(L_1\)ノルムのほうが大きい。
高次元のベクトルについても、原点からの距離を測ることができる。 20次元の場合。
<- rnorm(20, mean = 0, sd = 3)
beta beta
## [1] 0.9146441 -4.5505172 0.9599669 3.9842991 -3.2336485 4.3306049
## [7] -1.8077692 4.3012802 6.0072563 -1.0088395 1.7218507 2.0538056
## [13] -4.4672737 -9.5612610 -4.4332970 -2.2749843 -1.9943872 4.0057640
## [19] 4.6617256 -1.0632469
minkowski(beta, p = 2)
## [1] 17.68325
minkowski(beta, p = 1)
## [1] 67.33642
同じ次元の2つのベクトル間の距離も測れる。 20次元の場合。
<- rnorm(20, mean = 0, sd = 3)
x <- rnorm(20, mean = 0, sd = 3)
y cbind(x, y)
## x y
## [1,] -0.848191423 6.58940462
## [2,] -2.169053687 1.14978266
## [3,] -3.635219570 -1.44077379
## [4,] 3.154534496 -1.92476911
## [5,] -3.051425208 1.80255388
## [6,] -1.636872241 1.19653233
## [7,] -1.282081829 0.45640632
## [8,] 0.509077708 2.02177432
## [9,] 1.388155530 5.85392395
## [10,] -1.307016705 -6.00296898
## [11,] -3.737655930 0.06502178
## [12,] 3.420520354 5.73235875
## [13,] 0.512057509 -3.13812750
## [14,] -0.637968117 -0.69257612
## [15,] -2.278908101 -2.82291105
## [16,] 3.185022713 0.98435345
## [17,] -1.253209201 -2.26845500
## [18,] -0.279059957 6.38361902
## [19,] 0.008734508 0.61503575
## [20,] -0.716383777 -1.19281993
minkowski(x, y, p = 2)
## [1] 16.12854
minkowski(x, y, p = 1)
## [1] 59.45511
UCI Machine Learning Repository にある Congressional Voting Records Data Set(アメリカ合衆国議会における議員の投票データ)を例に、\(k\)-NN法で分類を行ってみよう。
まず、データ を入手する(download.file()
がうまくいかないときは手動でダウンロードする)。
dir.create("data")
download.file(
url = "https://archive.ics.uci.edu/ml/machine-learning-databases/voting-records/house-votes-84.data",
dest = "data/house-votes-84.csv"
)
データを読み込む。変数名が付いていないので注意。
<- read_csv("data/house-votes-84.csv",
Vote col_names = FALSE)
データの中身を確認する。
glimpse(Vote)
## Rows: 435
## Columns: 17
## $ X1 <chr> "republican", "republican", "democrat", "democrat", "democrat", "d…
## $ X2 <chr> "n", "n", "?", "n", "y", "n", "n", "n", "n", "y", "n", "n", "n", "…
## $ X3 <chr> "y", "y", "y", "y", "y", "y", "y", "y", "y", "y", "y", "y", "y", "…
## $ X4 <chr> "n", "n", "y", "y", "y", "y", "n", "n", "n", "y", "n", "n", "y", "…
## $ X5 <chr> "y", "y", "?", "n", "n", "n", "y", "y", "y", "n", "y", "y", "n", "…
## $ X6 <chr> "y", "y", "y", "?", "y", "y", "y", "y", "y", "n", "y", "y", "n", "…
## $ X7 <chr> "y", "y", "y", "y", "y", "y", "y", "y", "y", "n", "n", "y", "n", "…
## $ X8 <chr> "n", "n", "n", "n", "n", "n", "n", "n", "n", "y", "n", "n", "y", "…
## $ X9 <chr> "n", "n", "n", "n", "n", "n", "n", "n", "n", "y", "n", "n", "y", "…
## $ X10 <chr> "n", "n", "n", "n", "n", "n", "n", "n", "n", "y", "n", "n", "y", "…
## $ X11 <chr> "y", "n", "n", "n", "n", "n", "n", "n", "n", "n", "n", "n", "n", "…
## $ X12 <chr> "?", "n", "y", "y", "y", "n", "n", "n", "n", "n", "?", "y", "n", "…
## $ X13 <chr> "y", "y", "n", "n", "?", "n", "n", "n", "y", "n", "?", "?", "n", "…
## $ X14 <chr> "y", "y", "y", "y", "y", "y", "?", "y", "y", "n", "y", "y", "y", "…
## $ X15 <chr> "y", "y", "y", "n", "y", "y", "y", "y", "y", "n", "y", "y", "n", "…
## $ X16 <chr> "n", "n", "n", "n", "y", "y", "y", "?", "n", "?", "n", "?", "?", "…
## $ X17 <chr> "y", "?", "n", "y", "y", "y", "y", "y", "y", "?", "n", "?", "?", "…
このデータの各行は議員である。 第1列(X1
)がラベルで、その議員の所属政党を表す。
table(Vote$X1)
##
## democrat republican
## 267 168
各議員は、“democrat” (民主党員)か “republican”(共和党員)かのいずれかである。
第2列 (X2
) から 第17列 (X17
) までは、ある法案に賛成した (y
) か反対した (n
) かを示している。
table(Vote$X2)
##
## ? n y
## 12 236 187
賛成と反対だけでなく、?
が含まれていることがわかる。
必ずしも必要ではないが、ラベルを\(y\)、各説明変数を\(x1\)から\(x16\)として変数名を付けなおそう。
names(Vote) <- c("y", paste0("x", 1:16))
次に、法案に対する賛否を、数値に置き換えよう。
<- Vote %>%
myd mutate(across(x1:x16, function(v) case_when(
== "y" ~ 1,
v == "n" ~ -1,
v TRUE ~ 0
)))
このデータを、訓練用と検証用に分割しよう。
set.seed(2021-10-17)
<- initial_split(myd, prop = 0.8)
Vote_split <- training(Vote_split) # 訓練(学習)用
Vote_train <- testing(Vote_split) # 検証(テスト)用 Vote_test
さらに、ラベル(応答変数)と説明変数に分ける。
<- Vote_train[, 1] %>%
y_train as.matrix()
<- Vote_train[, -1] %>%
X_train as.matrix()
<- Vote_test[, 1] %>%
y_test as.matrix()
<- Vote_test[, -1] %>%
X_test as.matrix()
\(k\)-NN法は遅延学習(怠惰学習)を行うので、特に訓練は必要ない。 利用可能な状態でデータを保存(暗記)すればそれが学習なので、上で訓練済みである。
検証用データの各点について、以下を実行する。
\(k=5\)として、ユークリッド距離を用いて上の手続きを実行してみよう。
まず、検証用データの各点について、訓練用データのすべての点との距離を測る。 検証用データの観測点の数は、
<- nrow(X_test)) (J
## [1] 87
である。訓練用データの観測点の数は、
<- nrow(X_train)) (N
## [1] 348
である。
距離を記録するための行列を用意する。
<- matrix(NA, nrow = N, ncol = J) d_euclid
距離を測る。
for (j in 1:J) {
for (n in 1:N) {
<- minkowski(X_test[j, ], X_train[n, ], p = 2)
d_euclid[n, j]
} }
検証用データの各点について、最近傍の5つを見つける。
<- apply(d_euclid, 2, order)[1:5, ] nearest5
最近傍にある5点の所属政党を調べる。
<- matrix(NA, nrow = 5, ncol = J)
party for (j in 1:J) {
<- y_train[nearest5[, j], 1]
party[, j] }
多数決をとる。
<- apply(party, 2, function(x) table(x) %>% which.max() %>% names()) y_pred
予測が当たっているかどうか調べる。
mean(y_pred == y_test)
## [1] 0.8850575
的中率は約88.5%である。
全員民主党員であると予測した場合の的中率は
mean(y_test == "democrat")
## [1] 0.5747126
であり、全員共和党員だと予測した場合の的中率は
mean(y_test == "republican")
## [1] 0.4252874
である。\(k\)-NN法の予測はそこそこ当たっていると言えるだろう。
実際に分類を行う際には、class パッケージのknn()
を使うことができる。 上と同じ分類を、class::knn()
を用いて実行してみよう。
<- knn(train = X_train,
out test = X_test,
cl = as.factor(y_train),
k = 5)
結果は、gmodels パッケージの CrossTable()
で確認する。
CrossTable(x = as.factor(y_test),
y = out,
prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 87
##
##
## | out
## as.factor(y_test) | democrat | republican | Row Total |
## ------------------|------------|------------|------------|
## democrat | 44 | 6 | 50 |
## | 0.880 | 0.120 | 0.575 |
## | 0.917 | 0.154 | |
## | 0.506 | 0.069 | |
## ------------------|------------|------------|------------|
## republican | 4 | 33 | 37 |
## | 0.108 | 0.892 | 0.425 |
## | 0.083 | 0.846 | |
## | 0.046 | 0.379 | |
## ------------------|------------|------------|------------|
## Column Total | 48 | 39 | 87 |
## | 0.552 | 0.448 | |
## ------------------|------------|------------|------------|
##
##
この表の、主対角線(左上から右下)上にあるのが正しく予測された観測点の数(44 と 33)である。 実際には民主党員 (democrat) である50人のうち44人が民主党員であると正しく予測され、6人が共和党員 (republican) であると誤って予測されている。 同様に、実際には共和党員である37人のうち33人が共和党員であると正しく予測され、4人が民主党員であると誤って予測されている。 予測の的中率は、
44 + 33) / 87 (
## [1] 0.8850575
であり、パッケージを使わずに分類した結果に一致することが確認できる。
実習課題