2011.12.14
2011年度生物測定応用実験

テキストマイニング

東京大学大学院農学生命科学研究科　大森宏

本郷界隈景観調査での撮影理由のテキストマイニング

概要

　2010年度と2011年度にわたり，本郷界隈の好ましい景観の調査を行った．このとき，撮影理由も合わせて 記述した．今回の実験で撮影理由のテキストを統計的に解析し，撮影された写真との関係を考察する．
　MAC の R は日本語処理がうまくいかないので，windows 上の R で以下の解析を行う．

テキストマイニングシステムのインストール

　すでに終了した学生は以下のインストール作業を飛ばしてよい．
  1. 以下のファイルを c:\Users\eccs2008admin\Desktop に保存

    R 2.14.0
    mecab-0.98.exe
    RMeCab_0.98.zip

  2. R-2.14.0-win.exe を実行
    インストール先を c:\Users\eccs2008admin\Desktop にする．
  3. mecab-0.98.exe を実行
    インストール先を c:\Users\eccs2008admin\Desktop にする．
  4. R のパッケージのローカルにある zip ファイルからのパッケージ のインストールで RMeCab_0.98.zip を指定 
# MeCab の実行確認
library(RMeCab)
txt <- "「田舎の祖父母の家」のような懐かしさが感じられた。"
res <- RMeCabC(txt)
unlist(res)

収集された本郷界隈景観

　夏学期に行ったグルーピング実験のデータをデスクトップに ダウンロードして，R に読み込ませる．

グルーピングデータダウンロード

このデータから収集写真間の類似度を算出し，写真間類似度行列から多次元尺度法（MDS）により 写真間類似度マップを生成する． 
# 
# R スクリプト
#
mkmat <- function(wg){ 	# 0 - 1 行列を作成する関数の定義
n <- length(wg) 	# ベクトルの長さ（画像数）
maxg <- max(wg) 	# グループ最大値
ming <- min(wg) 	# グループ最小値（普通は１）
if(!ming){ 	# 最小値が 0 のときの処置
ming <- 1; maxg <- maxg+1; wg <- wg+1 	# グループ数を 1 つ増やす
} 	#
gmat <- matrix(0, nrow=n, ncol=maxg) 	# n × maxg 行列（値は 0）
for(i in ming:maxg){ 	# グループごとの処理
ng <- (1:n)[wg == i] 	# グループ i に所属する行番号（画像番号）
gmat[ng, i] <- 1 	# 上の行番号と i 列の値を 1 にする
} 	#
return(gmat) 	#
} 	#
# 
# 夏学期グルーピングデータの読み込み
tg <- read.csv("kaiwaigr.csv", header=TRUE, row.names=1); tg 
####
n <- ncol(tg) 	# 画像の数
m <- nrow(tg) 	# 学生の数
S <- matrix(0, nrow=n, ncol=n) 	# 類似度行列の定義
for(i in 1:m){ 	#
w <- mkmat(tg[i, ]) 	# 学生ごとのグルーピング行列
S <- S + w %*% t(w) 	# 学生ごとの類似度行列を加える
} 	#
D <- max(S) - S 	# 非類似度行列への変換
####
tcmd <- cmdscale(D, k=4, eig=TRUE, add=TRUE) 	# 多次元尺度法（MDS）
tcmd$eig[1:5] 		# MDS の固有値
x <- tcmd$points	# MDS の座標を x に格納
dimnames(x) <- list(as.character(1:n), paste("MDS", 1:4, sep="")) 
plot(x[,1:2], type="n") 	# １軸と２軸
text(x[,1:2], rownames(x), cex=0.8) 
title(main="MDS of around hongo landscapes") 	#
mds

クラスター分析による景観パターンの分類

