ラベル 偏相関行列 の投稿を表示しています。 すべての投稿を表示
ラベル 偏相関行列 の投稿を表示しています。 すべての投稿を表示

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/09/26

文系のための「多次元データの要約」(2)

分散共分散行列相関係数行列を用いることで、様々な定量的手法が可能となる。
実際の手法については「中級レベル」で解説するとして、要するに、
これら行列の意味を理解することは極めて重要である。

そもそも、この二つの行列は、どのようなものであったか?

たしか、分散共分散行列は、各変数の分散が対角成分に並び、
それ以外の成分には「共分散が入っているような「対称行列」であった。

一方、相関係数行列は、対角成分に「1」が並び、
それ以外の部分には「相関係数が入っているような行列であった。
相関係数行列は、変数間の関係を一目で確認できるので、色々と重宝するのだった。

ふむふむ。そのような話を確かにした。何か「問題」でもあるのか?

実は、2変数の相関係数の話では気づかなかったのであるが、
多変数の相関係数行列にしてみると、ある種の疑惑が生まれる。

本当に、二つの変数の関係「のみ」を表しているのか?
実は、他の変数の影響を受けているのではないか?
という疑惑である。

例えば、3つの変数、「」、「」、「」の3つの変数が存在した場合、
この3つの変数の相関係数行列は以下のようになるはず。



ふむ。何も不審な点は見当たらないように見えるが、
ひょっとすると、「」と「」の関係の中には、
」の影響が「潜在的」に存在するかもしれない。

2変数の間の相関係数の話では、意識する必要は無いが、
たしかに、多変数となる相関係数行列では、そういった懸念が生じる。
では、そのような別の変数の影響を取り除くにはどうすれば良いか?

この問題が、本日のメインテーマ。

とりあえず、いつものように、いつもの如く、チュートリアルデータを準備する。
今回のデータは、総務省統計局のデータ(e-stat)のデータを用いて、
チュートリアル用の「擬似」データを作成したもの。
今回のデータは、居住世帯の有無一ヶ月辺りの平均家賃の関係を見るためのデータ。
家賃のデータは、19階級に区分し家賃を集計したものであったので、
各階級の平均を一ヶ月の家賃とし、世帯数を掛けたもので都道府県別の平均家賃を算出。

かなり「大雑把な加工」をしているので、正式な分析には用いてはならない
あくまで、手法を学ぶための「擬似データ」であるので、
ここから実際の解釈を導いても、「深い意味」はない。

一応、注意事項を整理したところで、いつもどおりにデータを読み込む。

# Windows と Linux の人は次のコマンド
X <- read.table("clipboard", sep=",", header=TRUE)

# Mac の人は次のコマンド
X <- read.table(pipe("pbpaste") , sep=",", header=TRUE)

今回のチュートリアルのために用意したデータは以下の通り。

OCU,UNO,PRI
Hokkaido,2340300,390100,40687
Aomori-ken,493500,87400,111566
Iwate-ken,470700,78800,17002
Miyagi-ken,869700,144200,16084
Akita-ken,380300,57100,41254
Yamagata-ken,383000,49700,10523
Fukushima-ken,699700,108600,11879
Ibaraki-ken,1036200,187600,25207
Tochigi-ken,708700,131300,36003
Gumma-ken,725300,130400,27494
Saitama-ken,2688000,341100,22045
Chiba-ken,2344500,373100,94198
Tokyo-to,5939900,840500,60863
Kanagawa-ken,3612200,455600,246996
Niigata-ken,810700,119000,113336
Toyama-ken,368800,55500,24592
Ishikawa-ken,421600,76400,10485
Fukui-ken,259700,49000,15203
Yamanashi-ken,314600,83600,6005
Nagano-ken,758300,188000,10698
Gifu-ken,712600,123100,25608
Shizuoka-ken,1359400,238500,22521
Aichi-ken,2764400,368400,54336
Mie-ken,680900,110100,122595
Shiga-ken,491300,76300,17786
Kyoto-fu,1086800,183400,14849
Osaka-fu,3685100,660900,39764
Hyogo-ken,2169400,351300,150179
Nara-ken,502500,90100,68843
Wakayama-ken,382100,85700,12267
Tottori-ken,208600,38600,10868
Shimane-ken,249900,45900,6686
Okayama-ken,734700,131900,7459
Hiroshima-ken,1147600,208700,27600
Yamaguchi-ken,584100,107600,48448
Tokushima-ken,297000,58600,21579
Kagawa-ken,372700,73700,10305
Ehime-ken,574000,107100,12877
Kochi-ken,312800,64900,22953
Fukuoka-ken,2034000,340800,11205
Saga-ken,286100,36800,103313
Nagasaki-ken,539200,91900,9725
Kumamoto-ken,663800,105700,20633
Oita-ken,467200,79300,29546
Miyazaki-ken,443800,65900,22566
Kagoshima-ken,718200,133100,17694
Okinawa-ken,504400,62100,29919

