niszetの日記

細かい情報を載せていくブログ

(R)気象庁の震源リストからスクレイピング(コード一部更新した)

robots.txt とかも自分で一度は目を通しておこうね。

さて、以前の日記で気象庁の各日の震源データが消えていると思ったら見つかりました~ってのを書きました。

niszet.hatenablog.com

今回はそのページからデータを取ってくる作業をします。手作業でも良いかなと思ったらこれは日毎にページが分かれているわけですね~。流石にこれを手でやるのはちょっとシンドイので、久々にスクレイピングでやっつけます。

丁度良いことに、昨年末のJapan.R 2020にてwatagusaさんのLT、「"polite"で守るWebスクレイピングのエチケット」でpoliteパッケージの存在を知ったので、これを参考にしてやってみました。

Japan.Rのページはこちら

japanr.connpass.com

また、LTの内容ついてはwatagusaさんのブログにまとまってます。

watagusa.hatenablog.com

とりあえず先にコードを書いてしまうと、2016年の1年間のデータを取ってきて整形してdata.frameにして最後にcsvに書き出すコードは下記のようになります(1/14 1900更新)。

library(rvest)
library(xml2)
library(polite)
library(lubridate)
library(stringr)
library(dplyr)
library(magrittr)

trg <- lubridate::ymd("2016/1/1")
df <- data.frame()

session <- polite::bow(url=stringr::str_c("https://www.data.jma.go.jp/svd/eqev/data/daily_map/", sprintf("%04d%02d%02d", lubridate::year(trg), lubridate::month(trg), lubridate::day(trg)) ,".html"), delay=5)

while(trg < lubridate::ymd("2017/1/1")){

  session <- polite::nod(bow=session, path= stringr::str_c("https://www.data.jma.go.jp/svd/eqev/data/daily_map/", sprintf("%04d%02d%02d", lubridate::year(trg), lubridate::month(trg), lubridate::day(trg)) ,".html"))

  page <- polite::scrape(session)
  page %>% rvest::html_node(xpath = "/html/body/div[2]/div") %>%
    rvest::html_node("pre") %>% rvest::html_text() %>%
    readr::read_lines(skip_empty_rows = T, skip=3) %>%
    stringr::str_replace_all("° ", "°") %>%
    stringr::str_trim() %>%
    readr::read_delim(" ", col_names = F, trim_ws = T) %>%
    dplyr::bind_rows(df, .) -> df
  trg <- trg + 1
}

colnames(df) <- c("年", "月", "日", "時:分", "秒", "緯度", "経度", "深さ(km)", "M", "震央地名")

readr::write_csv(df, "2016.csv")

蛇足

以下、コードの補足。コピペでいいや~って人は読み飛ばしてどうぞ。

library()を先頭に書いているのでライブラリ名::関数名にする必要はないですが、どの関数がどのパッケージ由来かわからんくなるので書いてます。 ymd()を使っているのは日付の管理が面倒くさいので。trg <- trg + 1で日付を1日分進めています。これで2017/1/1以前の日について処理が回るというwhileループになっとります。 そもそも、URLがyyyymmddであるからそうなってますが。1月の場合に"01"としたい場合(0で埋めたい)場合はsprintf("%02d", day)みたいに書くのが一番楽だと思ってますが、今風の書き方はあるのかしら? politeの使い方はLTの資料とブログ記事を見てもらうとして、対象のデータがどこのタグにいるのかはブラウザの開発者ツールつかって掘っていく感じですね。この構造が未来永劫保たれているとも限らないし、他の年では違うかもしれないので注意。 readr::read_delim()ではなくreadr::read_lines()を使ってるのは後述するように変なところに空白があり、デリミタの指定で空白文字を使うと列がずれるため。とりあえず一旦読み込んで行ごとのデータにしたいならread_lines()が便利。最初の3行を取り込むと変なことになるのでskipし、列名はあとでつけるようにしています。 緯度経度でたまに一桁の数字があると表示位置のあわせでスペースを一個入れているようです。こういう目印になる文字がある場合は一緒に検出して置き換えればよいので楽。分かりづらいですが、"°"(度)の後に空白がある場合に"°"だけにしてスペースを取り除いています。2文字以上ある場合は対応しきれないので、[ ]+とかで検出かな。 stringr::str_trim()は各行末に位置合わせで空白文字があり、これが空列として追加されるのを防ぐ。 readr::read_delim()でスペースを区切り文字として読み取る。列名は不要。trim_wsで取り込み後に空白文字が残らないようになる。これをしないと、列の位置合わせで1月などは" 1"となっているため型が文字列になってしまう。10月は10なのでintegerと判断してくれる。そして型が合わずにbind_rowsで怒られる。 dplyr::bind_rows(df, .)は時系列順にしたいならこの順で。後でソートしても良いけど。 列名は"時:分"はオリジナルの列名とは異なるので、ここで与えている。決め打ちで良いところは決め打ちにしてしまう…。 最後にcsvに書き出してオシマイ。

使った感じ、politeパッケージは色々と面倒を見てくれるので便利ですね。Rでスクレイピングするなら今後は必ず使う方が良いんじゃないかなと思いました。watagusaさんありがとうございます。

rvestを使ったスクレイピングについてはほぼノー説明にしましたが、困ってる場合はRによるスクレイピング入門がおすすめですね。

www.c-r.com

lubridateパッケージについては書籍はないですが、ネット上に解説もあるので今回程度の使い方なら困ることはないでしょう(知らんけど)。

qiita.com

kazutan.github.io

さいごに

なんか変じゃねこれみたいなのあったら教えてくだされ~~

追記

nod使ってないじゃん!って気づいたので修正しました。修正前のコードも載せておきます(恥) nod使って何度もアクセスしないようにしようねって書いてあったのに、勢いで実装するとこうなるのだ…。気を付けよう。

library(rvest)
library(xml2)
library(polite)
library(lubridate)
library(stringr)
library(dplyr)
library(magrittr)

trg <- lubridate::ymd("2016/1/1")
df <- data.frame()

while(trg < lubridate::ymd("2017/1/1")){

  session <- polite::bow(url=stringr::str_c("https://www.data.jma.go.jp/svd/eqev/data/daily_map/", sprintf("%04d%02d%02d", lubridate::year(trg), lubridate::month(trg), lubridate::day(trg)) ,".html"), delay=5)

  page <- polite::scrape(session)
  page %>% rvest::html_node(xpath = "/html/body/div[2]/div") %>%
    rvest::html_node("pre") %>% rvest::html_text() %>%
    readr::read_lines(skip_empty_rows = T, skip=3) %>%
    stringr::str_replace_all("° ", "°") %>%
    stringr::str_trim() %>%
    readr::read_delim(" ", col_names = F, trim_ws = T) %>%
    dplyr::bind_rows(df, .) -> df
  trg <- trg + 1
}

colnames(df) <- c("年", "月", "日", "時:分", "秒", "緯度", "経度", "深さ(km)", "M", "震央地名")

readr::write_csv(df, "2016.csv")