　景観写真間非類似度行列を距離行列とみなしてクラスター分析にかけ， 景観パターンを分類する．R の階層的クラスター分析には，クラスターを構成 する方法として， "ward", "single", "complete", "average", "mcquitty", "median", "centroid"， の７つがある．R のデフォルトは "complete" である．
　クラスターを構成する手法によりクラスターの形状が異なるので，良さそうな 手法（method="complete"）を用い， 良さそうなクラスター間距離（h = 40）パターン分類を行った．得られた分類を MDS 類似 景観マップに書いてみるとまあ良さそうにみえる． 
#
# クラスター分析によるグルーピング例
dd <- dist(D)
dd.clus <- hclust(dd)		# hclust(dd, method="complete") と同じ
plot(dd.clus, cex=0.7)
abline(h=40, col="red")
clclass <- cutree(dd.clus, h=40)	# h=40 でグループ分け
# クラスメンバーの表示
g1 <- which(clclass==1); g1
g2 <- which(clclass==2); g2
g3 <- which(clclass==3); g3
g4 <- which(clclass==4); g4
g5 <- which(clclass==5); g5
g6 <- which(clclass==6); g6
g7 <- which(clclass==7); g7
# グループ名の表示
text(10, -12, "G2")
text(22, -13, "G1")
text(29, -12, "G4")
text(40, -13, "G5")
text(50, -10, "G6")
text(58, -13, "G3")
text(66, -10, "G7")
#
gn <- max(clclass)
xgname <- paste("G", 1:gn, sep="")
# MDS マップ上でのグループ平均座標
xg1 <- tapply(x[,1], clclass, mean)
xg2 <- tapply(x[,2], clclass, mean)
xg3 <- tapply(x[,3], clclass, mean)
xg4 <- tapply(x[,4], clclass, mean)
op <- par(mfrow = c(1, 2)) 
plot(x[,1:2], type="n") 	# １軸と２軸
text(x[,1:2], rownames(x), col=clclass+1, cex=0.8) 
text(xg1, xg2, xgname)
plot(x[,3:4], type="n") 	# 3軸と4軸
text(x[,3:4], rownames(x), col=clclass+1, cex=0.8) 
text(xg3, xg4, xgname)                                                                                 
par(op)
title(main="MDS of around hongo landscapes") 	#
cluster
cluster

写真つき類似度マップ

撮影地点マップ

撮影地点マップ（アイコンつき）

形態素解析

　形態素解析とはテキストをその最小単位である形態素に分解し， それぞれの品詞を判別することである． この実験では形態素解析ソフトとして R 上で動作する RMeCab を用いた．
いま，"「田舎の祖父母の家」のような懐かしさが感じられた。" を形態素解析にかけると以下のようになる． 
> library(RMeCab)
> txt <- "「田舎の祖父母の家」のような懐かしさが感じられた。"
> res <- RMeCabC(txt)
> unlist(res)
    記号     名詞     助詞     名詞     助詞     名詞     記号     助詞 
    "「"   "田舎"     "の" "祖父母"     "の"     "家"     "」"     "の" 
    名詞   助動詞   形容詞     名詞     助詞     動詞     動詞   助動詞 
  "よう"     "な" "懐かし"     "さ"     "が"   "感じ"   "られ"     "た" 
    記号 
    "。"

形態素文書行列

　複数の文書ファイル間の関係を調べるために、どの文書ファイルにどの形態素が 何回用いられているかの情報が重要な役割を演じる．RMeCab にはフォルダ内にある 文書ファイルをすべて読み込んで，形態素文書行列を生成させることができる．

文書フォルダ圧縮ファイルダウンロード

　ダウンロードした圧縮ファイルを解凍して doc フォルダをつくる． 　いま，doc フォルダ内に本郷界隈の撮影理由テキストが kaiwai01.txt，kaiwai02.txt，…， kaiwai69.txt というファイル名で入っている．助詞や助動詞は文書内容の特徴に 関係しないと考えられるので，名詞，形容詞，動詞の形態素を抽出する．全部で 746個の 形態素が抽出された．
　形態素文書行列に radj という名前をつけた．101番（イチョウ）から105番（クーラー） の形態素文書行列を表示してみる．これをみると，行列の要素のほとんどが 0 で， 非常にスパースであることがわかる． 
# 形態素文書行列表示の R スクリプト
radj <- docMatrix2("doc", pos=c("名詞", "形容詞", "動詞"))
rownames(radj)
dim(radj)
radj[101:105,1:12]