このデータにおいて、
  • OCU居住世帯
  • UNO非居住世帯
  • PRI一ヶ月の平均家賃
まずは、分散共分散行列相関係数行列を出してみる。

cov(X)    # 分散共分散行列
cor(X)    # 相関係数行列

以下が、その結果。

> cov(X)    # 分散共分散行列
             OCU          UNO         PRI
OCU 1.297147e+12 185407240994 21146986138
UNO 1.854072e+11  27363809917  2614407571
PRI 2.114699e+10   2614407571  2151559501

> cor(X)    # 相関係数行列
          OCU       UNO       PRI
OCU 1.0000000 0.9841103 0.4002922
UNO 0.9841103 1.0000000 0.3407284
PRI 0.4002922 0.3407284 1.0000000

さて、相関係数行列を見てみると、
居住世帯数OCU)と非居住世帯数UNO)の相関が非常に高く
平均家賃PRI)と他の変数の関係は強く無さそうに見える。

相関の有無は、ひとまずは置いておいて、
平均家賃に注目してやると、居住世帯数が多いと賃料が高く
同様に、非居住世帯数が多くて「も」平均賃料が高くなる傾向がある。

うん?非居住世帯が多くなるほど、月の平均賃料が高くなるというのは、
直感的に合わないような気がする。
居住・非居住の世帯数の関係が影響しているかも。

問題は、2変数間の関係に、別の変数の影響が存在している可能性があること。
では、この「潜在的」な影響は、どのようにしたら見えてくるのか?

ここで、相関係数とは別の方法で2変数の関係を考えてみる。
別の方法とは、すなわち、単回帰と呼ばれる方法である。
何のことか解らない人は、もう一度、やり直し

たしか、単回帰は、2つの変数の関係について、
一方の変数で、もう一方の変数を「説明」するという考え方だった。
この方法を用いることで、他の変数の潜在的な影響を知ることができるかもしれない。

OCUで「説明できない部分」のPRIの値と、
OCUで「説明できない部分」のUNOの値との、
関係を比較」すれば良いのではないか?とにかくやってみる。

手を動かした方が解りやすいので、まずは、普通に回帰分析を行なってみる。
Rでは、単回帰を行うためのlm()関数があるので、今回は、この関数を使ってみる。

# 平均家賃を固定し、単回帰を行う
X.lm.3_1 <- lm(X[,3]~X[,1])    # PRIをOCUで説明する
X.lm.2_1 <- lm(X[,2]~X[,1])    # UNOをOCUで説明する

本当は、PRIとUNOを比較したいが、OCUの影響が気になる。
したがって、PRIUNOをそれぞれ「y軸」に固定し、OCUからの説明を考える。
# グラフを並べて描くためのオマジナイ
par(mfrow=c(1,2))

# PRIをy軸とし、OCUをx軸とした散布図
plot(X[,1], X[,3], xlab="OCU", ylab="PRI", ylim=c(0, max(X[,3])))

# 回帰直線を重ねて描く
par(new=TRUE)
plot(X[,1], X.lm.3_1$fitted.value, type="l", ylim=c(0, max(X[,3])), xaxt="n", yaxt="n", xlab="", ylab="")

# UNOをy軸とし、OCUをx軸とした散布図
plot(X[,1], X[,2], xlab="OCU", ylab="UNO", ylim=c(0, max(X[,2])))

# 回帰直線を重ねて描く
par(new=TRUE)
plot(X[,1], X.lm.2_1$fitted.value, type="l", ylim=c(0, max(X[,2])), xaxt="n", yaxt="n", xlab="", ylab="")

次に、各々の「残差の状況」を確認してみる。
# グラフを並べて描くためのオマジナイ
par(mfrow=c(1,2))

# PRIとOCUの残差の検討(標準化残差)
plot(X[,1], scale(X.lm.3_1$residuals), ylim=c(-4,4), xlab="OCU", ylab="PRI")
abline(h=0)
abline(h=c(-2,2), lty=2, col="grey")

# UNOとOCUの残差の検討(標準化残差)
plot(X[,1], scale(X.lm.2_1$residuals), ylim=c(-4,4), xlab="OCU", ylab="UNO")
abline(h=0)
abline(h=c(-2,2), lty=2, col="grey")

この図では、残差の状況を見やすくするために残差を標準化している。
これは「標準化残差」と呼ばれる。「±2」の線は、おおよその「外れ値」の基準線。
詳しい話は、正規分布の話で述べる。

さてさて、たしか、理屈上は、説明できない部分が「残差」と呼ばれるものだった。
つまり、OCUの影響を取り除くには、「残差同士の相関」を見れば良い。

