ラベル 特異値分解 の投稿を表示しています。 すべての投稿を表示
ラベル 特異値分解 の投稿を表示しています。 すべての投稿を表示

2012/10/19

文系のための「自由度調整済み決定係数」

ここまでの話では、重回帰分析の仕組みとモデルの読み方を整理してきた。
要するに、重回帰係数について、連立方程式を解き、
重回帰係数値の正負値の大小によって変数間の関係を観察する

そうそう。特異値分解による擬逆行列から連立方程式を解く場合には、
以下のような式によって、重回帰係数を算出することができた。
少々、クドいかもしれないが、とりあえず再掲しておく。



一般的に、擬逆行列の解法は変数pが対象数nよりも小さい場合と(n > p)、
変数pが対象数nよりも大きい場合(n < p)で異なっているが、
特異値分解を用いた場合には近似的に計算することができる。 

とにかく、この式によって導出されたベクトルが重回帰係数であり、
この重回帰係数を用いて、次のような重回帰モデルを導出することができる。



さて、基本的な話は、これで収まっているのであるが、 問題となるのは、
このモデルが本当に正しいのか?という問題である。
まずは、このモデルの適合の度合いというか、説明力を知りたい。

最も単純な方法は、残差から重回帰モデル適合性を評価する決定係数を用いる方法。
 予測値のバラツキ(回帰の平方和)「Sr」、残差のバラツキ(残差平方和)「Se」、
そして、目的変数の総平方和St」から以下の式によって表すことができる。



この式を変形し、以下のようにしたものが決定係数と呼ばれるものであった。



詳細に関しては、残差決定係数の話ですでに整理済みの話である。
決定係数は、モデルで説明できない残差の大きさを反映した指標である。

ところで、この指標は直感的に理解しやすいのであるが、少々、問題がある。
実は、変数の数が増えれば増えるほど決定係数の値は高くなってしまうのである
そこで登場するのが、「自由度修正済み決定係数」と呼ばれるものである。



ここでは、目的変数の総平方和「St」に対して対象数「n-1」で基準化し、
Seは、Stと同様に対象数で基準化すると同時に、説明変数の数「p」で基準化をしている。
つまり、全体では一つの対象における一つの変数当たりの残差でモデルを評価する

このような調整を行うことで、対象数と変数の数の影響が除去される
とにかく、前回のデータを用いて、自由度調整済み決定係数とやらを計算してみる。
まず、前回と同様に、インターネット経由で直接データを読み込む。
今回の演習で使用するデータも前回と同じ。


library(RCurl) 

ライブラリを読み込めたら、
以下のコマンドを実行する。