不必要と思われる形態素の削除

　抽出された 746の形態素には "("，"1"，"あたる"，など景観の印象とはあまり 関係しないと思われる形態素がかなりある．そこで，このような形態素を手動で 削除してみる．
　まず，削除用の csv ファイルを作成し，これを Excel で開く．必要ないと 思われる形態素の cut 列に 1 を入れて保存する．その後 R にカット行列を読み込ませ， 不必要な形態素の行番号を取得して必要な形態素のみの文書行列を作成する．より正確には， "いい"，"よい"，"良い"，などの類似語をまとめる作業（辞書）の作成も必要であるが， 今回の実験では割愛する．興味のある学生は類似語をまとめてみてもよい． 
# 形態素カット行列作成の R スクリプト
cut0 <- data.frame(cbind(rownames(radj), rep(0,nrow(radj))))
names(cut0) <- c("word", "cut")
write.csv(cut0, file="kaiwaicut.csv")
#
# 形態素カット行列読み込みの R スクリプト
#cut <- read.csv("kaiwaiword.csv", row.names=1, header=T)
cut <- read.csv("kaiwaicut.csv", row.names=1, header=T)
use <- which(cut$cut == 0)
radj3 <- radj[use,]
rownames(radj3)
dim(radj3)

形態素文章行列の対応分析

　どのような形態素がどの文章によく用いられているかを対応分析で調べる． 対応分析の内容は 対応分析（数量化３類）の説明にある． 
# 形態素文章行列の対応分析の R スクリプト
library(MASS)
res3 <- corresp(radj3, nf=5)
colnames(res3$cscore) <- paste("Corresp", 1:5, sep="")
radname0 <- as.character(1:n)
res3$cor
biplot(res3, cex=0.5)
#
#
op <- par(mfrow = c(1, 2))
plot(res3$cscore[,1:2], type="n")
text(res3$cscore[,1:2], radname0, col=clclass+1, cex=0.8)
title(main="形態素文章行列の対応分析")
plot(res3$cscore[,1:2], type="n", xlim=c(-1.5,1.5), ylim=c(-1.5,1.5))
text(res3$cscore[,1:2], radname0, col=clclass+1, cex=0.7)
title(main="形態素文章行列の対応分析（中心部拡大）")
par(op)
mds
　スパースな形態素文章行列をそのまま対応分析にかけると，長い文章など他と 変わった文章が遠くに はじかれたりして構造がわからない．中心部を拡大しても景観パターンごとの 構造はみえてこない．なお，文章リストも参照 してみよう． 
# はじかれた文章の形態素
# 19
wn <- which(radj3[,19] > 0)
rownames(radj3)[wn]
# 21
wn <- which(radj3[,21] > 0)
rownames(radj3)[wn]
# 42
wn <- which(radj3[,42] > 0)
rownames(radj3)[wn]

形態素文章行列の対応分析の改良

