先日のエントリ(AKB勢力図を描いてみました)でAKBの勢力図を描いてみたが，あれはクリギングという地球統計学の技法を使ったもの。それがそのままマーケティングだとか，勢力分布の理解に利用できる保障はどこにもない。
ところで，社会心理学の態度研究の系譜の中に，Abelson,R.Pという人がいる。この人は，Lewinの場の理論に影響を受け，電磁場モデルの態度版とでもいうべき，態度の等高線マップモデルというのを提案している*1。
これまた，出典こそ社会心理学ではあるが，社会的態度や心理学研究に予測的妥当性や新しい知見をもたらすものかどうか，ということについてはまだ不明。まぁ研究例が少ないからである。Abelsonのこのモデルは，なぜか態度研究業界では忘れ去られた存在になっている。
理由の一つは，描画方法がなかったからかと。アプリケーションがあるわけでもないし。
手前味噌ながら，このAbelsonモデルで論文を書いているのだけど*2，そのときは自作のプログラムでX,Y座標各点の高さZを算出するコードを描いて，それをgnuplotで読ませて描いていた。
さて。既に，統計ソフトプラットフォームはRで統一されていると言っても過言ではないが，このAbelsonモデルをRで描けないかなぁ，ということで関数を書いてみました。いやぁ，ベクトル演算ができるので，書くのがとっても楽！描画についてもcontour関数やimage関数をそのままつかえるので，苦労する必要がない。
X-Y軸とZ軸のデータセットをリストとして持つgeodataオブジェクトにしておくと，先のクリギングとの対応も簡単に出来ちゃう。
ということで，Abelsonモデルの方でAKB勢力図を書いてみました。
サンプルコードはこちら。最初の距離データについては提供できませんのであしからず。
disance <- read.csv("c:\\temp\\akb48.csv")
cmdscale(distance) -> AKBmap
contAKB <- cbind(AKBmap,
c(17156,16452,12056,8833,
8582,8016,7357,6596,6559,
6537,5157,5096,3931,3860,
3102,2843,2753,2685,2201,1793))
library(geoR)
geodata <- as.geodata(contAKB)
Abelson.map <- function(dat,locations){
z <- double()
X <- dat$coords[,1]
Y <- dat$coords[,2]
P <- dat$data
un <- matrix(1,nrow(locations),1,)
Xs <- un %*% X
Ys <- un %*% Y
dm <- ((locations[,1]-Xs)^2+(locations[,2]-Ys)^2+1)
V <- t(P %*% (1/t(dm)))
xx <- sort(unique(locations[,1]))
nx <- length(xx)
yy <- sort(unique(locations[,2]))
ny <- length(yy)
values <- matrix(V,ncol=ny)
ret <- structure(list(x=xx,y=yy,valence=values))
return(ret)
}
Abelson.map(geodata,loc) -> ab
image(x=ab$x, y=ab$y,z=ab$valence)
contour(x=ab$x,y=ab$y,z=ab$valence,add=TRUE,drawlabels=FALSE)
text(AKBmap,colnames(distance))
とまぁこんな感じ。解釈のしやすさという意味では，クリギングよりこちらの方がよいかも知れない。
いずれにせよ，AbelsonモデルvsKrigモデル，という対比をして，どちらが態度研究に向いているか，という比較が出来るようになったという点は進歩かなぁ。これでしばらく遊べそうです。
プログラムはこちらに置いておきましたので，良かったら使ってみてください。