読者です 読者をやめる 読者になる 読者になる

Rを通じて統計学を学ぶ備忘録ブログ

SPSSからRに移行したい私のような人向けのR解説ブログ兼学習用備忘録。

テキストマイニングはじめました〜その9〜

テキストマイニング

今回はテキストマイニングとコレスポンデンス分析(対応分析)について見ていきます。目標は以下の通りです。

自由記述の回答を成形し、対応分析を行うこと

今回利用する自由記述のデータは、STAP細胞でおなじみの小保方先生著「あの日」のアマゾンのレビューより抽出しました。また対応づけるために、星の数も同時に抽出しています。特に深く分析をしようとしていないので、特段おもしろい結果もでないと思いますが、 とりあえず始めます。 また、今回使用するフォントは「ヒラギノ丸ゴ」です。個人的にはよく使うフォントの一つです。 f:id:teruaki-sugiura:20160604134342p:plain

コレスポンデンス分析は、数量化3類と同様の手法と言われ、カテゴリカルデータの解析方法です。簡単に言うと、多次元クロス表の行と列に対応する度数をもとに、相関が最大になるように並び替えることで、変数間の関連性を探り、グラフ化する手法です。

数理的なことはさておき、Rで実際にやってみます。データはネットにおちていた年収と1ヶ月の読書数のデータを利用しています。

dat <- read.csv("demo20160604.csv", header = TRUE)
dat.table <- table(dat$income, dat$books)
dat.table <- matrix(dat.table, 4, 4)
rownames(dat.table) <- c("1~2", "3~4", "5~6", "7~")
colnames(dat.table) <- c("~300", "301~500", "501~700", "701~")

corresp()関数はtable()形式だと計算できないので3行目でmatrix形式に変換しています。次に実際にコレスポンデンス分析を行います。corresp()関数のnfで求める固有値固有ベクトルの数を指定します。

dat.correspond.nf2 <- corresp(dat.table, nf = 2)
dat.eigenvalue <- dat.correspond.nf2$cor^2
round(100 * dat.eigenvalue / sum(dat.eigenvalue), 2)
dat.correspond.nf4 <- corresp(dat.table, nf = 4)
dat.eigenvalue <- dat.correspond.nf4$cor^2
round(100 * dat.eigenvalue / sum(dat.eigenvalue), 2)

f:id:teruaki-sugiura:20160604145327p:plain

累積寄与率をみてみると、2軸で99%を説明しており、3軸もいらないことがわかります。そして、軸の数も決まったところで、グラフ化していきます。

biplot(dat.correspond.nf2)

f:id:teruaki-sugiura:20160604144458p:plain

この結果を見る限り、年収501~700万円では1ヶ月の読書数は3~4冊であり、年収301~500万円では1ヶ月の読書数は1~2冊という傾向が読み取れます。今回は2変数でしたが、多変数をまとめてグラフ化することで、傾向を読み取れる点がコレスポンデンス分析の良い点ですね。

f:id:teruaki-sugiura:20160604151008p:plain

では「あの日」の「レビューと星」の中で、なにかテキストの傾向があるのかどうかをみていきます。この本は読んだことがないので、内容がわかりませんが、なにかおもしろい傾向はあるのでしょうか。本の内容は以下の通りです。

真実を歪めたのは誰だ?STAP騒動の真相、生命科学界の内幕、業火に焼かれる人間の内面を綴った衝撃の手記。

とりあえず、データの中身を見ていきます。とりあえず、RMeCabDF()関数で、自由記述のテキストを形態素に分けます。

anohi.DF <- RMeCabDF(anohi.df, 1, 1)
anohi.DF[1]

f:id:teruaki-sugiura:20160604152955p:plain

length(anohi.DF)
length(unlist(anohi.DF))
length(unique(unlist(anohi.DF)))
anohi.table1 <- table(unlist(anohi.DF))
anohi.table1[rev(order(anohi.table1))][1:10]

f:id:teruaki-sugiura:20160604153017p:plain

このデータではレビューが770件の時点のデータなので、長さは770行あります。トークン数は21万で、ユニークなターム(タイプ)はおよそ1万あるようです。とりあえず、いったん度数が高いもの順に並べてみます。「の」「は」「に」・・・「だ」「て」などの機能語が多いことがわかります。これはなんら不思議なことではありません。order()関数で順に並べるんですが、少ないもの順に並ぶので、rev()関数で「多いもの順」に並び替えています。今回の目的では、テキストと星の数の傾向を見ることを目的にしているので、「機能語」を削除していきます。

anohi.list1 <- list()
for(i in 1:length(anohi.DF)){
 anohi.list1i <- anohi.DFi[names(anohi.DFi) == "名詞" |
                         names(anohi.DFi) == "形容詞"]
}

