moratoriamuo
2018年10月25日
「怪異・妖怪伝承との衝動遊戯：第１ゲーム」で書いた内容のRのコードと解説です。
R MarkdownでHTMLを作成して、はてなブログのHTML編集にコピペしてます。
ディレクトリについては、上手く調整してください。
スクレイピングで得たデータはoni_youyakuフォルダを作成して保存しています。
スクレイピング
必要なライブラリーの読み込みをする。
library(tidyverse)
library(rvest)
library(magrittr)
library(stringr)
library(XML)データベースの構造を把握するため、オニの一つ目だけ要約を抜き出してみる。
result_oni_1 <- read_html("http://www.nichibun.ac.jp/YoukaiCard/0640010.shtml")
youyaku_table_1 <- result_oni_1 %>% html_table(fill = TRUE)
youyaku_1 <- youyaku_table_1[[11]]$X3[27]
write(youyaku_1, "oni_youyaku_1.txt")YoukaiCardの番号を抜き出せれば、そこだけ変更すればいけそうだと分かる。
result_oni <- read_html("http://www.nichibun.ac.jp/cgi-bin/YoukaiDB2/ksearch.cgi?Name=%E3%82%AA%E3%83%8B&Pref=&Area=%E5%85%A8%E5%9B%BD")
links_oni <- result_oni %>% html_nodes("td") %>% html_nodes('a') %>% html_attr('href')
#YoukaiCardのTRUEorFALSE
#Card_TF <- str_detect(links_oni, pattern = "YoukaiCard")
#links_oni[Card_TF]
#ってやろうとしたけど、これで十分だった
links_oni <- str_subset(links_oni, pattern = "YoukaiCard")
#ここから、/で始まりshtmlで終わるところを抽出したい(うまいやり方が思い付かず位置でごり押し)
str_count("../../YoukaiCard/")
card_shtml <- str_sub(links_oni, start = 18)
#そこから/と.shtmlを削除したデータも作成(後でtxtファイルの名前に使用)
card_num <- str_sub(card_shtml, end = -7)
#ループ処理で使うurl集
url_oni <- str_c("http://www.nichibun.ac.jp/YoukaiCard/", card_shtml)
#長さが一緒であることの確認。件数。
length(card_num)
length(url_oni)これでループ回してスクレイピングしようとしたら、途中で文字化けして止まってしまった。
10番目で止まったので、そこを調べてみると
result_oni_10 <- read_html(url_oni[10])
youyaku_table_10 <- result_oni %>% html_table(fill = TRUE)Error in type.convert.default(out[, i], as.is = TRUE, dec = dec) :
invalid multibyte string at ’
縲竊帝｡樔ｼｼ蜻ｼ遘ｰ
と表示された。 エラーのケースは例外処理するコードを書いた。
for(i in 1:length(url_oni)){
tryCatch(
{
result_oni <- read_html(url_oni[i])
youyaku_table <- result_oni %>% html_table(fill = TRUE)
youyaku <- youyaku_table[[11]]$X3[27]
name <- str_c("oni_youyaku_",card_num[i],".txt")
write(youyaku, name)
Sys.sleep(2)
}
, error = function(e){ERROR_num[i] <- 1
print(i)}
)
}これを回すと496件中105件、エラーしたことが分かった。
原因と対処法が思いつかない。どなたかご教授願いたいです。
代わりに、XMLパッケージのreadHTMLTable()を使ったら、なぜか分からないけど上手くいった。
for(i in 1:length(url_oni)){
tab <- readHTMLTable(url_oni[i])[11] %>% as.data.frame()
youyaku <- tab[27,3] %>% as.character()
name <- str_c("oni_youyaku_",card_num[i],".txt")
write(youyaku, name)
Sys.sleep(2)
}これで各データが入手できた。
全データを結合した文書データも作成しておく。
fnames <- dir(pattern=".txt")
fnames_list <- as.list(fnames)
all_youyaku <- ""
for(file in fnames_list){
all_youyaku <- str_c(all_youyaku,scan(file, what = "char", quiet = TRUE))
}
write(all_youyaku, "all_youyaku.txt")分析
必要なライブラリーの読み込みをする。
library(RMeCab)
library(tidyverse)
library(stringr)
library(wordcloud)
library(tm)
library(topicmodels)
library(ldatuning)頻度集計
オニ全体の特徴を掴むためにデータ全体で頻度集計。
oni_all_freq <- RMeCabFreq("oni_youyaku/all_youyaku.txt")oni_all_freqD <- oni_all_freq[order(oni_all_freq$Freq, decreasing = TRUE),] %>%
as.data.frame()自立語(動詞・形容詞・形容動詞)の頻度集計
oni_all_jiritu_freq <- oni_all_freqD %>% filter(Info2=="自立")
freq_dt <- oni_all_jiritu_freq %>% head(30) %>% as.data.frame() %>% select(Term,Freq) %>% t()
freq_dt## 1 2 3 4 5 6 7 8 9
## Term "する" "いう" "なる" "ある" "来る" "言う" "出る" "いる" "食べる"
## Freq "431" "255" "157" "154" " 85" " 77" " 69" " 59" " 58"
## 10 11 12 13 14 15 16 17 18
## Term "逃げる" "行く" "住む" "食う" "死ぬ" "入る" "作る" "入れる" "取る"
## Freq " 58" " 44" " 41" " 41" " 40" " 40" " 32" " 31" " 29"
## 19 20 21 22 23 24 25 26 27
## Term "見る" "ない" "殺す" "帰る" "聞く" "くる" "つく" "呼ぶ" "持つ"
## Freq " 27" " 26" " 24" " 23" " 23" " 22" " 22" " 21" " 21"
## 28 29 30
## Term "現れる" "さらう" "つける"
## Freq " 19" " 18" " 18"名詞の頻度集計
oni_all_noun_freq <- oni_all_freqD %>% filter(Info1=="名詞")
freq_noun_dt <- oni_all_noun_freq %>% head(30) %>% as.data.frame() %>% select(Term,Freq) %>% t()
freq_noun_dt## 1 2 3 4 5 6 7 8 9 10
## Term "鬼" "家" "の" "昔" "人" "日" "退治" "こと" "よう" "節分"
## Freq "938" "100" "100" " 87" " 86" " 78" " 77" " 75" " 68" " 64"
## 11 12 13 14 15 16 17 18 19 20
## Term "それ" "これ" "ところ" "男" "とき" "夜" "もの" "娘" "人" "時"
## Freq " 60" " 58" " 57" " 56" " 52" " 52" " 51" " 48" " 48" " 48"
## 21 22 23 24 25 26 27 28 29 30
## Term "豆" "山" "目" "月" "ため" "正月" "首" "石" "姿" "菖蒲"
## Freq " 47" " 46" " 46" " 42" " 40" " 39" " 37" " 34" " 33" " 31"ワードクラウド
wordcloudで可視化
corpus_oni <- docDF("oni_youyaku/all_youyaku.txt", type = 1)警告がめっちゃ出たけど、結果は出た。何の警告は調べず放置してしまいました。
ワードクラウドの出力は乱数で変わっていると思われる。
options(warn=-1)
corpus_oni <- corpus_oni %>% filter(POS1 == "名詞"&POS2=="一般"| POS2 == "自立")
wordcloud(corpus_oni$TERM, corpus_oni$all_youyaku.txt, min.freq= 15, scale=c(15,0.5),
family ="JP1", random.color=FALSE, color = rainbow(5))
options(warn=0)トピックモデル
複数文書の読み込んで、文書ターム行列を作成する。
#フォルダのパス
dir_youyaku <- "oni_youyaku"
DTM <- docDF(dir_youyaku, type = 1)名詞(一般)と動詞を抽出し、トピックモデルを実行する。
DTM_nouns_verbs <- DTM %>% filter( (POS1 == "名詞"&POS2 == "一般") | POS2 == "動詞" )%>%
select(-c(POS1,POS2)) %>%
data.frame(row.names = 1) %>% t() %>%
as.DocumentTermMatrix(weighting = weightTf)トピック数を何パターンかやってみて、直感で決定した。
これも乱数依存の結果なので、第１ゲームと結果が異なる。(set.seed()しとくべきだった。)
#トピック数をkとする。
k <- 3
lda_result <- LDA(DTM_nouns_verbs,k)
terms(lda_result,10)
k <- 4
lda_result <- LDA(DTM_nouns_verbs,k)
terms(lda_result,10)
k <- 10
lda_result <- LDA(DTM_nouns_verbs,k)
topic10_nv <- terms(lda_result,10) %>% as.data.frame()
k <- 20
lda_result <- LDA(DTM_nouns_verbs,k)
topic_nv20 <- terms(lda_result,10) %>% as.data.frame()
k <- 30
lda_result <- LDA(DTM_nouns_verbs,k)
topic30_nv <- terms(lda_result,10) %>% as.data.frame()k <- 30
lda_result <- LDA(DTM_nouns_verbs,k)
topic30_nv <- terms(lda_result,10) %>% as.data.frame()
topic30_nv## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5 Topic 6 Topic 7 Topic 8
## 1 鬼 家 鬼 鬼 鬼 鬼 鬼 鬼
## 2 腕 鬼 橋 節分 剣 団子 神様 地蔵
## 3 綱 村 夫 頭 戸 土 山 爺
## 4 破風 宿 気 戸口 瘤 矢 場所 手
## 5 家 僧 妻 豆 人々 殿様 川 人形
## 6 姓 娘 神 柊 篩 足 弓 金
## 7 子孫 木 死体 月 手 背 嘘 赤
## 8 ケムダシ 旅人 弓矢 目 青 囲炉裏 涙 字
## 9 先祖 兄弟 鬼神 鰯 一つ 武士 お婆さん 銭
## 10 外 村人 悪鬼 イワシ 里 山 瓶 博打
## Topic 9 Topic 10 Topic 11 Topic 12 Topic 13 Topic 14 Topic 15 Topic 16
## 1 鬼 月 鬼 鬼 鬼 鬼 男 目
## 2 血 鬼 人 菖蒲 地獄 女 鬼 鬼
## 3 灰 餅 行者 娘 人 火 姿 弟
## 4 弓 若者 島 蓬 田 釜 女 籠
## 5 山 図 竹 節句 地 山姥 地蔵 人
## 6 バラ 金 門松 節供 地名 家 池 姉
## 7 尻 神様 赤 ヨモギ 狂言 牛 木 心
## 8 矢 婆 妻 屋根 罪人 蜘蛛 塩 兄
## 9 ひと 宿 青 家 盆 馬方 馬 ススキ
## 10 土 餓鬼 正月 雨 寺 爺 尊 小僧
## Topic 17 Topic 18 Topic 19 Topic 20 Topic 21 Topic 22 Topic 23
## 1 鬼 鬼 鬼 鬼 豆 鬼 鬼
## 2 酒 目玉 子供 芽 節分 森 首
## 3 童子 丸 山 上人 鬼 首 寺
## 4 呑 箒 お爺さん 神さま 子 木 村人
## 5 力 魔 集落 おじいさん 家 蛭 興
## 6 神社 姿 谷 牙 晩 里人 勅命
## 7 ヶ 箕 船 舟 川下 村 粥
## 8 首 人間 宝物 川 数 跡 念
## 9 ゾウリ ショウブ 髪 モグラ 年 下 天
## 10 坂 臭い 沖 息子 まき 比べ オオモ
## Topic 24 Topic 25 Topic 26 Topic 27 Topic 28 Topic 29 Topic 30
## 1 鬼 鬼 鬼 鬼 鬼 鬼 嫁
## 2 鶏 歯 石 人 年 正月 助
## 3 爺さん 穴 岩 娘 島 骨 鬼
## 4 鳴き 飯 跡 家 角 外 娘
## 5 正体 下 血 妹 怪物 部落 山鳥
## 6 女房 山 伝説 底 亥 福 尾
## 7 隣 鬼面 川 山 部落 内 矢
## 8 博打 柄杓 狐 籠 男子 松 土蔵
## 9 箕 様子 U 金 勘 節分 将軍
## 10 金 婆さん 主人 継母 由 家々 神酒