2値データの相関は Multiple R-squared では解りづらいので らしい相関を計算する
・linear model を2値データに適用したとき summayの Multiple R-squared は、実感とずれがある かなり小さな値がでてくる
・yが0,1のデータがそのまま相関x,yでのyとして計算され Multiple R-squared となっている
・推定結果、得た係数をIDごとの曝露で計算したpと、観察したyとの関係を考え、別な相関を計算してみる
■ lmでのMRsqは、公式通りの単純な相関係数である
plot(jitter(idp),jitter(d$y)) :変数は後述
図 IDごとのpとy ;とあるモデルから
p:推定係数と曝露からなる期待値
例としたモデルの、推定pと発生yの相関は、
cor((idp),(d$y))
[1] 0.3120816
cor((idp),(d$y))^2
[1] 0.09739494 ;これは Multiple R-squared に一致
つまり、サマリーは2値のyそのまま、相関の計算をしている
また、その数値は、図からも明らかなようにごく弱い相関となってしまい、小さい
■ 別な相関 ・・ましな相関をどう計算するか
相関をみるべきxとy
まずxとなる、p これは推定の結果、coefficients×曝露有無 ;因子vectorの内積;IDごとに計算したvectorである pはもともと、yと、推定された係数によって決まる pの値は、あるID がもつ発生の可能性であって、曝露パターンの一致したサブg;ID n個 の pjは 対応するn個 のyのなかで y1/n という発生率に近づけたい性質のものであり、0,1のままでなく、pごとに集めたy1のy0+y1に占める割合として計算する
・記事;《前座》でまあまあよいモデルだった、 steak での計算例
ko6st <- lm(formula = y ~ wat + mesi + tam + potesara + steak + steak:mesi:tam +
mesi:tam, data = d)
summary(ko6st)
・・中略
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.009791 0.141247 0.069 0.94480
wat -0.110899 0.100638 -1.102 0.27164
mesi 0.166222 0.200210 0.830 0.40727
tam 0.620697 0.221751 2.799 0.00556 **
potesara 0.064811 0.095652 0.678 0.49873
steak -0.126427 0.166205 -0.761 0.44764
mesi:tam -0.540110 0.330976 -1.632 0.10409
mesi:tam:steak 0.238870 0.207519 1.151 0.25091
---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.4628 on 228 degrees of freedom
Multiple R-squared: 0.09739, Adjusted R-squared: 0.06968
F-statistic: 3.515 on 7 and 228 DF, p-value: 0.00133
kc <- ko6st $coefficients # 推定結果 coef を kcとしておく
■ 手計算で
IDごとの、期待値 p ;
idp = kc[ 1] + kc[2 ]*vw+ kc[3 ]*vm+ kc[4 ] *vt+ kc[5 ]*vp+ kc[6 ]*vste+ kc[7 ]*vm*vt+ kc[8 ]*vm*vt*vste
idp ;期待p の ID分のvec
などとして手作業を織り込んで計算できそうだ
■ 曝露、係数ベクトルから IDごとの期待値pを計算する
pivdf<- data.frame(table( idp))
yp_<- cbind(vy,1-vy,idp ) 236行 3列
table( yp_) 21 1 (項目名 目盛
table(yp_)[1] -0.16・・ 1
-------------------
y1idp<-cbind(idp,vy) # IDごと pとy
y0idp<-cbind(idp,1-vy) # 〃 y0;1 これいらない
y1df<-data.frame(y1idp) # df化
y0df<-data.frame(y0idp) #
tab1 <- table(y1df) # 度数
rdf<- cbind(tab1,tab1[,2]/(tab1[,2]+tab1[,1])) # pごとのyの率
rowr<- as.numeric(rownames(rdf)) # 文字であるpを数値にする
・pの値ごとの、yの率の分布
この段階でpごとのy率について形式的に相関をみる:上の rdf;度数表から直にMRsqが再現される
cor(rowr,rdf[,3]) # pが作るサブgのID 数は相関係数に反映されない
[1] 0.8429513
> cor(rowr,rdf[,3])^2
[1] 0.7105669
図示 plot(rowr,rdf[,3],cex=(log(rdf[,2]+rdf[,3]+1)))
図 pごとのy率の位置 ;プロット大きさは目盛ごとの例数に応じる
* 2×2表でいえば
------------------
・本来的な相関
p.rate<-as.numeric(rownames(rdf)) # 目盛を数値にして取り出し
ratedf<- cbind(p.rate,rdf[,1],rdf[,2],rdf[,3]) # y01、yrateとつなげる
# 項目名をつける
これは、度数表
ID ごとのデータをつくる
n=pごとのy01数;ID 数
rep(ratedf[,1], times = ratedf[,2]+ratedf[,3] ) # p をn個つくる
repp<- rep(ratedf[,1], times = ratedf[,2]+ratedf[,3] ) # p をn繰り返したもの
repy<- rep(ratedf[,4], times = ratedf[,2]+ratedf[,3] ) # yrate を 〃
rept<-rbind(repp,repy) # 2つを合わせ・・
cor(rept[1,],rept[2,]) # 相関をみる これはいわば nのウエイトつき相関
[1] 0.8803379
> cor(rept[1,],rept[2,])^2
[1] 0.7749948
図 pによるサブgごとのy発生率の相関 jitter入り
・この処理はあたかも重みをつけたような相関性を算出できる
■ 考えるに
2値解析はロジスティック回帰が、連続量はlmが連想される
pが比較的大きく推定される一方、観測yは、1に一致せず、ましてかなりがy0になっていることは、交互作用項を含む複数のモデル試行で明らかだが、かつての記事にあるとおり、不思議なことでも不都合なことでもない
よって、その値 2×2表 でいえば c * に直接左右されない指標がほしいところ、発生有無でなくその率とで相関係数風な値を得て視覚化し、実感した pという位置において y1のものの割合が適合しているかの一致具合こそ実は重要なのだろう
ここで試行した”ましな”相関は、1つの思いつきであった
これによる値は、モデルサマリーと比べて、かなり良好な相関を示す
ちょっと残念なのはいちいちモデルごと計算しなければならず、使いづらい 当面、Rsqをみていくことになる