センチメント分析
Ei Taguchi
Abstract
実践Rによるテキストマイニング第2章辞書作成
## 辞書の読み込み
dic <- read.table("http://www.lr.pi.titech.ac.jp/~takamura/pubs/pn_ja.dic",
sep = ":", stringsAsFactors = FALSE, fileEncoding = "CP932",
encoding = "UTF-8")library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──## ✓ ggplot2 3.3.3 ✓ purrr 0.3.4
## ✓ tibble 3.1.0 ✓ dplyr 1.0.5
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 1.4.0 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()## 冒頭部分の確認
dic %>%
head(15)## V1 V2 V3 V4
## 1 優れる すぐれる 動詞 1.000000
## 2 良い よい 形容詞 0.999995
## 3 喜ぶ よろこぶ 動詞 0.999979
## 4 褒める ほめる 動詞 0.999979
## 5 めでたい めでたい 形容詞 0.999645
## 6 賢い かしこい 形容詞 0.999486
## 7 善い いい 形容詞 0.999314
## 8 適す てきす 動詞 0.999295
## 9 天晴 あっぱれ 名詞 0.999267
## 10 祝う いわう 動詞 0.999122
## 11 功績 こうせき 名詞 0.999104
## 12 賞 しょう 名詞 0.998943
## 13 嬉しい うれしい 形容詞 0.998871
## 14 喜び よろこび 名詞 0.998861
## 15 才知 さいち 名詞 0.998771V4には感情極性値が格納されている. +1~-1で, 大きいほどポジティブ 次に同じ単語で複数の読みがあるものを確認する
dic %>%
group_by(V1) %>%
## 要素をカウントする
filter(n() > 1) %>%
## 降順
arrange((desc(V1)))## # A tibble: 4,504 x 4
## # Groups: V1 [2,050]
## V1 V2 V3 V4
## <chr> <chr> <chr> <dbl>
## 1 齢 れい 名詞 -0.328
## 2 齢 よわい 名詞 -0.533
## 3 鼻息 びそく 名詞 0.155
## 4 鼻息 はないき 名詞 -0.0388
## 5 鼻 はな 名詞 -0.770
## 6 鼻 び 名詞 -0.938
## 7 鼠 ねず 名詞 -0.497
## 8 鼠 ねずみ 名詞 -0.900
## 9 鼠 そ 名詞 -0.989
## 10 鼓 こ 名詞 -0.331
## # … with 4,494 more rows複数の読みがある場合は感情極性値の平均を使うこととするが, 単語によっては大きな差が出る可能性がある. 単語ごと最大値と最小値の差を確認する
## 最大値-最小値
dic %>%
group_by(V1) %>%
filter(n() > 1) %>%
summarise(Diff = max(V4) - min(V4)) %>%
arrange((desc(Diff))) %>%
head(10)## # A tibble: 10 x 2
## V1 Diff
## <chr> <dbl>
## 1 大人 1.94
## 2 竹 1.90
## 3 様様 1.89
## 4 五 1.79
## 5 父 1.72
## 6 玉 1.69
## 7 縁 1.66
## 8 冠 1.61
## 9 長 1.59
## 10 守る 1.50極性値の平均をとり, 単語と極性値のみ残す
dic <- dic %>%
group_by(V1) %>%
summarize(SCORE = mean(V4)) %>%
rename(TERM = V1) %>%
select(TERM, SCORE)テキストを文で区切る
## 注文の多い料理店
source("http://rmecab.jp/R/Aozora.R")# 青空文庫ダウンロード解析用機能の取得
kenji <- Aozora("https://www.aozora.gr.jp/cards/000081/files/43754_ruby_17594.zip")## example: folder_name <- Aozora('http://www.aozora.gr.jp/cards/000081/files/462_ruby_716.zip')## 文章ごとに区切る
chumon <- readLines(kenji)
chumon %>%
head()## [1] "注文の多い料理店"
## [2] "宮沢賢治"
## [3] ""
## [4] ""
## [5] " 二人の若い紳士が、すっかりイギリスの兵隊のかたちをして、ぴかぴかする鉄砲をかついで、白熊のような犬を二疋つれて、だいぶ山奥の、木の葉のかさかさしたとこを、こんなことを云いながら、あるいておりました。"
## [6] "「ぜんたい、ここらの山は怪しからんね。鳥も獣も一疋も居やがらん。なんでも構わないから、早くタンタアーンと、やって見たいもんだなあ。」"## タイトルと作者を削除
chumon <- chumon[-(1:2)]文単位で区切るために余計なものを削除していく
library(stringr)
sent_chumon <- chumon %>%
## 全角削除
str_remove_all(" ") %>%
## 。で区切る
str_split(pattern = "(?<=。)") %>%
## ベクトルに戻す
unlist()
sent_chumon <- sent_chumon %>%
## カギ括弧消す
str_remove_all("「|」")
## 空のレコードを消す
sent_chumon <- sent_chumon[sent_chumon != ""]
sent_chumon %>% head(5)## [1] "二人の若い紳士が、すっかりイギリスの兵隊のかたちをして、ぴかぴかする鉄砲をかついで、白熊のような犬を二疋つれて、だいぶ山奥の、木の葉のかさかさしたとこを、こんなことを云いながら、あるいておりました。"
## [2] "ぜんたい、ここらの山は怪しからんね。"
## [3] "鳥も獣も一疋も居やがらん。"
## [4] "なんでも構わないから、早くタンタアーンと、やって見たいもんだなあ。"
## [5] "鹿の黄いろな横っ腹なんぞに、二三発お見舞もうしたら、ずいぶん痛快だろうねえ。"## tibbleへの変換
## 番号を降る
sent_chumon <- tibble(S = sent_chumon) %>%
mutate(ID = row_number())
## tibbleでは文字列のまま保存される
str(sent_chumon)## tibble[,2] [241 × 2] (S3: tbl_df/tbl/data.frame)
## $ S : chr [1:241] "二人の若い紳士が、すっかりイギリスの兵隊のかたちをして、ぴかぴかする鉄砲をかついで、白熊のような犬を二疋つれて"| __truncated__ "ぜんたい、ここらの山は怪しからんね。" "鳥も獣も一疋も居やがらん。" "なんでも構わないから、早くタンタアーンと、やって見たいもんだなあ。" ...
## $ ID: int [1:241] 1 2 3 4 5 6 7 8 9 10 ...## 文の長さを数えてみる
sent_chumon %>%
mutate(N = nchar(S)) %>%
## 最小と最長をみる
filter(N == max(N) | N == min(N))## # A tibble: 3 x 3
## S ID N
## <chr> <int> <int>
## 1 二人の若い紳士が、すっかりイギリスの兵隊のかたちをして、ぴかぴかする鉄砲をかついで、白熊のような犬を二疋つれて、だいぶ山奥の、木の… 1 99
## 2 山猫軒 36 3
## 3 わん。 223 3各文ごと形態素解析をしてデータフレームを作成し, 連結する
library(RMeCab)
library(purrr)
## データフレームを作る関数を定義
rmecabc <- function(id, sent){
## RMrcabCの第二引数に1を渡すと形態素原型がかえってくる
## 1つのベクトルにする
x <- unlist(RMeCabC(sent, 1))
tibble(ID = id, TERM = x)
}## IDとSにおいて関数rmecabcが繰り返し適用される
terms_chumon <- map2_dfr(sent_chumon$ID, sent_chumon$S,
## 内部で別の関数を使う場合~を使う
## ..1, ..2は引数を指定しており, 1がID, 2がS
~ rmecabc(..1, ..2))
## これでもいける
terms_chumon2 <- map2(sent_chumon$ID, sent_chumon$S,
## 内部で別の関数を使う場合~を使う
## ..1, ..2は引数を指定しており, 1がID, 2がS
~ rmecabc(..1, ..2)) %>%
bind_rows()
terms_chumon## # A tibble: 3,218 x 2
## ID TERM
## <int> <chr>
## 1 1 二
## 2 1 人
## 3 1 の
## 4 1 若い
## 5 1 紳士
## 6 1 が
## 7 1 、
## 8 1 すっかり
## 9 1 イギリス
## 10 1 の
## # … with 3,208 more rows感情極性値辞書の適用
データと辞書を結合する
## TERMをキーにして結合## 違う場合はby=c("X" = "Y")
terms_chumon <- terms_chumon %>%
left_join(dic, by = "TERM")## 各文章ごとに極性値を計算
em_chumon <- terms_chumon %>%
group_by(ID) %>%
summarise(EM = sum(SCORE, na.rm = T))
summary(em_chumon$EM)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -12.9732 -2.3827 -1.2325 -1.6223 -0.4227 1.4585## 最小値と最大値の文をみてみる
em_chumon %>%
filter(EM == min(EM) | EM == max(EM)) %>%
left_join(sent_chumon, by = "ID") %>%
pull()## [1] "ことに肥ったお方や若いお方は、大歓迎いたします"
## [2] "だからさ、西洋料理店というのは、ぼくの考えるところでは、西洋料理を、来た人にたべさせるのではなくて、来た人を西洋料理にして、食べてやる家とこういうことなんだ。"感情極性値の時系列
感情極性値の流れを可視化してみる
library(ggplot2)
ggplot(data = em_chumon)+
aes(x = ID, y = EM) +
geom_line()
だいたい0~-5くらいにおさまっているので、それより小さいと何かハプニングが起きてそう
em_chumon %>%
filter(EM < -5) %>%
left_join(sent_chumon, by = "ID") %>%
pull()## [1] "風がどうと吹いてきて、草はざわざわ、木の葉はかさかさ、木はごとんごとんと鳴りました。"
## [2] "ブラシを板の上に置くや否や、そいつがぼうっとかすんで無くなって、風がどうっと室の中に入ってきました。"
## [3] "二人は帽子とオーバーコートを釘にかけ、靴をぬいでぺたぺたあるいて扉の中にはいりました。"
## [4] "二人は壺のクリームを、顔に塗って手に塗ってそれから靴下をぬいで足に塗りました。"
## [5] "なるほど立派な青い瀬戸の塩壺は置いてありましたが、こんどというこんどは二人ともぎょっとしてお互にクリームをたくさん塗った顔を見合せました。"
## [6] "だからさ、西洋料理店というのは、ぼくの考えるところでは、西洋料理を、来た人にたべさせるのではなくて、来た人を西洋料理にして、食べてやる家とこういうことなんだ。"
## [7] "がたがたしながら一人の紳士はうしろの戸を押そうとしましたが、どうです、戸はもう一分も動きませんでした。"
## [8] "奥の方にはまだ一枚扉があって、大きなかぎ穴が二つつき、銀いろのホークとナイフの形が切りだしてあって、"
## [9] "二人はあんまり心を痛めたために、顔がまるでくしゃくしゃの紙屑のようになり、お互にその顔を見合せ、ぶるぶるふるえ、声もなく泣きました。"
## [10] "室はけむりのように消え、二人は寒さにぶるぶるふるえて、草の中に立っていました。"
## [11] "風がどうと吹いてきて、草はざわざわ、木の葉はかさかさ、木はごとんごとんと鳴りました。"
## [12] "そして猟師のもってきた団子をたべ、途中で十円だけ山鳥を買って東京に帰りました。"時系列に文字数を重ねてみる
em_chumon %>%
left_join(sent_chumon, by = "ID") %>%
## 文字数の列を追加
mutate(L = nchar(S)) %>%
ggplot()+
## 分離するためにEM列を5倍する
geom_line(aes(x = ID, y = EM*5), colour = "red")+
geom_line(aes(x = ID, y = L), colour = "blue")+
## y軸左が文長, 右が感情極性値
scale_y_continuous(name = "length",
## ~.がEM列, /5することで軸の値が1/5に狭まる
sec.axis = sec_axis(~ . /5, name = "EM"))