# Google Spreadsheet からデータをダウンロードする
data <- getURL("https://docs.google.com/spreadsheet/pub?key=0AtOtIs5BjRVhdDdyTmgtNm9DcEVJb3VLbnh3ZFlNb2c&single=true&gid=0&range=A1%3AH295&output=csv
")

# ダウンロードしたデータを読み込む
X <- as.data.frame(read.table(textConnection(data), header=TRUE, row.names=1, sep=","))


次に、重回帰分析を実行する。前回と同様に、「墳長」を目的変数とし、
その他の変数から重回帰モデルを立てる。

# 念の為に最初のデータの状態を保存しておく。
O <- X

# 実際の目的変数も保存しておく。
y <- O[, 1]

 # 目的変数を元の行列から分離する
y <- X[, 1]
X <- as.matrix(X[, -1])

# 切片の計算のために先頭行を「1」の行列を付け加える。
Intercept <- matrix(rep(1, nrow(X)), ncol=1)
X <- cbind(Intercept, X)

# 特異値分解を行う
X.svd <- svd(X)
X.svd.v <- X.svd$v
X.svd.d <- diag(X.svd$d)
X.svd.u <- X.svd$u

 # 重回帰係数を求める
X.lm <- ((X.svd.v %*% solve(X.svd.d)) %*% t(X.svd.u)) %*% y 

# 解りやすいように名前を付ける。
rownames(X.lm) <- c("Intercept",colnames( X[,2:ncol(X)]))
colnames(X.lm) <- "coefficients" 

# 最後に重回帰モデルから予測する。
# なお、以下の計算はベクトルの成分の掛け算。
y_hat <- X.lm[1] + X.lm[2]*X[,2] + X.lm[3]*X[,3] + X.lm[4]*X[,4] + X.lm[5]*X[,5] + X.lm[6]*X[,6] + X.lm[7]*X[,7]

# まずは、StとSeを求めて、決定係数を算出する。
Se <- sum((y-y_hat)^2)
St <- sum((y-mean(y))^2)

# 以下が標準的な決定係数。
1-(Se/St) 

# 次に、自由度調整済み決定係数を求める
p <- ncol(X)-1
n <- length(y)
1-(Se/(n-p-1))/(St/(n-1)) 


実行結果は以下の通り。決定係数自由度調整済み決定係数はかなり高い。 

> # 以下が標準的な決定係数。
> 1-(Se/St)  
[1] 0.9926216

> # 次に、自由度調整済み決定係数を求める
> p <- ncol(X)-1
> n <- length(y)
> 1-(Se/(n-p-1))/(St/(n-1))  
[1] 0.9924674

決定係数は、モデルの当てはまりの良さを表す指標であるので、
今回の結果の場合は、モデル全体では99%以上の説明力を持っていることが解る。
したがって、今回のモデルは、非常に当てはまりの良いモデルだと言える。

さて、残差の検討もしておく。これも、必ず確認しておく必要がある
たしか、残差プロットは、まんべんなく散らばっていた方が良かった。
残差に何らかの傾向が現れているということは、重回帰モデルとして問題がある
# 残差を標準化してバラツキ具合を観察する。
plot(scale(y-y_hat), ylab="Residuals")
abline(h=0)
abline(h=c(-2, 2), col="gray", lty=2)

# 外れ値を検出する
(r.lower <- which(scale(y-y_hat) < -2)) # −2よりも小さいもの
(r.upper <- which(scale(y-y_hat) > 2))  # +2よりも大きいもの
1-((length(r.upper)+length(r.lower))/n)


そして、実行結果は以下の通り。

# 外れ値を検出する
> (r.lower <- which(scale(y-y_hat) < -2)) # −2よりも小さいもの
[1] 91 98 137 243 258
> (r.upper <- which(scale(y-y_hat) > 2)) # +2よりも大きいもの
[1] 53 94 121 127 131 162 164 263 264 267
> 1-((length(r.upper)+length(r.lower))/n)
[1] 0.9489796 


一般的に重回帰分析における残差は正規分布に従うとされている。
そして、標準正規分布に従うのであれば、±2σ95.4%が入ることになるので、
簡易な方法として、標準化した値の±2の外側を「外れ値」とする。 

今回の場合、全体の約94.9%が、±2σの範囲内に収まっていて、
また、散布図を見る限りは、何の傾向も見えてこない。
したがって、やはり、このモデルは非常に良い状況を表していることになる。 

自由度調整済み決定係数を用いることで、モデルの適合の度合いを知ることができ、
さらに、F検定という方法を用いることでモデルの適合性を評価するができる
これに関しては、次回に整理することにする。

2012/10/10

文系のための「重回帰分析のモデル」

重回帰分析の基本的な仕組みを理解したところで、
今度は、実際のデータを用いて重回帰モデルの検討方法を整理する。

今回のデータは、某国の某時代の某地域の古墳」のデータ。
実際のデータを少し加工し、詳細が特定できないようにマスキング
考古学的な解釈を避けるための処置。興味がある人は自分のデータで。

とりあえず、Google spreadsheet にデータを置いているので、
インターネット経由で直接データを読み込む。
この作業を行うためには、RCurlというライブラリを読み込む必要がある。

library(RCurl)

ライブラリを読み込めたら、以下のコマンドを実行する。

# Google Spreadsheet からデータをダウンロードする
data <- getURL("https://docs.google.com/spreadsheet/pub?key=0AtOtIs5BjRVhdDdyTmgtNm9DcEVJb3VLbnh3ZFlNb2c&single=true&gid=0&range=A1%3AH295&output=csv")

# ダウンロードしたデータを読み込む
X <- as.data.frame(read.table(textConnection(data), header=TRUE, row.names=1, sep=","))

このデータは、「294」の古墳が「対象」となっている。
属性は、墳長(length)後円径(bk_radius)後円高(bk_height)前方幅(fr_width)
前方長(fr_length)前方高(fr_height)くびれ(constricted)である。

なお、このデータの単位は、全て「メートル」であり、計測値は、10センチ単位まで。
扱うデータの単位を理解しておくことは基本中の基本なのであるが、
単位を無視して分析する人は少なくは無い。

ふむ。どこの国かは、特定できそうな変数であるが...まぁ、それは置いておく。
細かい詮索は無用。とにかく、これは架空のデータとして理解。
ちなみに、かつて、卒業論文研究のために集めたデータを改変したもの。

なお、後の処理のために、今回のデータはマトリクス型では無く、
データフレーム型というデータ型を指定しておく。

まずは、このデータの相関係数行列偏相関係数行列を確認しておく。
多次元データを扱う際には、最初にデータの全容を掴んでおくことが重要
やり方は、理解できているハズなので、出力結果のみを表示。

> round(cor(X),3)
            length bk_radius bk_height fr_width fr_length fr_height constricted
length       1.000     0.985     0.933    0.949     0.976     0.873       0.955
bk_radius    0.985     1.000     0.944    0.930     0.939     0.865       0.953
bk_height    0.933     0.944     1.000    0.882     0.887     0.896       0.900
fr_width     0.949     0.930     0.882    1.000     0.956     0.895       0.972
fr_length    0.976     0.939     0.887    0.956     1.000     0.866       0.950
fr_height    0.873     0.865     0.896    0.895     0.866     1.000       0.872
constricted  0.955     0.953     0.900    0.972     0.950     0.872       1.000

小数点以下の桁数が多すぎるので、小数点第三位までで丸め込み。
対象数が294の場合の相関の基準も考えておく。
たしか、相関係数のt検定というのがあった。

# 対象数を変数「n」に格納する。
n <- nrow(X)

# 有意水準1%、5%、10%の場合について検討する
abs(qt((0.01)/2, n-2)/sqrt(n-2+qt((0.01)/2, n-2)^2))
abs(qt((0.05)/2, n-2)/sqrt(n-2+qt((0.05)/2, n-2)^2))
abs(qt((0.10)/2, n-2)/sqrt(n-2+qt((0.10)/2, n-2)^2))

以下が実行結果。

> # 有意水準1%、5%、10%の場合について検討する
> abs(qt((0.01)/2, n-2)/sqrt(n-2+qt((0.01)/2, n-2)^2))
[1] 0.1500135
> abs(qt((0.05)/2, n-2)/sqrt(n-2+qt((0.05)/2, n-2)^2))
[1] 0.1144192
> abs(qt((0.10)/2, n-2)/sqrt(n-2+qt((0.10)/2, n-2)^2))
[1] 0.09611705

以上の結果から、有意水準1%で見ても、相関係数が「0.16」以上であれば、
相関があると行っても構わない。相関係数行列を見てみると、
どの値もこの水準よりも遥かに高い。したがって、全ての組合せには相関がある

この状態では見難いかもしれない。ついでに、散布図行列も出しておく。
# 「凝った」散布図行列を作るためにライブラリ「psych」を使う
library(psych)
pairs.panels(X, smooth=FALSE, density=FALSE, ellipses=FALSE, scale=TRUE)

なるほど。散布図行列を見てみても、なんらかの関係があるように見える。
ひょっとしたら、見せかけの相関が潜んでいるかもしれない。
ということで、次に、偏相関係数行列も計算しておく。

> library(corpcor)
> round(cor2pcor(cor(X)),3)
       [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]
[1,]  1.000  0.835  0.113  0.131  0.816 -0.078 -0.298
[2,]  0.835  1.000  0.249 -0.124 -0.586 -0.045  0.444
[3,]  0.113  0.249  1.000 -0.200 -0.103  0.540  0.073
[4,]  0.131 -0.124 -0.200  1.000  0.129  0.415  0.654
[5,]  0.816 -0.586 -0.103  0.129  1.000  0.068  0.270
[6,] -0.078 -0.045  0.540  0.415  0.068  1.000 -0.134
[7,] -0.298  0.444  0.073  0.654  0.270 -0.134  1.000

Rの偏相関係数行列は、ライブラリ「corpcor」が必要であり、
cor2pcor()関数は、相関係数行列の結果を使って、
偏相関係数を計算するのであった。ラベルは、相関係数行列と同じ。

偏相関を見てみると、墳長と後円径墳長と前方長の関係が際立って高い。
さて、この偏相関係数の値は、後に重要となるのであるが、
今は、深く踏み込まず、実際に重回帰分析の方法を整理する。

さて、このデータを用いて重回帰モデルを立てるためには、
最初に目的変数を決めなければならないのであるが、
墳長(length) 目的変数とし、その他の変数との関係を調べてみる

最初にすべきことは、何であったか?そうそう、重回帰係数を求めること。
一応、前回の復習を兼ねて、重回帰モデルの基本形を見てみる。



元のデータのうち、一つの変数が目的変数となり、
切片を計算するために、先頭に「1」が並んだ列が入っている。
このような行列を連立方程式に見たてて解いてやると重回帰係数が出てくるはず。

連立方程式を解くためには、逆行列が必要となるが、
残念ながら逆行列は正方行列にしか使えない。どうれば良かったか?
たしか、擬逆行列を用いるのであった。

二つの方法を紹介したが、ここでは特異値分解を使う。
既に述べたようにn✕p行列とp✕n行列では解き方が異なる
そのような場合でも、特異値分解を用いれば擬逆行列が計算できる

重回帰分析を実行できるソフトによっては、変数の数が対象数よりも多い場合に、
デタラメな結果を表示することもあるらしい。注意が必要である。
擬逆行列重回帰分析の仕組みを知っていれば解ることであるが...。

いずれにせよ、対象数よりも変数の方が多いようなデータに対して、
いわゆる「多変量解析」を行うのは危険極まりないのである。
上記の意味が解らない人は、もう一度、擬逆行列の話を参照すること。

さてさて、特異値分解を用いた方法はどのような方法であったか?
これも、もう一度確認しておくことにする。



Rには、特異値分解を行うためのsvd()関数がある。
この関数を覚えておくと主成分分析など他の分析でも役立つ。

少々、話が逸れてしまったが、上記のことを確認した上で、
実際に、以下の手順で重回帰係数を求めてみる。

#  念の為に最初のデータの状態を保存しておく。
O <- X

# 目的変数を元の行列から分離する
y <- X[, 1]
X <- as.matrix(X[, -1])

# 切片の計算のために先頭行を「1」の行列を付け加える。
Intercept <- matrix(rep(1, nrow(X)), ncol=1)
X <- cbind(Intercept, X)

# 特異値分解を行う
X.svd <- svd(X)
X.svd.v <- X.svd$v
X.svd.d <- diag(X.svd$d)
X.svd.u <- X.svd$u

# 重回帰係数を求める

# 特異値分解を行う
X.svd <- svd(X)
X.svd.v <- X.svd$v
X.svd.d <- diag(X.svd$d)
X.svd.u <- X.svd$u

# 重回帰係数を求める
X.lm.coefficient <- ((X.svd.v %*% solve(X.svd.d)) %*% t(X.svd.u)) %*% y

# 解りやすいように名前を付ける。
rownames(X.lm.coefficient ) <- c("Intercept",colnames( X[,2:ncol(X)]))
colnames(X.lm.coefficient) <- "coefficients"

# 最後に結果を表示する
X.lm.coefficient

実行結果は以下の通り。

> # 最後に結果を表示する
> X.lm.coefficient
            coefficients
Intercept     1.31774995
bk_radius     1.05513862
bk_height     0.41494162
fr_width      0.09120632
fr_length     0.90234517
fr_height    -0.23795594
constricted  -0.33198797

これでめでたく重回帰係数が求まったはずだが...本当に計算できているのか?
Rにおける重回帰分析を行うための関数は、単回帰と同じ。
どのような関数であったか?頑張って思い出してみる。

# Rで重回帰分析を行なってみる。
lm(formula=length~bk_radius+bk_height+fr_width+fr_length+fr_height+constricted, data=O)

実は、単回帰の話で用いたlm()関数で良い。
すでに、Xのデータは、元のデータと変わってしまっているので、
ここでは、元のデータをコピーである行列「O」を用いている。

lm()関数では、少々、見慣れない形でデータが指定されている。
まず、パラメータ「formula」をモデル式と呼び、ここでモデルを定義し、
実際のデータをパラメータ「data」で指定する。

この場合は、「〜」を挟んで右側が目的変数であり、左側が説明変数となる。
今回は、全ての変数を使っているが、使う変数をここで決めることができる。
なお、全ての変数を使う場合には、次のようにも指定できる

lm(formula=length~., data=O)

もちろん、上記二つの結果は同じになる。
とにかく、実行結果は以下の通り。

> lm(formula=length~., data=O)

Call:
lm(formula = length ~ ., data = O)

Coefficients:
(Intercept)    bk_radius    bk_height     fr_width    fr_length    fr_height  
    1.31775      1.05514      0.41494      0.09121      0.90235     -0.23796  
constricted  
   -0.33199 

重要な部分は、「Coefficients: 」から後の部分。この部分に重回帰係数が並んでいる。
特異値分解を使って解いた場合と結果が同じことを確認できたはず。
重回帰分析の解法を理解できていれば、lm()関数を用いても問題ないだろう。

さて、ここで、重回帰係数の検討に入りたいところであるが、
その前に、もう少し、重回帰モデルそのものについて考えてみたい。

何度も述べているが「回帰」というのは変数間の関係を観察するための方法である。
では、変数間に「全く」関係が無い場合、一体どのようなことになるのか?
ここで、簡単な実験を行なってみる。
# 乱数使って変数間に関係の無いデータを作る
test <- matrix(c(runif(1000),runif(1000)), ncol=2)

# 回帰係数を求める
b0 <- lm(test[,2]~test[,1])$coefficient[1]
b1 <- lm(test[,2]~test[,1])$coefficient[2]

# データをプロットする。
rng <- c(0, 1)
plot(test[,1], test[,2], ylim=rng, xlab="x", ylab="y", pch=16, col="lightblue")
par(new=TRUE)
plot(test[,1], test[,1]*b1+b0, type="l", ylim=rng, xlab="", ylab="", xaxt="n", yaxt="n", col="blue")

# yの平均を表す水平線を引く
abline(h=mean(test[,2]), col="red", lty=2, ltw=2)

さて、この図を見て解るように、関係が無いということは、
傾きは限りなく「0」に近づき、切片のみが反映されていることが解る。

たしか、xの平均値のときにyの平均を通るように調整した際のyの値
切片であったので、結局は、平均によって説明することと同じなのである。
この状況は、lm()関数のモデル式でも表すことができる。

ここで、もう一度、古墳のデータに戻って確認してみる。

# まずは、行列「O」の「length」の平均値を計算する。
mean(O$length)

# 次に、lm()関数で変数を指定しない場合の係数を確認する。
lm(formula=length~1, data=O)$coefficient

以下がこの実行結果。

> # まずは、行列「O」の「length」の平均値を計算する。
> mean(O$length)
[1] 83.86105
>
> # 次に、lm()関数で変数を指定しない場合の係数を確認する。
> lm(formula=length~1, data=O)$coefficient
(Intercept)
   83.86105

つまり、他の変数との関係を除いてしまえば、平均によって説明することと同じ
また、作成した回帰モデルが本当に意味があるものであれば、
そのモデルは平均よりも妥当性が高い(説明力が高い)とも言える。

さて、ここからが、今回の話の「本題」である。
いやいや、ここまでの話は、少々長すぎた...かもしれない。

すなわち、重回帰モデルの検討の仕方。ここまでのことが理解できていれば簡単。
とりあえず、重回帰係数の絶対値の大きさと、その符号を観察する。



このモデルの中で、負の符号を取っているのは、前方高くびれ幅
したがって、前方高の値が「1メートル」増えると、墳長は「0.238メートル」減り
同様に、くびれ幅の値が「1メートル」増えると、墳長は「0.332メートル」減る

逆に、全長が増える場合を考えると、正の係数が最も大きいものが後円径であり、
この値が1メートル」増えると、墳長は「1.055メートル」増えることになる。
次に値が大きい前方長が「1メートル」増えると、「0.090メートル」墳長は増える

さて、このモデルでは、小数点第三位まで表しているのであるが、適切であろうか?
元のデータの単位がメートル単位であり、値は10センチ刻みであった。
したがって、ミリ単位というのは細かすぎる。本当は、小数点第二位までで十分。

たまに、コンピュータの出力をそのまま書き出している人がいるが、
計算結果の桁の下の方は、ほとんど計算誤差
意味のある桁数を理解しておく必要がある。

話が逸れたが、このようにして、ある変数とその他の変数の間の関係を、
それぞれの値の増減によって変化するかを観察するのが重回帰分析である。

ところで、この結果を見て、一種の「違和感」を感じた人もいるかもしれない。
規模の話なので、前方高くびれ幅が増えると、墳長が減って良いのか?
ここで、もう一度、偏相関係数の結果を見てみる。

> round(cor2pcor(cor(X)),3)
       [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]
[1,]  1.000  0.835  0.113  0.131  0.816 -0.078 -0.298
[2,]  0.835  1.000  0.249 -0.124 -0.586 -0.045  0.444
[3,]  0.113  0.249  1.000 -0.200 -0.103  0.540  0.073
[4,]  0.131 -0.124 -0.200  1.000  0.129  0.415  0.654
[5,]  0.816 -0.586 -0.103  0.129  1.000  0.068  0.270
[6,] -0.078 -0.045  0.540  0.415  0.068  1.000 -0.134
[7,] -0.298  0.444  0.073  0.654  0.270 -0.134  1.000

実は、変数間の関係性で言うと、特に、前方径の値は限りなく「0」近い
ひょっとしたら、モデルに加えない方が良いかもしれない
あるいは、後円高前方幅いらないかもしれない。

また、くびれ部に関しては、全体の大きさに対して、
変化の度合いが鈍感で、そのような状況が影響しているかもしれない。
とにかく、何とも言えない状況がある。

では、どうするべきか?

この問題を考えるためには、重回帰係数の妥当性の検討や、
どの変数を選択すべきであるか、という変数選択が必要になる。
ということで、次回は、重回帰係数の妥当性から整理してみることにする。

2012/10/04

文系のための「重回帰分析のモデル」(1)

変数の関係を観察するための基本的方法に「相関」と「回帰」の考え方がある。
相関は、変数間の結びつきの「連動性」を表す方法であり、
回帰は、変数間の結びつきの「関係性」を表す方法であった。

ここで「うん...?」となった人は、もう一度、相関の話回帰の話を復習。

相関の考え方の場合では、複数の変数の場合相関係数行列を用いたが、
回帰の考え方の場合には、どのように表すのか?というのが、今回のテーマである。

ところで、一般的な解説では「説明する」という言葉に重きを置いて、
回帰分析を解説することが多いが、回帰分析は変数間の関係を観察する手法である。
「説明変数」と「目的変数」という言葉に惑わされてはいけない。

まずは、2変数の場合における回帰、すなわち、単回帰の話を思い出してみる。
たしか、以下のような式によって、表されたのであった。



この式では、一方の変数のみで、もう一方の変数を変数を表そうとしていることが解る。
一般的な言い方をすると、一方の変数でもう一方の変数の「説明」を試みている。
ここで、説明される側の変数を目的変数説明する側の変数を説明変数と呼んだ。

この式において左辺の目的変数には「^(ハット)」が付いている。
したがって、説明変数によって導かれているのは推定値だと解る。
ここで、実際の値を表現するのであれば、以下のようになる。



左辺の目的変数の「^(ハット)」が取れて、右辺の最後に「」が付くだけ。
最後に付け足した「」は、説明しきれない「残差(誤差)を表すのであった。
説明変数によって、説明しきれなかった部分を最後に足してやれば元の値が解るハズ。

おそらく、ここまでの話は、理解できている...と信じたい。

さて、変数がさらに多くなるとどうなるのか?
p個の変数からなる多次元データがあったとして、
一つの変数を目的変数としたとき、次のように表すことができる。



p-1となっているのは、元の変数の内の1つが目的変数とな っているため。
p個の変数のうち、説明変数を抜いた「p-1」個の変数が説明変数となる。
この式では、目的変数推定値であるが、実際の値は次のように表すことができる。



これが、「重回帰分析」と呼ばれるもののモデルである。
添字が並んでいるので、混乱するかもしれないが、
要するに、変数が増えただけ。モデルとしては、基本的に単回帰と同じ。

これを実際に計算するとなると、少々面倒な手続きが必要となる。

まずは、目的変数を推定する式をと眺めてみる。気づくことはないか?
このままだと、少々、解りにくいかもしれない。
この式はベクトルの式で表されているので行列の式で表してみる。



行列の「掛け算」を理解していれば、難しくは無いハズ。
ここで知りたいのは、「β」のベクトルの部分。回帰係数のベクトルである。
これで、意味が解った人はスゴイ。解らない人のために式を変形してみる

たしか、行列には割り算が存在しない代わりに、
スカラー逆数に相当する、逆行列というのがあった。
まずは、これを使って両辺を基準化してみる。すると以下のようになる。



逆行列の性質から、元の行列に逆行列を掛けると、単位行列が出てくるので、
要するに、上の式は、実際には以下のようになっている。



単位行列に別の行列を掛けると、掛けた行列が出てくる。
つまり、何も起きないのであった。したがって、次のようになる。



最後に、左辺と右辺を入れ替えると次のようになる。



さて、ここまで変形してみて意味が解ればと合格。
要するに、連立方程式の形にもってきただけのこと。
逆行列を使えば連立方程式が解ける

もう少し、一般的な式に書きなおしてみると、以下のようになる。



本当にこの式で大丈夫だろうか?
逆行列は正方行列にしか使えないので、擬逆行列にしないといけない。
つまり、以下のようになる。擬逆行列の話を思い出してみる。



あるいは、特異値分解による逆行列の近似によって、以下のようにも表すことができる。
もちろん、計算結果は上の式と同じ。詳しくは、擬逆行列の話でも述べている。



以上のようにして、複数の変数における回帰係数を求めることができる。
すでに、ここまでの話を、一つずつ積み重ねてきた人は、
Rで重回帰分析における回帰係数を計算することができるハズ。

次の話では、実際のデータを用いてもう少し、
重回帰分析意味モデルの見方について整理したい。

文系のための「擬逆行列」(2)

逆行列というのは計算がとにかく厄介で、手計算で計算するのは大変。
それ故に、通常は、コンピュータの力を借りることになる。
しかしながら、逆行列の性質を知らなくても良いということでは無い。

これまで、行列の足し算引き算掛け算を行なってきたが、
行列の「割り算」そのものは存在しない。その代わりに、存在するのが逆行列である。
逆行列は、スカラーにおける逆数に相当し、行列を基準化するために用いる

つまり、逆行列は、厳密には「割り算」では無いけれど、
逆行列を掛ける(あるいは掛けられる)ということは、
スカラーにおいて逆数を掛けるような意味を持つ。

では、実際にどのような時に役立つのか?

実際には、様々なところで逆行列は登場するのであるが、
特に、逆行列を用いることで連立方程式が解ける
というのは、逆行列の重要な性質の一つである。

私は辛党なのだが、ケーキ屋さんになったつもりになって、
洋菓子を作るための分量を考えてみることにする。
まず、以下のようなレシピとそれに対応する分量が与えられたとする。


pancake doughnut sponge cake
cake flour
(gram per piece)
50.0
7.0
75.0
egg
(per piece)
0.5
0.2
3.0
milk
(millilitre per piece)
50.0
0.0
20.0
sugar
(gram per piece)
5.0
6.0
50.0

これは、ホットケーキドーナツカステラのレシピであり、
それぞれ、一個辺りの薄力粉の量卵の量牛乳の量砂糖の量が書いてある。
この通りに作れば、秘伝の洋菓子を作れる...かもしれない。

なお、これまでの話では、対象が行で変数が列となる「n×p行列」を扱ってきたが、
今回に関しては、対象が列で変数が行となる「p×n行列」となっている。
これは、後の話を理解しやすくするためであり、例外的なデータ構造となっている。

まずは、上記のレシピの分量を行列としてRに入れてみる。

# 各レシピにおける材料の分量をベクトルとして準備する
pancake <- c(50, 0.5, 50, 5.0)
doughnut <- c(7.0, 0.2, 0.0, 6.0)
spongecake <- c(75, 3.0, 20.0, 50.0)

# 作成したベクトルを結合して行列を作成する。
A <- cbind(pancake, doughnut, spongecake)

# 対称名を付ける
rownames(A) <- c("flour", "egg", "milk", "sugar")

ここで、cbind()関数というのは、ベクトルあるいは行列列に追加するための関数。
この関数も非常に良く使う。列を追加(結合)するためにはrbind()関数を使う。

上手くできると、以下のような行列が出来るはず。

> A
      pancake doughnut spongecake
flour    50.0      7.0         75
egg       0.5      0.2          3
milk     50.0      0.0         20
sugar     5.0      6.0         50

まずは、復習から。とりあえず、行列の掛け算を用いて、
ホットケーキ2ドーナッツ10カステラ1
を作ったときの総分量はどのようになるのか?これを考えてみる。

とりあえず、小麦粉の総量例を考えてみると、
ホットケーキの小麦粉、ドーナツの小麦粉、カステラの小麦粉のそれぞれの分量と
作りたい個数を掛けて足せば良いのだから、この場合は、

小麦粉の総分量= (50.0 ✕ 2)+(7.0 ✕ 10) +(75 ✕ 1)

となる。これは行列の掛け算で簡単に計算することができる。
行列の掛け算のルールは、「横✕縦」が原則であった。
つまり、以下のような式を考えれば良いことになる。



となるはず。Rで実際に計算して確かめてみる。
たしか、行列の「掛け算」のときには「%*%」を使うのだった。

# 作りたい個数を変数にセットする。
pieces <- c(2, 10, 1)

# 次に、行列の掛け算を実行
A %*% pieces

以下がこの行列の計算結果。

> # 次に、行列の掛け算を実行
> A %*% pieces
      [,1]
flour  245
egg      6
milk   120
sugar  120

このように、総分量を計算するのは至って簡単。
上手くやれば、洋菓子作りの分量計算を自動的にやってくれるソフトも作れる。
まぁ、現実問題として、そういったソフトの需要があるかという問題はあるが。

さて、以上のことが確認できたら、今度は、逆の場合を考えてみる。
すなわち、総分量があったとして、それで作れるお菓子の量を知りたい、
という状況を考えてみる。

薄力粉565g15牛乳260ml砂糖290gを使ったときに、
ホットケーキドーナッツカステラはそれぞれいくつ作れるのか?
今度は、これを考えてみる。まずは、式を考えなくてはならない。



知りたい場所が変わったので、今度はこのような式を考えることができる。
おそらく、ここまでは、想像できたはず。知りたい場所が変わっただけ。
計算はしないが、試しに、スカラーの計算に展開してみる。



そうそう。このようなものを連立方程式と呼ぶのであった。
我々が中学校までに習った連立方程式は、実は行列で表すことができる。
計算の順番を確認してみると、ちゃんと、横✕縦の形式になっていて対応がとれるハズ。

では、いよいよ、この連立方程式を解くことを考えてみる。
ここで、先程の行列の式を、よく観察してみる。
すると、あることに気づく。

左辺にxのベクトルを残し、右辺を基準化したら答えが解るのではないか?
ここで、スカラーの世界では、両辺を同じ数で割れば良かったはずだが、
残念ながら、行列の世界には「割り算」は存在しない。そこで、逆行列が登場する。



思わず割り算をしたくなるかもしれない。でも、割り算をしてはいけない
移動したレシピの行列を良く見てみる。右上に「-1」が付いている。
この右上の記号が逆行列を意味するのであった。

さて、もう一つ思い出してもらいたい。通常の逆行列の条件は何だったか?
既に述べたように、逆行列は正方行列にしか対応しなかった
つまり、ここでは、擬逆行列を使う必要が出てくる。

今の状況では、少々解りにくい。記号を使って式を般化してみる。



元の行列の転置行列元の行列を掛けると正方行列になる。
この正方行列の逆行列は、転置行列の分だけ余分に基準化しているので、
さらに、転置行列を掛けて、元の状態に対応する行列に戻す

また、特異値分解から、次のようにして計算することも可能。



詳しくは、特異値分解の話に書いてあるが、
スカラーにおける因数分解のように、行列においても分解というものが存在する。
要するに、行列の状態の見通しを良くするのであるが、これを使うと擬逆行列も求まる。

とりあえず、この二つの方法で、先程の問題を解決してみる。
まずは、転置行列を使った方法。

# 材料の総量
total <- c(565, 15, 260, 290)

# 連立方程式を解く
solve((t(A)%*%A))%*%t(A)%*%total

ここで、solve()関数というのが逆行列を求める方法であった。
以下がこの計算の結果。

> # 連立方程式を解く
> solve((t(A)%*%A))%*%t(A)%*%total
           [,1]
pancake       4
doughnut     20
spongecake    3

次に、特異値分解を用いた方法。

# 材料の総量
total <- c(565, 15, 260, 290)

# 特異値分解を行う
A.svd <- svd(A)

# 解りやすいように変数を入れなおす。
D <- diag(A.svd$d)
V <- A.svd$v
U <- A.svd$u

# 連立方程式を解く
V %*% solve(D)%*%t(U)%*%total

そして、この結果。

> # 連立方程式を解く
> V %*% solve(D)%*%t(U)%*%total
     [,1]
[1,]    4
[2,]   20
[3,]    3

そうそう。逆行列の関数ginv()関数も存在していた。一応、それも比較。

# ライブラリを読み込む
library(MASS)

# 連立方程式を解く
ginv(A)%*%total

そして、この結果を以下に。

> # 連立方程式を解く
> ginv(A)%*%total
     [,1]
[1,]    4
[2,]   20
[3,]    3

以上の結果から、いずれの方法も同じ結果を導いていることが確認できる。
結論としては、ホットケーキ4枚と、ドーナツ20個カステラ3個を作ることができる。

ところで、今回の場合は、きちんと計算することができたが、
かならず、キレイな計算結果が出てくるとは限らない
つまり、そもそも、連立方程式が解けない場合が考えられる。

実は、そのような時でも、擬逆行列を使うと近似的に最適な答えを見つけてくれる。
最適な答えというのは、要するに、誤差の二乗が最も小さくなるような答えである。
この性質から、一連方法は、「最小二乗法」ととも呼ばれる。

このことは、後に中級編で解説する「重回帰分析」とも密接な関わりがある。

2012/09/09

文系のための「主成分分析の可視化」(2)

主成分分析の解釈の仕方が理解できたところで、
いよいよ、一般的な主成分分析の可視化方法である「バイプロット」を実行してみる。

今回の話は、ソフトウェアが既定で設定している値を鵜呑みにしてはいけない例
数理的な背景を理解していれば、簡単に理解できることである。

文系だから深く知る必要は無い。使えれば良い」などと言う人がいる。
学生であっても、時には研究者もそのようなこと言う。最低限の知識は必要
何度も主張しているが、私は、数学が苦手な文系研究者である。

さて、「最低限の知識」との線引きは確かに困難であるが、
少なくとも、間違った解釈をしないための知識は必要であろう。
特異値分解は、必要最低限の知識に加えても良いと思う。

特異値分解を概念的に理解しておけば、逆行列主成分分析の理解も楽である。

一般的な教科書では、主成分分析を固有ベクトル固有値から説明するが、
文系人間には、理解しにくく、何より、実際の計算では特異値分解を使っているので、
やはり、特異値分解から説明した方が良いであろう。

話が逸れたが、さっそく、バイプロットを使って、主成分分析の結果を可視化する。
本来ならば、分析前に散布図行列が必要であるが今回は省略。
データの詳細は、散布図行列の話にあるので、そちらを参照する。

library(RCurl)

# Google Spreadsheet からデータをダウンロードする
data <- getURL("https://docs.google.com/spreadsheet/pub?key=0AtOtIs5BjRVhdHo0c0pjb29OTU9aV3BmQUFJUWJQa0E&single=true&gid=0&range=A1%3AK48&output=csv", ssl.verifypeer = FALSE)

# ダウンロードしたデータを読み込む
X <- as.matrix(read.table(textConnection(data), header=TRUE, row.names=1, sep=","))

まずは、prcomp()関数 を用いて、バイプロットを作成する。
今回は、標準化を掛けない方法と、掛けたものを比較する。
それぞれ、分散共分散行列相関係数行列に対応するのだった。

# 並べて描くためのオマジナイ
par(mfrow=c(1,2))

# 標準化を行わない場合
biplot(prcomp(X), main="PCA without scaling")

# 標準化を行う場合
biplot(prcomp(X, scale=TRUE), main="PCA with scaling")

このように、二つの図を重ね合わせることで、より解釈がしやすくなる。

なお、バイプロットにおける二つの図の軸スケールは関係せず
変数間の主成分負荷量を表す矢印線の向きおよび長さの違いと、
その方向に布置されている各対象の布置されている状況のみが重要である。

さて、Rにおけるバイプロットは、biplot()関数を使う。
基本的には、この方法でプロットすることが可能であるが、
既定の状態では、いくつか問題がある

そもそも、バイプロットによって重ね合わされた二つの図、つまり、
主成分得点主成分負荷量根本的に異なる空間に存在している。
それを、半ば「強引に」重ね合わしている。

それ故に、重ねあわせ方についてはいくつかの主張が存在する。
その主張とは、すなわち、特異値の掛ける比率であり、
この比率は、二つの図を重ねあわせる際の回転に影響する。

タイプ得点負荷
Type 1U✕DV✕D
Type 2UV✕D
Type 3U✕√DV✕√D
Type 4U✕DV
Type 5√n✕UV÷√n

ここでは、便宜上、5つの形式に分けた。
biplot()関数の既定では、Type 2 が採用されており、
PCA()関数では、Type 1 が採用されている。

さて、ここで、Type 5 を除く、Type 1 〜 Type 4 の主張は、
特異値分解と大きく関わりがある。



この式は、偏差行列に対する特異値分解である。

ここで、Type 1は、特異値Σ分だけ余分であるが同じ空間に投影できる。
一方、Type 2 〜 Type 4 までは、特異値分解に合わせた布置となり、
Type 2 と Type 4 を採用した場合、特異値を余分に掛けている分だけ角度は合わない

実際に角度を合わせるのであれば、Type 1 か Type 3 を採用するべきである。
この二つの方法は、変数と対象の配置関係は同じであるが、軸スケールは異なる

さて、このように状況を整理した上で、再び、prcomp()関数について整理してみる。
実は、R の biplot()関数では、Vに乗じるDの割合を指定することができ
それは、「0〜1」の連続的な数値で設定することができる。

つまり、特異値分解を以下のように書き換えた状況で考えている。



この調整分を行うパラメータは、 scale であり、既定では「1」となっている。
つまり、Uに対してはDを掛けずに、VのみにDを掛けている状態(Type 2)となる。
そして、この値を「0.5」とすると、Type 3 の方式となる


# 並べて描くためのオマジナイ
par(mfrow=c(1,2))

# 標準化を行わない場合
biplot(prcomp(X), main="PCA without scaling", scale=0.5)

# 標準化を行う場合
biplot(prcomp(X, scale=TRUE), main="PCA with scaling", scale=0.5)


先程の図と見比べると、全体的に右方向に傾いていることが解る。
これは、特に、矢印の長いもので確認すると解かりやすい。

バイプロットは、変数の状況と対象の状況を比較して解釈する上で重要であるが、
微妙な角度の違いによって、間違った解釈を導きかねない
したがって、これらの数理的背景を含めて理解することが重要である。

2012/09/07

文系のための「主成分分析の可視化」(1)

前回までは、主成分分析の仕組みについて整理してきた。
主成分分析というのは、分散共分散行列相関係数行列と深い関係があって、
これらの見通しをより良くするために、ある種の変換を掛けるであった。

重要なことは、変数が多いと変数間の関係が複雑になりすぎるので、
変数間の関係を本質を変えずに取り除き対象間の関係のみに焦点を絞ること。

ところで、主成分分析を2〜3変数のデータに対して用いている例を見かけるが、
実は、少ない変数の場合は、分散共分散行列相関係数行列を見ても混乱しない。

したがって、散布図行列を観察するだけで十分に解釈できる場合が多い。
状況に合わせて、適切な方法を選択することが重要である。
重回帰分析偏相関係数を観察するという方法もある。

さて、少し話が逸れたが、本日は、主成分分析の解釈について整理する。
正確には、主成分得点主成分負荷量可視化し、
それらから適切な解釈を導く方法について整理する。

では、さっそく、前回までに用いたデータを用いて、実際の処理を始める。
今回もGoogle Spreadsheet にデータを置いてあるので、それを利用する。
なお、今回は、散布図行列を作成するステップは省略する。本当は必要。

library(RCurl)

データの詳細は、散布図行列の話にあるので、そちらを参照する。
ライブラリを無事に読み込めたら、次は、以下のコマンドを実行する。

# Google Spreadsheet からデータをダウンロードする
data <- getURL("https://docs.google.com/spreadsheet/pub?key=0AtOtIs5BjRVhdHo0c0pjb29OTU9aV3BmQUFJUWJQa0E&single=true&gid=0&range=A1%3AK48&output=csv")

# ダウンロードしたデータを読み込む
X <- as.matrix(read.table(textConnection(data), header=TRUE, row.names=1, sep=","))

主成分分析の結果を可視化する場合には、
バイプロットと呼ばれる方法を用いるのが一般的であり、
prcomp()関数の結果も、その方法で可視化する。

しかしながら、最初からバイプロットで可視化すると、
初学者の多くは、間違った解釈を行う危険性がある。
そこで、本日は、特異値分解から直接的に分析し、その結果の可視化を行う。

ところで、このチュートリアルで用いているデータは、
分散共分散行列相関係数行列のうち、どちらが適切であったか?

確か、単位が揃っていて、その単位における値の大小にも意味があったので、
分散共分散行列の方が適切であった。前回の話では、そのように解説した。
っということは、つまりは、偏差行列を準備する必要があった。

# 行列の引き算ができるように、平均値を総数個複製する。
M <- matrix(rep(m <- t(colMeans(X)), each=nrow(X)), nrow=nrow(X))

# 元の行列から、偏差行列を作成する。
A <- as.matrix(X-M)

次に、作成された偏差行列に対して特異値分解を行い、
主成分得点と主成分負荷量を計算する。

# 特異値分解を行う
A.svd <- svd(A)

# 主成分スコアと主成分負荷量を計算する
A.svd.score <- A.svd$u %*% diag(A.svd$d)
A.svd.loadings <- A.svd$v %*% diag(A.svd$d)

各主成分の説明力についての情報も欲しい。説明力は何に対応していたか?
確か、主成分得点の行列の分散の割合に相当していた。

# 割合を100分率で表し、さらに、小数点第二位で切り詰める。
A.svd.per <- round(diag((var(A.svd.score)/sum(diag(var(A.svd.score)))))*100,2)

割合なので、小数点以下をダラダラと書いても仕方がない。
小数点第二位〜第三位当たりで切る。この場合は、第二位までで十分。

では、さっそく、「第1主成分」における「主成分負荷量」を可視化してみる。
今は、量の大きさを可視化したいので、棒グラフを用いる。詳しくは、棒グラフの話

# 第一主成分というのは、主成分の第1次元ということ
dim <- 1

# 各変数の分散の割合の大きさを表すだけなので、とりあえず棒グラフで表現
barplot(as.vector(A.svd.loadings[,dim]), names=colnames(X))

# タイトルは必ず必要。タイトル文字を作成する。少々面倒。
pca.loadings.title <- paste("Factors of principal component in dimension", dim, sep="")
pca.loadings.title <- paste(pca.loadings.title , A.svd.per[1],sep="\n")
pca.loadings.title <- paste(pca.loadings.title , "%", sep="")

# タイトルをグラフに与える。
title(main=pca.loadings.title, ylab="variance")

まずは、主成分負荷量の見方から整理する。

この図では、第1主成分における主成分負荷量は、正と負の値を取っている
実は、主成分分析の正と負は計算方法に依存しソフトや関数によって逆転する

したがって、分散の大きさの差と、0を中心に二つの相反する性質を表す
正と負は関係無いので、正負に捕らわれずに判断することが重要。

この図の場合、第1主成分では、国際協力に関する活動医療や健康に関する活動
二つの変数に相当する主成分負荷量が両極にあって、国際協力に近い方から見ていくと、
障害者に関する活動高齢者に関する活動・・・という順番で並んでいる。

医療や健康に関する活動のみ」が反対側に向いていて、
しかも、出ている度合いがかなり小さいのが気になるが...とりあえず、次に進む。

こうした状況を観察してみると、第1主成分における二つの対極というのは、
一方がグローバルな活動を表し、もう一方がローカルな活動を表している「らしく」、
この状況は、元のデータの50.79%を説明していることが解る。

らしく」というのは、この状況だけでは、まだ、なんとも言えない。焦ってはいけない。
主成分得点に関しても同様の図を作成し、
意味については、両方を比較しながら再度検討する。


# 第一主成分というのは、主成分の第1次元ということ
dim <- 1

# 各変数の分散の割合の大きさを表すだけなので、とりあえず棒グラフで表現
barplot(as.vector(A.svd.score[,dim]), names=rownames(X), las=2)

# タイトルは必ず必要。タイトル文字を作成する。少々面倒。
pca.loadings.title <- paste("Scores of principal component in dimension", dim, sep="")
pca.loadings.title <- paste(pca.loadings.title , A.svd.per[dim],sep="\n")
pca.loadings.title <- paste(pca.loadings.title , "%", sep="")

# タイトルをグラフに与える。
title(main=pca.loadings.title, ylab="variance")

第1主成分における主成分得点は、第1主成分における主成分負荷量に対応している。
つまり、この図においては、「0」を中心に下側はグローバルな活動の強さを表し、
一方、上側はローカルな活動の強さを表している。

なお、「0」付近というのは、どちらにも寄らないことを意味するので、
比較的に平均」な対象が集まっている。

そうそう、具体的な数値もあった方が良い。

> A.svd.score[(order(A.svd.score[,1])),][,1]
      Oita       Aichi       Miyagi     Ibaraki    Ishikawa    Kanagawa
-84.3659879 -27.2237009 -17.5878902 -17.4725893 -15.6203251 -15.3652856
       Gifu        Nara   Fukushima     Saitama       Ehime       Hyogo
-14.7809511 -12.8015618 -11.9976794 -11.9089262  -9.1302220  -8.3305146
   Kumamoto       Kochi      Toyama    Tokyo-to       Akita     Niigata
 -7.8976958  -6.4295937  -5.7279074  -4.9173176  -4.1723528  -3.8796902
   Shizuoka     Okinawa       Shiga    Osaka-fu     Fukuoka   Tokushima
 -2.8219903  -1.7026102  -1.2568486  -0.8619497   0.3182618   2.6431475
     Nagano       Gumma    Hokkaido      Iwate        Chiba     Okayama
  2.6834044   2.8809400   3.6513143   4.1912833   4.8209478   5.4525580
     Kagawa     Tochigi   Kagoshima   Hiroshima        Saga        Mie
  6.0702498   9.7733572   9.8101319  13.1450657  13.4666745  13.5595689
  Yamanashi     Tottori    Wakayama    Miyazaki    Kyoto-fu   Yamaguchi
 13.8047619  14.2913455  14.4812483  15.6424106  15.8493474  15.8798751
   Nagasaki     Aomori      Shimane    Yamagata       Fukui
 18.3468538  19.7863922  21.2399576  21.3140915  23.1504013

まず、グローバルな活動の強さを見ると、大分県が圧倒的に強く現れており、
次いで、愛知県、宮城県、茨城県、石川県、神奈川県・・・と続く。

一方、ローカルな活動の強さを見ると、福井県が最も値が大きく、
山形県、島根県、青森県、長崎県、山口県・・・と続く。

全体的な印象として、グローバルな活動は、比較的人口が集中している地域が多く、
ローカルな活動は、過疎化などが問題になっている地域が多いように思える。

ここで、気になるのは、グローバルな活動が大分県で高いこと。
このように「なんで?」という疑問は良く生じる

そういった時に、元データを参照すると新しいことが見えてくる
常に、元データと分析結果を交互に行き来することが重要

> X
            HM  ELD   HC  CHR   SC   LI   SP  ENV  DIS    IC
Hokkaido  11.3 35.1 34.1 21.2 44.3 14.4 15.5 24.1  5.4  17.9
Aomori    15.2 21.0 22.4 13.3 55.2  7.9  8.4 19.9  8.3   8.0
Iwate      6.0 26.1 12.5 15.9 33.1 10.6 15.6 16.9 11.8  26.9
Miyagi    22.8 40.6 32.8 20.7 43.4 13.4 14.3 22.6 15.2  40.4
Akita      4.9 19.5 25.1 16.1 41.2  7.4  9.8 12.8 10.4  33.2
Yamagata   7.4 26.5 13.4 15.8 33.3  9.5 11.4 13.0  5.9   8.7
Fukushima 14.8 30.5 16.2 15.9 40.9 10.5 16.4 29.6 15.2  41.8
Ibaraki    7.9 29.6 38.6 21.4 63.1  9.5 29.6 26.9 10.2  38.5
Tochigi   16.2 36.2 24.3 20.4 51.2 12.1 14.5 24.9  4.7  14.5
Gumma     14.6 32.4 23.1 18.8 41.9  8.7 16.8 26.5  5.9  23.3
Saitama   10.3 36.3 21.8 18.3 34.5 15.0 24.7 28.9  8.5  38.3
Chiba     10.9 29.4 33.1 20.6 42.2 15.5 24.7 22.6  7.1  17.6
Tokyo-to  11.4 41.9 36.8 24.5 37.9 26.1 18.6 48.1  6.6  23.8
Kanagawa  11.9 31.4 26.0 24.6 44.7 16.0 23.7 42.2  5.4  40.7
Niigata   10.3 35.6 36.8 19.0 49.6  8.4 20.6 23.6  5.2  24.8
Toyama    16.8 25.1 28.3 15.6 37.8 11.5 16.5 19.2  9.0  32.7
Ishikawa   6.9 41.7 13.4 25.3 35.0 10.4 23.3 20.3  9.1  43.9
Fukui      7.5 29.3 12.1 17.4 44.2 10.2 15.1 19.6  4.4   5.8
Yamanashi 12.8 27.4 18.2 17.1 39.2  8.7 12.0 25.4  5.4  14.6
Nagano    12.4 24.9 31.8 16.6 29.9  9.3 14.1 18.5  4.9  22.9
Gifu      18.5 29.9 20.7 16.4 44.6  8.2 18.7 26.3  5.2  43.8
Shizuoka  10.6 32.7 18.5 17.8 50.8 11.1 12.8 21.1  5.4  30.9
Aichi      9.0 42.6 21.1 20.2 36.0 11.5 22.1 20.7  5.2  54.2
Mie       23.6 26.8 14.2 17.6 45.4 12.1 15.8 22.6  4.6  16.3
Shiga      9.5 28.0 15.8 22.3 40.9 10.1 13.3 20.7  4.6  31.1
Kyoto-fu  17.6 32.7 22.3 30.3 38.2 18.0 22.4 34.5  5.8   8.3
Osaka-fu  11.9 28.8 41.4 22.2 36.3 13.6 17.5 38.9  7.4  21.2
Hyogo      7.0 40.0 39.8 26.4 42.2 15.6 16.1 23.3  7.8  27.4
Nara      16.3 34.0 36.7 24.9 39.9 11.1 17.2 23.6  7.6  35.0
Wakayama   8.2 38.2 25.1 16.7 39.6 13.2 10.8 33.7  8.2   8.9
Tottori   12.6 31.6 18.3 15.9 41.9  9.2 12.7 23.7  5.1  13.2
Shimane   17.4 28.1 12.3 18.6 31.9  9.9 20.9 20.5  6.6   8.3
Okayama   17.9 39.6 26.9 23.0 32.7 11.9 12.7 27.5  4.6  18.2
Hiroshima 10.0 33.8 25.2 23.1 36.2 12.5 20.7 24.9  4.2  10.8
Yamaguchi 14.2 26.2 31.4 19.7 32.9 11.2 17.5 24.0  5.5   7.9
Tokushima 19.3 26.0 29.8 15.7 46.5  9.7 12.0 17.5  6.9  23.2
Kagawa    18.2 30.8 21.7 20.1 54.5 11.1 12.6 20.7  8.4  20.5
Ehime      9.0 44.3 26.2 18.7 37.5  8.0 13.4 22.5  7.3  33.1
Kochi     19.1 38.3 27.6 19.7 43.0 14.6 11.9 34.7  5.4  30.7
Fukuoka    9.6 29.7 30.5 27.9 44.0 14.4 18.6 24.0 13.3  22.8
Saga      18.9 31.5 27.8 20.7 52.2 10.2 20.0 17.4  5.2  10.2
Nagasaki  26.7 33.4 25.0 18.8 55.1 11.7 10.7 26.9  4.3   6.1
Kumamoto  21.5 38.1 56.9 17.3 30.4 12.5 13.2 20.0  4.2  23.5
Oita      13.4 44.5 58.9 23.8 47.7 12.8 14.5 21.2  6.7 102.6
Miyazaki  13.6 23.8 26.0 20.1 38.7 13.7 21.9 33.0  6.9   9.6
Kagoshima 21.2 26.6 22.2 14.1 40.3 11.1 10.7 18.7  4.7  18.4
Okinawa   21.7 39.9 26.4 22.4 46.6 22.4 20.7 46.0 10.6  24.3

なるほど、確かに、大分県では国際協力に関わるボランティア活動の割合が、
他の都道府県と比較して、群を抜いて高い。では、福井県はどうであるか?

うん?今度は、あまり、何かの値が突出しているようには見えない
ついでに、データのサマリと箱ヒゲ図も確認。
> boxplot(X, main="Average Days for Participation in Volunteer Activities", ylab="Average days in a year")

> summary(X)
       HM             ELD              HC             CHR    
 Min.   : 4.90   Min.   :19.50   Min.   :12.10   Min.   :13.30
 1st Qu.: 9.80   1st Qu.:27.70   1st Qu.:20.90   1st Qu.:16.90
 Median :12.80   Median :31.50   Median :25.20   Median :19.70
 Mean   :13.80   Mean   :32.35   Mean   :26.59   Mean   :19.85
 3rd Qu.:17.75   3rd Qu.:37.20   3rd Qu.:31.60   3rd Qu.:22.25
 Max.   :26.70   Max.   :44.50   Max.   :58.90   Max.   :30.30
       SC              LI              SP             ENV    
 Min.   :29.90   Min.   : 7.40   Min.   : 8.40   Min.   :12.80
 1st Qu.:36.90   1st Qu.: 9.80   1st Qu.:12.75   1st Qu.:20.40
 Median :41.20   Median :11.20   Median :15.80   Median :23.60
 Mean   :41.89   Mean   :12.05   Mean   :16.53   Mean   :24.98
 3rd Qu.:45.05   3rd Qu.:13.50   3rd Qu.:20.30   3rd Qu.:26.90
 Max.   :63.10   Max.   :26.10   Max.   :29.60   Max.   :48.10
      DIS               IC      
 Min.   : 4.200   Min.   :  5.80
 1st Qu.: 5.200   1st Qu.: 13.85
 Median : 5.900   Median : 23.20
 Mean   : 7.028   Mean   : 25.08
 3rd Qu.: 8.250   3rd Qu.: 32.90
 Max.   :15.200   Max.   :102.60

さて、当初はローカルな活動の強さを表していたのかと思ったが、
福井県のデータは、全体的に各値が低く、特に、国際協力に関する活動は著しく低い

この傾向は、福井県の次の山形県にも現れている。

したがって、ローカルというよりは「反」グローバル的とするか、
ボランティアに活動に対する総合的な取り組み度合いと見ても良かもしれない。

今度は、第2主成分に関しても同じことをしてみる。
今回は、二つの図を並べて同時に出力する。


#並べて描くためのオマジナイ。
par(mfrow=c(1,2))

# 今度は次元が2になる。
dim <- 2

# 一つ目の図には、主成分負荷量の図
# 各変数の分散の割合の大きさを表すだけなので、とりあえず棒グラフで表現
barplot(as.vector(A.svd.loadings[,dim]), names=colnames(X))

# タイトルは必ず必要。タイトル文字を作成する。少々面倒。
pca.loadings.title <- paste("Factors of principal component in dimension", dim, sep=" ")
pca.loadings.title <- paste(pca.loadings.title , A.svd.per[dim],sep="\n")
pca.loadings.title <- paste(pca.loadings.title , "%", sep="")

# タイトルをグラフに与える。
title(main=pca.loadings.title, ylab="variance")

# 次は、主成分得点の可視化
# 各変数の分散の割合の大きさを表すだけなので、とりあえず棒グラフで表現
barplot(as.vector(A.svd.score[,dim]), names=rownames(X), las=2)

# タイトルは必ず必要。タイトル文字を作成する。少々面倒。
pca.loadings.title <- paste("Scores of principal component in dimension", dim, sep=" ")
pca.loadings.title <- paste(pca.loadings.title , A.svd.per[dim],sep="\n")
pca.loadings.title <- paste(pca.loadings.title , "%", sep="")

# タイトルをグラフに与える。
title(main=pca.loadings.title, ylab="variance")

実際の値も表示する。これは、結果のみ。

> A.svd.score[(order(A.svd.score[,2])),][,2]
    Tokyo-to     Kumamoto     Osaka-fu      Okinawa     Kyoto-fu        Hyogo 
-25.48330834 -19.54068817 -17.89270947 -17.53265633 -11.60217588 -10.09716695 
    Wakayama     Hokkaido     Nagasaki     Miyazaki        Kochi      Niigata 
 -7.99181874  -7.95731799  -7.78153288  -7.29715992  -6.45035170  -6.32440501 
       Chiba     Kanagawa    Yamaguchi      Okayama      Ibaraki         Nara 
 -6.11855778  -6.08651180  -6.01139834  -5.64678869  -5.49745999  -4.43666871 
   Hiroshima      Fukuoka      Tochigi         Saga       Miyagi        Oita  
 -4.06168230  -3.71780644  -3.37521039  -2.60332055  -1.57447800   0.03078564 
       Gumma       Nagano    Tokushima        Ehime       Kagawa      Saitama 
  1.82577203   3.22769906   3.37501834   3.66652229   3.79919709   3.97604392 
     Tottori      Aomori     Yamanashi    Kagoshima       Toyama         Mie  
  4.70810331   5.05798505   5.39623139   6.31970748   6.62959774   6.96469789 
     Shimane        Fukui         Gifu     Shizuoka    Fukushima       Aichi  
  8.14448030   9.14451299   9.99399234  10.06750081  11.39446940  12.86385463 
       Shiga     Yamagata     Ishikawa        Akita       Iwate  
 13.29618683  14.73308634  15.04994751  16.76995612  18.64582591 

第2主成分は、元情報の16.38%の情報を持っている。
主成分負荷量を見ると、障害者に関する活動国際協力に関する活動が対立している。
全体的に見てみると、恒常的な状況特殊な状況に分かれているように見える。

一方、主成分得点を見てみると、下側に最も値が高いのが東京都で、
熊本県、大阪府、沖縄県、京都府・・・と続く。
逆に、上側に最も値が高いのは、岩手県で、秋田県、石川県、山形県・・・と続く。

それぞれの上位を見てみると、下側には西日本が多く含まれていて、
上側には東日本が多く含まれているようにも見える。
文化の違いだろうか?それとも、人口密度の問題だろうか?

研究として踏み込むのであれば、より詳細な検討を必要とする
元データがどのようにして得られたのか、あるいは、外国人の居住人口の割合、
高齢者や障害者の人口比率、犯罪件数、環境汚染といった他の情報も必要とする。
少なくとも、今回のデータでは、これ以上の解釈はできない。

これは、主成分分析に限ったことでは無いが、データの背景を知ることは極めて重要
また、ある分析から導かれるのが解釈ではなく、新しい疑問であることも多い。

分析結果を安易に鵜呑みにしたり、
強引に分析結果を結びつけることも厳禁!
こういった状況を目にすることは多い。

さて、話が逸れたが、主成分分析の結果を可視化するために、
棒グラフを用いて説明してきたが、これは、各主成分を1次元ごとに観察するため。
次は、二つの次元を同時に可視化する方法を行うが1次元毎に解釈するのは同じ

では、第1主成分第2主成分主成分負荷量を同時に表現してみる。
# 第1主成分と第2主成分の次元を設定する
dim1 <- 1
dim2 <- 2

# 第1主成分と第2主成分の主成分負荷量をベクトルに入れる
x <- A.svd.loadings[,dim1]
y <- A.svd.loadings[,dim2]

# x軸の軸ラベル
label_x <- ""
label_x <- paste("Dim.", dim1)
label_x <- paste(label_x, "(")
label_x <- paste(label_x, A.svd.per[dim1], sep="")
label_x <- paste(label_x, "%)")

# y軸の軸ラベル
label_y <- ""
label_y <- paste("Dim.", dim2)
label_y <- paste(label_y, "(")
label_y <- paste(label_y, A.svd.per[dim2], sep="")
label_y <- paste(label_y, "%)")

# まずは、プロット領域を作成し、ラベルを配置する
plot(x, y, xlab=label_x, ylab=label_y, type="n", main="Loadings of principal component")
text(x, y, colnames(X), cex=0.8)

# 原点0からの方向を矢印で表現する
arrows(x0=0, y0=0, x1=x, y1=y, length=0.1, col="red")

# 最後に、原点軸を入れて整形する
abline(h=0, v=0, lty=2, col="lightgrey")

主成分負荷量の見方は、棒グラフで見た方法と同じ。要するに、一次元で観察する
主成分負荷量というのは、あくまで、各次元における主成分の方向の強さなので、
幾何的なベクトルとして考えて矢印で表現する。

今度は、主成分得点の図も出してみる。
# 第1主成分と第2主成分の次元を設定する
dim1 <- 1
dim2 <- 2

# 第1主成分と第2主成分の主成分負荷量をベクトルに入れる
x <- A.svd.loadings[,dim1]
y <- A.svd.loadings[,dim2]

# x軸の軸ラベル
label_x <- ""
label_x <- paste("Dim.", dim1)
label_x <- paste(label_x, "(")
label_x <- paste(label_x, A.svd.per[dim1], sep="")
label_x <- paste(label_x, "%)")

# y軸の軸ラベル
label_y <- ""
label_y <- paste("Dim.", dim2)
label_y <- paste(label_y, "(")
label_y <- paste(label_y, A.svd.per[dim2], sep="")
label_y <- paste(label_y, "%)")

# まずは、プロット領域を作成し、ラベルを配置する
plot(x, y, xlab=label_x, ylab=label_y, type="n", main="Loadings of principal component")
text(x, y, colnames(X), cex=0.8)

# 原点0からの方向を矢印で表現する
arrows(x0=0, y0=0, x1=x, y1=y, length=0.1, col="red")

# 最後に、原点軸を入れて整形する
abline(h=0, v=0, lty=2, col="lightgrey")

# 第1主成分と第2主成分の主成分負荷量をベクトルに入れる
x <- A.svd.score[,dim1]
y <- A.svd.score[,dim2]

# x軸の軸ラベル
label_x <- ""
label_x <- paste("Dim.", dim1)
label_x <- paste(label_x, "(")
label_x <- paste(label_x, A.svd.per[dim1], sep="")
label_x <- paste(label_x, "%)")

# y軸の軸ラベル
label_y <- ""
label_y <- paste("Dim.", dim2)
label_y <- paste(label_y, "(")
label_y <- paste(label_y, A.svd.per[dim2], sep="")
label_y <- paste(label_y, "%)")
# まずは、プロット領域を作成し、ラベルを配置する
plot(x, y, xlab=label_x, ylab=label_y, type="n", main="Scores of principal component")
text(x+1, y+1, rownames(X), cex=0.8)

# 原点0からの方向を矢印で表現する
points(x, y, pch=16, col="blue")

# 最後に、原点軸を入れて整形する
abline(h=0, v=0, lty=2, col="lightgrey")

主成分得点は、散布図の「ように」可視化する。あくまで「ように」。
重要なことは、主成分負荷量と同様に、各次元ごとに1次元で解釈すること。

さて、ここでは第1主成分第2主成分における主成分得点同時に布置している。
したがって、比較的近い所に布置されている物同士は、
この二つの主成分のみにおいて似た性質を持っていると言える。

また、「0」付近に布置されるもの(今回は存在しない)は、
可視化された二つの軸において、平均「的」な性質を持っていることを意味する。

さて、最後に、相関係数行列に対応した場合でのプロットも作成してみる。
今回の場合、分散共産分散行列に対応した方法が良いのであるが練習だけ。
# 特異値分解を行う
A.svd <- svd(scale(X))

# 主成分スコアと主成分負荷量を計算する
A.svd.score <- A.svd$u %*% diag(A.svd$d)
A.svd.loadings <- (A.svd$v %*% diag(A.svd$d))/sqrt(nrow(X)-1)

# 二つのプロットを並べて描くためのオマジナイ
par(mfrow=c(1,2))

# 第1主成分と第2主成分の次元を設定する
dim1 <- 1
dim2 <- 2

# x軸の軸ラベル
label_x <- ""
label_x <- paste("Dim.", dim1)
label_x <- paste(label_x, "(")
label_x <- paste(label_x, A.svd.per[dim1], sep="")
label_x <- paste(label_x, "%)")

# y軸の軸ラベル
label_y <- ""
label_y <- paste("Dim.", dim2)
label_y <- paste(label_y, "(")
label_y <- paste(label_y, A.svd.per[dim2], sep="")
label_y <- paste(label_y, "%)")

# 主成分負荷量のプロット
# 第1主成分と第2主成分の主成分負荷量をベクトルに入れる
x <- A.svd.loadings[,dim1]
y <- A.svd.loadings[,dim2]

# まずは、プロット領域を作成し、ラベルを配置する
plot(x, y, xlab=label_x, ylab=label_y, type="n", main="Loadings of principal component", xlim=c(-1,1),ylim=c(-1,1),asp=1)
text(x, y, colnames(X), cex=0.8)

# 中心に円を描く
x.circle <- seq(-1, 1, by = 0.01)
y.circle <- sqrt(1 - x.circle^2)
lines(x.circle, y = y.circle)
lines(x.circle, y = -y.circle)

# 原点0からの方向を矢印で表現する
arrows(x0=0, y0=0, x1=x, y1=y, length=0.1, col="red")

# 最後に、原点軸を入れて整形する
abline(h=0, v=0, lty=2, col="lightgrey")

# 主成分得点のプロット
# 第1主成分と第2主成分の主成分負荷量をベクトルに入れる
x <- A.svd.score[,dim1]
y <- A.svd.score[,dim2]

# まずは、プロット領域を作成し、ラベルを配置する
plot(x, y, xlab=label_x, ylab=label_y, type="n", main="Scores of principal component")
text(x+0.1, y+0.1, rownames(X), cex=0.8)

# 原点0からの方向を矢印で表現する
points(x, y, pch=16, col="blue")

# 最後に、原点軸を入れて整形する
abline(h=0, v=0, lty=2, col="lightgrey")

相関係数行列に対応する主成分分析を行う場合、
主成分負荷量は、sqrt(n-1) で基準化する必要がある。

そして、これを可視化する場合には、分散が1であることを示すために半径1の円を描く。
別の言い方をすると、主成分負荷量のプロットの中心に円が描かれている場合には、
その分析結果が相関係数行列に対応していることが解るのである。

さて、今回は第1主成分第2主成分のみの可視化を行った。
これは、元のデータの67.17%を再現している。
これが十分であるかは、もう少し議論がある。

基本的には、この値が高いほど元のデータに近づくのであるが、
必ずしも、値が高ければ良いとも言えない。

というのは、第1主成分に特定の変数の値が強く反映され、
他の状況が上手く読み取れない場合が存在する
そのような場合、第1主成分を除いて、第2主成分以下で分析することがある

また、ある特殊な状況においては、第1主成分第2主成分主成分得点のプロットが、
「U」の字に布置されることがあって(馬蹄形問題、そのような場合には、
第1主成分と第3主成分で観察し直す必要がある。この話はいずれ。

今回は、主成分負荷量主成分得点を可視化する方法を実践し、
さらに、その結果を横に並べて表示した。
実は、この二つの図を重ね合わせる可視化方法があって、
その方法のことをバイプロットと呼ぶ。

次回は、そのバイプロットについて整理する。