# 残差同士の相関係数
cor(X.lm.3_1$residuals,X.lm.2_1$residuals)

以下は実行結果。

> # 残差同士の相関係数
> cor(X.lm.3_1$residuals,X.lm.2_1$residuals)
[1] -0.3269775

なるほど。OCUの影響を抜いた状況相関係数を見てみると、
月の平均賃料非居住世帯数の関係は、「負の関係」となった。
つまり、非世帯数が増加するほど、平均賃料は低くなる傾向がある。

この結果は、影響を抜かない相関係数よりも直感に即しているように思える。
すなわち、人が住んでいない住宅が多いということは、
需要に対する過剰供給が背後に存在し得るので賃料が低くなる

試しに、残差同士の関係を散布図で可視化すると以下のようになる。
# とりあえず、変数を定義し直す
pri.res <- X.lm.3_1$residuals
uno.res <- X.lm.2_1$residuals

# 残差同士の単回帰(偏回帰)
res.lm <- lm(uno.res ~ pri.res)

# 残差同士の関係を散布図で表す
plot(pri.res, uno.res, ylim=c(min(uno.res),max(uno.res)), xlab="", ylab="")

# 一応、回帰直線も追加
par(new=TRUE)
plot(pri.res, res.lm$fitted.value, type="l", xlab="", ylab="",  xaxt="n", yaxt="n",  ylim=c(min(uno.res),max(uno.res)), col="red")

# 最後に図を整える
pcor <-  round(cor(pri.res, uno.res),3)
plm <- round(res.lm$coefficient[2],3)
leg1 <- paste("Partial Correlation", pcor, sep=": ")
leg2 <- paste("Partial Regression Coefficient", plm, sep=": ")
legend("topright", legend=c(leg1, leg2))

title(xlab="Residuals for building rental price", ylab="Residuals for unoccupied buildings")
abline(h=0, v=0)

さて、このように、ある2つの変数の関係を観察するために、
別の変数の影響を取り除いた相関係数のことを、
偏相関係数(Partial Correlation)」と呼ぶ。

また、ここでは、残差同士の単回帰を行い、その回帰直線も描いているが、
残差同士の単回帰の係数のことを「偏回帰係数(Partial Regression Coefficients)」と呼ぶ。
ちなみに、残差同士の関係なので切片は「0」となる。

さて、今回は、単回帰の残差の関係から偏相関を導いたが、
一般的に、偏相関係数は元の相関係数から、以下のように計算できる。



なお、は、の影響を抜いた と との偏相関を意味し、
 はそれぞれ、元の相関係数を意味している。
」は、ギリシア文字で「ロー」と発音する。「ピー」では無い。

さて、要するに、知りたい2つの変数の相関係数から、
潜在的に影響しているかもしれない別の1つの変数の影響を取り除き
結果の値が、「±1」の間に収まるように分母の部分で基準化している。

今回のように、3変数の場合は、直感的に理解しやすいのであるが、
4変数以上になると計算が非常に厄介になってくる。行列を使えば、
式自体はコンパクトになるが...余裕の無い人は以下の式の話は飛ばしても良い。

まず、元の相関係数行列における、変数「i」と「jとの相関係数を「」 とし、
その相関係数行列の逆行列におけるi」と「j」の関係を 「」する。
ちなみに、逆行列の添字を右下ではなく「右上」に置く。ちょっと、注意。

このとき、4変数以上の偏相関係数行列は、次のように求める。



逆行列の対応する要素を、2つの対角要素の平方根で割って基準化し、
さらに、「符号を反転」させている逆行列を使った数学の魔法!!
この方法で、偏相関係数を計算することができるのである。

まぁ、実際には、手計算で偏相関係数を求める人は少ないであろう。

Rでは、この偏相関係数を簡単に計算できるため、通常はこれを用いるのであるが、
残念ながら、偏相関行列を計算してくれるパッケージは最初からは入っていないので、
「corpcor」パッケージをインストールする。

# corpcor パッケージのインストール
install.packages("corpcor", dep=TRUE)

上手くインストールできたら、実際に計算してみる。

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

# 偏相関係数行列を計算する。
X.pcor <- cor2pcor(cor(X))

# 変数名が付かないので付け直す。
rownames(X.pcor) <- rownames(cor(X))
colnames(X.pcor) <- colnames(cor(X))

以下が、この実行結果。

> X.pcor
          OCU        UNO        PRI
OCU 1.0000000  0.9839439  0.3892439
UNO 0.9839439  1.0000000 -0.3269775
PRI 0.3892439 -0.3269775  1.0000000

PRIUNOの関係を見てみると、確かに、残差同士の相関係数と一致している。

相関係数行列は、変数間の関係を観察する上で非常に重要であるが、
さらに、細かい状況を把握するためには、
偏相関係数行列で見た方が、状況が良く解る場合もある。