このfor文は1〜770行までのテキスト内の、「名詞」と「形容詞」を取り出してます。目的に応じて、「動詞」が必要であれば同様の方法で追加します。

length(unique(unlist(anohi.list1)))
anohi.table2 <- table(unlist(anohi.list1))
anohi.table2[rev(order(anohi.table2))][1:20]

f:id:teruaki-sugiura:20160604155518p:plain

さらに、ここからコレスポンデンス分析を行うために「星が1つ」「星が2つ」「星が3つ」「星が4つ」「星が5つ」に分けて、星数に対応するテキストを振り分けていく必要があります。また、「小保方」「研究」「STAP細胞」などは必要ないので削除してもいいかもしれません。とりあえず、振り分けを行います。

anohi.1star <- list()
for(i in 1:length(anohi.list1)){
 if(!is.na(anohi.df$star[i]) & nohi.df$star[i] == "1"){
   anohi.1stari <- anohi.list1i
  }else{
   anohi.1stari <- NA
 }
}

このfor文では「もし、is.na()関数で「星」がNAでなく、かつ「星=1」の回答者を、さっき「名詞」「形容詞」を抽出したリストから振り分け、そうでない番号ではNAをいれる」ようになっています。」

anohi.1star1 <- unlist(anohi.1star)[unlist(anohi.1star)!="小保方" &
                unlist(anohi.1star)!= "の" &
                unlist(anohi.1star)!= "的" &
                unlist(anohi.1star)!="する" &
                unlist(anohi.1star)!= "いる" &
                unlist(anohi.1star)!= "れる" &
                unlist(anohi.1star)!= "こと" &
                unlist(anohi.1star)!= "さん" &
                unlist(anohi.1star)!= "なる" &
                unlist(anohi.1star)!= "よう" &
                unlist(anohi.1star)!= "ない" ]
anohi.1star1.table <-table(anohi.1star1)

そして、振り分けたリストの中から、分析目的にはそぐわない「不必要」な言葉は削除していきます。 これを星が2つ〜5つまでも同じように処理します。このようにテキストデータを成形した後、コレスポンデンス分析に移ります。

anohi.label1 <- unique(c(names(anohi.table1),
           names(anohi.table2),
           names(anohi.table3),
           names(anohi.table4),
           names(anohi.table5)))
anohi.DF001 <- NULL
anohi.DF001 <- data.frame(word = names(anohi.table1), id = rep("1star",length(anohi.table1)), Freq = anohi.table1)
anohi.DF002 <- NULL
anohi.DF002 <- data.frame(word = names(anohi.table2), id = rep("2star",length(anohi.table2)), Freq = anohi.table2)
anohi.DF003 <- NULL
anohi.DF003 <- data.frame(word = names(anohi.table3), id = rep("3star",length(anohi.table3)), Freq = anohi.table3)
anohi.DF004 <- NULL
anohi.DF004 <- data.frame(word = names(anohi.table4), id = rep("4star",length(anohi.table4)), Freq = anohi.table4)
anohi.DF005 <- NULL
anohi.DF005 <- data.frame(word = names(anohi.table5), id = rep("5star",length(anohi.table5)), Freq = anohi.table5)
anohi.DF.all <- rbind(anohi.DF001, anohi.DF002, anohi.DF003, anohi.DF004, anohi.DF005)

ここではコレスポンデンス分析をするために、データの最終成形を行っているところです。data.frame()関数で「word」「id」「Freq」の3つの列情報を持つデータフレームに変換しています。こんな感じです。まだまだ不必要な言葉がありますので削除しなければいけませんね・・・。

f:id:teruaki-sugiura:20160604162736p:plain

words <- which(anohi.label1 %in% "の",...,"氏")
anohi.label1 <- anohi.label1[-words]
anohi.label1[which(anohi.label1 == "教授")] <- “先生"

2行目のコードでは、不必要な形態素は削除し、3行目のコードでは似たような意味の言葉を括ることができます。

コレスポンデンス分析をするためには、MASSパッケージが必要なので、読み込む必要があります。corresp()関数に渡すために、xtabs()関数で成形しています。

library(MASS)
anohi.DF.all.table <- xtabs(Freq ~ word + id, data = anohi.DF.all)
row.names(anohi.DF.all.table)
par(family = "HiraKakuProN-W3")
anohi.correspond <- corresp(anohi.DF.all.table, nf = 2)
biplot(anohi.correspond)

f:id:teruaki-sugiura:20160604162204p:plain

星が1つの人たちでは「理研」、星が2つの人たちでは「テラトーマ」という傾向がありますが、これではなんのこっちゃさっぱりなので、よりテキストデータを精緻に成形していく必要がありそうです。とはいっても、私のようなテキストマイニング初心者にとっては、どうすればいいのか・・・・テキストマイニングの勉強をより一層していくしかないですね・・・

以上で今回はおしまい。

広告を非表示にする