　文章の長さや変わった文章などがあり，このままでは全体像をつかむことができない． そこで，同じ景観グループに対応する文章は互いに似ていると考え，景観グループ ごとにまとめた文章集合を考える．これを形態素文章行列に加え，対応分析を行うと， 景観グループ文書集合で基本的な配置がえられ，景観グループのまわりにそこに含まれる 個々の文章が配置されるので，全体の関係がわかりやすくなる．景観グループ文章集合 の配置を詳しくみるには１軸−２軸だけでなく他の軸での配置をみる．また，景観グループ のそばに配置された文章がその景観グループに対する印象を代表する文章になる． 
# 形態素文章行列の景観グループの対応分析の R スクリプト
wg1 <- apply(radj3[,g1],1,sum)
wg2 <- apply(radj3[,g2],1,sum)
wg3 <- apply(radj3[,g3],1,sum)
wg4 <- apply(radj3[,g4],1,sum)
wg5 <- apply(radj3[,g5],1,sum)
wg6 <- apply(radj3[,g6],1,sum)
wg7 <- apply(radj3[,g7],1,sum)
#
wonlyg1 <- which( (wg2+wg3+wg4+wg5+wg6+wg7)==0 )
wonlyg2 <- which( (wg1+wg3+wg4+wg5+wg6+wg7)==0 )
wonlyg3 <- which( (wg2+wg1+wg4+wg5+wg6+wg7)==0 )
wonlyg4 <- which( (wg2+wg3+wg1+wg5+wg6+wg7)==0 )
wonlyg5 <- which( (wg2+wg3+wg4+wg1+wg6+wg7)==0 )
wonlyg6 <- which( (wg2+wg3+wg4+wg5+wg1+wg7)==0 )
wonlyg7 <- which( (wg2+wg3+wg4+wg5+wg6+wg1)==0 )
#
radj4 <- cbind(radj3, wg1,wg2,wg3,wg4,wg5,wg6,wg7)
res4 <- corresp(radj4, nf=5)
colnames(res4$cscore) <- paste("Corresp", 1:5, sep="")
colnames(res4$rscore) <- paste("Corresp", 1:5, sep="")
biplot(res4, cex=0.5)
groupname <- paste("wg", 1:7, sep="")
op <- par(mfrow = c(1, 2))
com <- c(1,2)
plot(res4$cscore[,com], type="n")
text(res4$cscore[1:n,com], radname0, col=clclass+1, cex=0.7)
text(res4$cscore[(n+1):ncol(radj4), com], groupname)
com <- c(3,4)
plot(res4$cscore[,com], type="n")
text(res4$cscore[1:n,com], radname0, col=clclass+1, cex=0.7)
text(res4$cscore[(n+1):ncol(radj4), com], groupname)
par(op)
title(main="本郷界隈景観コメントの対応分析")
mds
　たとえば，グループ４についてみてみる．下の図をみると，グループ４を代表する文章は， ９番と20番の文章であることがわかるので，その文章を文章リスト でみてみよう． 
# グループ４を詳しくみる R スクリプト
op <- par(mfrow = c(1, 2))
com <- c(1,2)
# 文章の配置
plot(res4$cscore[,com], type="n", xlim=c(-2, 0), ylim=c(-1, 1))
text(res4$cscore[1:n,com], radname0, col=clclass+1, cex=0.8)
text(res4$cscore[(n+1):ncol(radj4), com], groupname)
# 形態素の配置
plot(res4$rscore[,com], type="n", xlim=c(-2, 0), ylim=c(-1, 1))
text(res4$rscore[,com], rownames(res4$rscore), cex=0.6)
par(op)
title(main="拡大図によるグループ４の文章番号と形態素")
mds

景観グループごとに使用された形態素の分析

# 景観グループごとの使用形態素の R スクリプト
#
# group1 
#
wn1 <- which(wg1>0)
wl1 <- which(wn1 %in% wonlyg1)
length(wn1)
length(wl1)
# グループ１で使用された形態素
wall1 <- sort(wg1[wn1], decreasing=T); wall1
# グループ１のみで使用された形態素
wuni1 <- sort(wg1[wn1[wl1]], decreasing=T); wuni1
#
# group2 
#
wn2 <- which(wg2>0)
wl2 <- which(wn2 %in% wonlyg2)
length(wn2)
length(wl2)
# グループ２で使用された形態素
wall2 <- sort(wg2[wn2], decreasing=T); wall2
# グループ２のみで使用された形態素
wuni2 <- sort(wg2[wn2[wl2]], decreasing=T); wuni2
Copyright (C) 2011, Hiroshi Omori. 最終更新日：2011年 12月13日