RでWebスクレイピングしたい
背景
ちょっとした用事によりリコール情報について調査する機会がありました。これまでWebスクレイピングは経験がなかったのですが、便利なライブラリ（{rvest}）もあることだし、挑戦してみた結果を紹介します。 内容としては、国交省のサイトにある「リコール情報検索」（こちら）からリコールデータを取得し、テキストマイニングにかけた、というものです。
分析の進め方
分析の進め方は以下の通りです：
特別なことはしておらず、サイトのページ構成に合わせて必要なデータを取得し、可視化などを行います。
１．サイトのページ構成を把握
ここは、Rではなくブラウザの機能を使いました。例えばこの辺りの記事を参考に、Google Chromeのデベロッパーツールでhtmlの構成を把握しました。
２．構成にマッチするようにループを組んでrvest::read_htmlで順次読み込み
ライブラリのインストール
ここからがRによる処理となります。まずは必要なライブラリをインストールして読み込みます。今回新しくインストールしたライブラリは以下の通りで、RMecabはこちらの記事を参考にMecabのインストールから行いました。以下は、Mecabのインストールが終わっている前提です。
install.packages("rvest") install.packages("RMeCab", repos = "http://rmecab.jp/R") install.packages("wordcloud")
ライブラリの読み込み
インストールしたライブラリ以外に、{dplyr}や{tidyr}などの定番ライブラリ、またテキストデータを扱うので{stringr}や{stringi}なども読み込んでいます。
library(rvest) library(dplyr) library(tidyr) library(stringr) library(stringi) library(RMeCab) library(ggplot2) library(wordcloud)
{RMecab}のお試し
ここで少し{RMecab}を使ってみましょう。こんな使い方ができます。
res <- RMeCabC("すもももももももものうち") > unlist (res) 名詞 助詞 名詞 助詞 名詞 助詞 名詞 "すもも" "も" "もも" "も" "もも" "の" "うち"
{rvest}のお試し
同じく{rvest}も試してみます。read_htmlで指定したURLのページ構成をごそっと取ってきてくれます。
source_url <- "http://carinf.mlit.go.jp/jidosha/carinf/ris/search.html?selCarTp=1&lstCarNo=1060&txtMdlNm=&txtFrDat=2000/01/01&txtToDat=2017/12/31&page=1" recall_html <- read_html(source_url, encoding = "UTF-8")
取ってきたデータの中身を確認するためには、例えば以下のようにします：
> recall_html %>% + html_nodes("body") %>% # HTMLのbodyタグの情報を取り出す + html_text() # テキストデータを取り出す [1] "\n\n\n \n \n \n \n \n \n \n \n \n \n \n \n トップページ>リコール情報検索>リコール届出情報一覧\n \n \n \n \n \n \n リコール届出情報一覧\n ご利用のブラウザはJavaScriptまたはCookieが無効に設定されています。設定を確認して再度アクセスしてください。\n \n\n\n\n\n \n 90件のデータがヒットしました\n \n \n 5 / 5 ページ\n \n 番号\n 届出番号\n 届出日\n 通称名\n 81\n リ 国-3988-0\n 2017/02/02\n [リバティ]\n 82\n リ 国-3988-0\n 2017/02/02\n [ブルーバードシルフィ]\n 83\n リ 国-3988-0\n 2017/02/02\n [キャラバン]\n 84\n 改 国-0513-0\n 2017/01/27\n [デイズ]\n 85\n 改 国-0513-0\n 2017/01/27\n [デイズ ルークス]\n 86\n リ 国-3944-1\n 2017/01/27\n [デイズ]\n 87\n リ 国-3944-1\n 2017/01/27\n [デイズ ルークス]\n 88\n リ 国-3944-2\n 2017/01/27\n [デイズ]\n 89\n リ 国-3944-2\n 2017/01/27\n [デイズ ルークス]\n 90\n リ 国-3977-0\n 2017/01/27\n [セレナ]\n \n \n\n \n \n \n \n\n\t \n\n \n \n\n\n\n \n \n \n \n \n \n \n \n トップページ\n 自動車のリコール制度について\n リコール情報検索\n リコール届出情報一覧\n 自動車不具合情報ホットライン\n 不具合情報検索\n 事故・火災情報検索\n よくあるお問い合わせ\n 公表資料\n 自動車を安全に使うためには\n 利用規約等\n バナーダウンロード\n \n \n \n \n \n\n\n Copyright © 2001-myDate = new Date() ;myYear = myDate.getFullYear();document.write(myYear); Ministry of Land, Infrastructure, Transport and Tourism All rights reserved.\n\n\n\n\n(function(){\n var p = ((\"https:\" == document.location.protocol) ? \"https://\" : \"http://\"), r=Math.round(Math.random() * 10000000), rf = window.top.location.href, prf = window.top.document.referrer;\n document.write(unescape('%3C')+'img src=\"'+ p + 'acq-3pas.admatrix.jp/if/5/01/7b9f970b303989123e334299f50a384a.fs?cb=' + encodeURIComponent(r) + '&rf=' + encodeURIComponent(rf) +'&prf=' + encodeURIComponent(prf) + '\" alt=\"\" width=\"1\" height=\"1\" '+unescape('%2F%3E'));\n})();\n\n\n\n\nnew Image(1, 1).src=\"//data-dsp.ad-m.asia/dsp/api/mark/?m=323gb&c=bcMR&cb=\" + Math.floor(new Date().getTime() / 86400);\n\n (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){\n (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),\n m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)\n })(window,document,'script','//www.google-analytics.com/analytics.js','ga');\n\n ga('create', 'UA-52116336-5',{'allowLinker': true});\n ga('require','linker');\n ga('linker:autoLink',['destination']);\n ga('require','displayfeatures');\n ga('send', 'pageview');\n\n"
またページの全てのtableのテキストを取り出す時はこのようになります：
> recall_html %>% + html_nodes(xpath="//table") %>% + html_text() [1] "番号\n 届出番号\n 届出日\n 通称名\n 81\n リ 国-3988-0\n 2017/02/02\n [リバティ]\n 82\n リ 国-3988-0\n 2017/02/02\n [ブルーバードシルフィ]\n 83\n リ 国-3988-0\n 2017/02/02\n [キャラバン]\n 84\n 改 国-0513-0\n 2017/01/27\n [デイズ]\n 85\n 改 国-0513-0\n 2017/01/27\n [デイズ ルークス]\n 86\n リ 国-3944-1\n 2017/01/27\n [デイズ]\n 87\n リ 国-3944-1\n 2017/01/27\n [デイズ ルークス]\n 88\n リ 国-3944-2\n 2017/01/27\n [デイズ]\n 89\n リ 国-3944-2\n 2017/01/27\n [デイズ ルークス]\n 90\n リ 国-3977-0\n 2017/01/27\n [セレナ]\n "
本番
それではここからが本番です。まずは対象となるページと、したいことが何であるかを確認しておきましょう。
こちらが今回の分析対象となるページです。この検索条件として例えば車名を「ニッサン」、届出日を「2017/01/01」〜「2017/12/31」としてみましょう。
このように条件に合致したリコール情報を一覧表示してくれます。例えば１個目をクリックすると、
リコール情報の詳細について知ることができます。このうち、上段の表にある「車名/メーカー名」や「不具合装置」、「対象台数」などを取得したいのですが、リンクを一つずつ辿ってコピーしてくるのは大変なので、スクリプトを書いて情報を取ってきたい、というのが今回の取り組みです。
スクリプトの大まかな内容としては、
- 検索結果の画面から、各リコールの詳細結果画面へのURLを取得する
- 取得したURLに順次アクセスし、必要な情報を取り出してまとめる
- 次のページに移動し、繰り返し
という感じになります。
3についてですが、幸いなことに1の検索結果URLは、次ページを確認すると末尾が「page=2」となっています。ここから元のページに戻ると「page=1」となっており、数値を変更するだけで任意のページに行けそうなので、検索結果のページ数（今回は5）だけメモしておけばループで回せそうです。 また、各リコールの詳細結果画面についてはURLが「http://carinf.mlit.go.jp/jidosha/carinf/ris/detail/1141591.html」 のようになっており、末尾の「数字7桁」を変えていけば良さそうです。
というわけで、以下のように検索結果と各リコールの詳細結果画面のURLについて、変更がない部分を定義しておきます。
src_url <- "http://carinf.mlit.go.jp/jidosha/carinf/ris/search.html?selCarTp=1&lstCarNo=1060&txtMdlNm=&txtFrDat=2017/01/01&txtToDat=2017/12/31&page=" link_url <- "http://carinf.mlit.go.jp/jidosha/carinf/ris/"
また分析に用いる項目を以下の5つとし、結果の格納用のデータフレームを準備しておきます。
target_column <- c("車名/メーカー名", "不具合装置", "状 況", "リコール開始日", "対象台数") html_tbl_all <- data_frame()
以下、リコール情報を順次取得していきます。スクリプトの流れのセクションで書いたように、検索結果の画面のページを変えつつ、各リコールの詳細結果画面へのURLを取得し、read_htmlでデータを取り出していきます。
下のスクリプトでtarget_url_listをsapplyすればもっと早くなるかもしれませんが、今回はパフォーマンスを求めたい訳ではないので素直にLoopを回しました。
st <- Sys.time() ## iはページ数。事前にメモしておく。今回は5 for (i in 1:5) { ## 検索結果の各ページのURLを指定し、データを取得 target_page <- paste0(src_url, i) recall_html <- read_html(target_page, encoding = "UTF-8") ## 検索結果画面から、各リコール詳細結果へのURLを取得 target_url_list <- recall_html %>% html_nodes(xpath = "//a") %>% # aタグに格納されている html_attr("href") %>% # href属性のデータを取り出す as_data_frame() %>% filter(grepl("detail", .$value)) # 詳細結果は"detail" + 数字7桁 + .htmlで構成されている ## 詳細結果の数 l <- nrow(target_url_list) ## ここから各詳細結果へアクセスし、データを取得する for (j in 1:l) { ## アクセス負荷を軽減するため、少し間を置く Sys.sleep(2) ## 詳細結果へのURLを指定し、データを取得 target_url <- paste0(link_url, target_url_list$value[j]) recall_html_tmp <- read_html(target_url) html_tbl_tmp <- html_table(recall_html_tmp)[[1]] ## 上段のテーブルのデータを取得 ## ４列あるが、1・3列目に項目名が、2・4列目にデータが入っているので、2列のデータに直す html_tbl <- html_tbl_tmp %>% filter(X1 %in% target_column) %>% ## 必要な情報を抽出 rename("Term" = X1, "Value" = X2) %>% select(Term, Value) %>% bind_rows( html_tbl_tmp %>% filter(X3 %in% target_column) %>% rename("Term" = X3, "Value" = X4) %>% select(Term, Value)) %>% spread(Term, Value) ## 順次追加していけるよう、wideに変換 ## データを追加 html_tbl_all <- bind_rows(html_tbl_all, html_tbl) } }
> Sys.time() - st Time difference of 9.495965 mins
このスクリプトでは一年分の日産のデータを取得するのに、私の環境で約10分かかりました。結構時間がかかるので、データを保存しておきます。
save(html_tbl_all, file = "Recall_Data.Rdata")
３．取得したテキストデータをMecabで形態素解析
ではこれ以降、取得したデータで分析を行います。と言ってもMecabによる形態素解析を掛けた後は集計して可視化するぐらいのものです。その前にデータを確認してみましょう。検索結果では90件と表示されていましたが、ちゃんと取れているでしょうか。
> dim(html_tbl_all) [1] 90 5
大丈夫なようですね。データも見てみましょう。
> head(html_tbl_all) # A tibble: 6 x 6 リコール開始日 `車名/メーカー名` `状 況` 対象台数 不具合装置 Num <chr> <chr> <chr> <chr> <chr> <dbl> 1 2017年12月14日 いすゞ ① 電源電圧が１２Ｖのテールゲートリフタ装着車の後部反射器において、選定が不適切なため、反射… 1,153台 その他(保安灯火)… 1153 2 2017年12月14日 いすゞ ② 電源電圧が２４Ｖのテールゲートリフタ装着車の後部反射器及び後退灯において、選定が不適切な… 162台 後退灯 162 3 2017年12月15日 ニッサン 電源分配器の基板において、回路基板の製造時に不要な半田が付着した状態で防湿材がコーティングさ… 316,759… その他(電気装置)… 316759 4 2017年12月15日 ニッサン 電源分配器の基板において、回路基板の製造時に不要な半田が付着した状態で防湿材がコーティングさ… 316,759… その他(電気装置)… 316759 5 2017年12月15日 ニッサン 電源分配器の基板において、回路基板の製造時に不要な半田が付着した状態で防湿材がコーティングさ… 316,759… その他(電気装置)… 316759 6 2017年12月01日 いすゞ 小型トラックの燃料噴射装置において、サプライポンプをエンジンに締結する取付けボルトの締付トル… 83,591台 エンジン一般… 83591
「車名」を確認すると一部にニッサン以外が含まれていますね。しかし当該の詳細結果を確認すると「いすゞ」とともに「ニッサン」がリコール対象となっており、間違いではないようです。
また「状況」を確認すると、全く同じ文言が同じ日付で出ています。これは、このリコールの届出が車種別に行われているためであり、例えば「2017年12月15日」の例では、「セレナ」「キューブ」「バネット」で同じ理由によりリコールの届出があったようです。本来この後の形態素解析では、これらのテキストを集約するべきでしょう（今回はお試しなのでやりませんが）。
分析対象となる部分を取り出す
さて、今回形態素解析の対象としたいテキストデータは「状 況」です。RMecabではテキストファイルからデータを読み込んで処理するので、テキストとして書き出しておきましょう。
load("Recall_Data.Rdata") ## 必要なら txt_defect_situation <- html_tbl_all$`状 況` write.csv(txt_defect_situation, file = "Situation.csv")
読み込み
書き出したテキストファイルを以下のように読み込みます。
txt_situ <- RMeCabFreq("Situation.csv")
全部で529個の単語に分割されたようです。
データ加工
テキストデータはMecabによって形態素解析され、単語ごとに分割された上で品詞を割り当てられています。このうち、単語抽出の対象となりそうなものだけを使用します。今回は名詞の頻度を確認します。
Noun_res_situ <- txt_situ %>% filter(Info1 == "名詞") %>% filter(!Info2 %in% c("非自立", "代名詞")) %>% group_by(Term, Info1) %>% summarise("TF" = sum(Freq)) %>% ungroup() %>% arrange(desc(TF)) %>% mutate(Pos = factor(Term, levels = .$Term))
上のスクリプトで最後にfactorにしているのは、グラフにする時に単語の並び順ではなく頻度で表示するためです。
４．可視化
では加工済みのデータを用いて単語の頻度を可視化してみましょう。まずは棒グラフですが、単語の数が多いので上位20個に限定しています。なおMacの場合、日本語が表示されない可能性があります（私は表示されませんでした）。その場合、下記のページが参考になると思います。私は下記を全て実行したところ表示できるようになりました：
- http://blog.0093.tv/2011/05/rstudio-for-mac-os-x.html
- https://ameblo.jp/mojio914/entry-12030044452.html
- https://www.karada-good.net/analyticsr/r-58
ggplot(Noun_res_situ[1:20, ], aes(x = Pos, y = TF)) + geom_bar(stat = "Identity") + theme_bw(base_family = "HiraKakuProN-W3")
「"」や「","」のような変な単語(?)が混ざっていますね。これは流石に格好悪いので除いておきます。
Noun_res_situ %>% filter(!Term %in% c("\"", "\",\"")) %>% slice(1:20) %>% ggplot(., aes(x = Pos, y = TF)) + geom_bar(stat = "Identity") + theme_classic(base_family = "HiraKakuProN-W3")
なるほど、なんかそれっぽい単語が抽出されていますね〜。しかし、実際のテキストを見ていると、例えば「検査」という単語は「完成検査」という熟語として使われることが多いなど、ドメイン特有の表現があったりします。そういった特有の表現を集めた辞書がないと、こういった単語抽出はあまり効果的でなかったりします。
続いてWordcloudを作成してみます。ここでも単語の数が多いので絞ろうと思うのですが、個数ではなく出現頻度でfilterしましょう。TFが4以上の単語を抽出すると、以下のようになります。
Noun_res_situ_4 <- Noun_res_situ %>% filter(!Term %in% c("\"", "\",\"")) %>% filter(TF >= 4) par(family = "HiraKakuProN-W3") wordcloud(Noun_res_situ_4$Term, Noun_res_situ_4$TF, random.color = TRUE, colors = rainbow(10))
５．おまけ
以上でやりたかったことは終わりなのですが、最後におまけでリコール総台数の確認をしてみます。「対象台数」列に入っている数値を集計したいのですが、文字列として入力されているので修正します。
html_tbl_all$Num <- html_tbl_all$対象台数 html_tbl_all$Num <- str_replace_all(html_tbl_all$Num, ",", "") html_tbl_all$Num <- str_replace_all(html_tbl_all$Num, "台", "") html_tbl_all$Num <- as.numeric(html_tbl_all$Num) ggplot(html_tbl_all, aes(x = Num)) + geom_histogram() + theme_classic()
最後に
というわけで今回は{rvest}を用いたWebスクレイピングに挑戦しました。read_htmlで簡単にWebサイトのデータを取得することができ、html_text()やhtml_table()で簡単に加工することが可能なため、初めての挑戦ではあったものの大きな引っかかりもなく進めることができました。今まで何となく敬遠していたのですが、積極的に使っていきたい技術ですね。
