台風22号と23号

台風の情報をRで描く

その5、22号と23号です。前回からの変更点は図の下に書いてます:

前回からの変更点

台風が2つあるので、それぞれに別々のデータ(idによってフィルタしたデータ)を割り当ててグループに割り当てる。これにより2系統であってもそれぞれに軌跡(addPolyline)を当てることが可能になった
レイヤーグループを設定したので、グループごとに表示/非表示のコントロールを設置
rvest::htmlがdeprecatedと警告がでたので、read_htmlに変更
色を変更。塗りつぶしの透明度で中心気圧を表現しているけど、現状いまいちなのでどうやるか思案中。

感想

やっとレイヤーグループが使えるようになったのと、レイヤーごとにデータを差し替える方法を見つけたので非常に満足です。このあたりはggplot2の感覚とかなり近いので助かりました。これで相当自由度がアップしたので、色々試したいです。

参考

以下説明(前回と同様)。

この内容は、気象庁の台風情報を、ある時点において取得して、そのまま図示するための一連のコードを実行しています。基本は私の練習のためです。

詳しい情報、および速報については、上記リンクで必ず確認してください。

基本的な流れ

データの取得

{rvest}を用いて上記Webページより必要なデータをスクレイピングします。

データの処理

この後{leaflet}にて描画するために、データを処理します。未熟なため非常に汚く効率が悪いです。だれか教えてください。

描画

{leaflet}にてプロットします。また必要に応じて事前にいくつかデータを準備してます。

コード

必要なパッケージをインストールして実行すれば再現できます。ただし、実行時の時刻でデータを取得しますので、台風の中心位置は再現されません。

# 台風情報
library("dplyr")
library("rvest")
library("stringr")
library("leaflet")

trg <- read_html("http://www.jma.go.jp/jp/typh/") %>% html_table
tbl22 <- trg[[4]] # テーブルは4番目が台風22号
res22 <- data.frame(
  timing = tbl22$X1 %>% str_subset("[0-9][0-9]日[0-9][0-9]時"),
  lat = tbl22$X2 %>% 
    str_subset("北緯") %>%
    str_extract("[0-9][0-9]\\.[0-9]度") %>%
    str_replace("度","") %>%
    as.numeric,
  lon = tbl22$X2 %>%
    str_subset("東経") %>%
    str_extract("[0-9][0-9][0-9]\\.[0-9]度") %>%
    str_replace("度","") %>%
    as.numeric,
  hpa = tbl22$X2 %>% 
    str_subset("hPa") %>% 
    str_replace("hPa","") %>% 
    as.numeric,
  c_wspeed = tbl22 %>% 
    dplyr::filter(X1 == "中心付近の最大風速"| X1 == "最大風速") %>% 
    dplyr::select(X2) %>% 
    dplyr::rename(c_wspeed=X2),
  m_wspeed = tbl22 %>% 
    dplyr::filter(X1 == "最大瞬間風速") %>% 
    dplyr::select(X2) %>% 
    dplyr::rename(m_wspeed=X2)
)

tbl23 <- trg[[5]] # テーブルは4番目が台風23号
res23 <- data.frame(
  timing = tbl23$X1 %>% str_subset("[0-9][0-9]日[0-9][0-9]時"),
  lat = tbl23$X2 %>% 
    str_subset("北緯") %>%
    str_extract("[0-9][0-9]\\.[0-9]度") %>%
    str_replace("度","") %>%
    as.numeric,
  lon = tbl23$X2 %>%
    str_subset("東経") %>%
    str_extract("[0-9][0-9][0-9]\\.[0-9]度") %>%
    str_replace("度","") %>%
    as.numeric,
  hpa = tbl23$X2 %>% 
    str_subset("hPa") %>% 
    str_replace("hPa","") %>% 
    as.numeric,
  c_wspeed = tbl23 %>% 
    dplyr::filter(X1 == "中心付近の最大風速"| X1 == "最大風速") %>% 
    dplyr::select(X2) %>% 
    dplyr::rename(c_wspeed=X2),
  m_wspeed = tbl23 %>% 
    dplyr::filter(X1 == "最大瞬間風速") %>% 
    dplyr::select(X2) %>% 
    dplyr::rename(m_wspeed=X2)
)

# 2つの台風データを結合
res <- bind_rows(list(res22=res22,res23=res23),.id = "id")

## Warning in rbind_all(x, .id): Unequal factor levels: coercing to character

res$id <- gsub("res22","台風22号", res$id)
res$id <- gsub("res23","台風23号", res$id)

# 取得した台風20号のデータを表示
knitr::kable(res)

id	timing	lat	lon	hpa	c_wspeed	m_wspeed
台風22号	<02日21時の実況>	17.1	117.8	990	23m/s(45kt)	35m/s(65kt)
台風22号	<03日09時の予報>	18.2	115.9	985	25m/s(50kt)	35m/s(70kt)
台風22号	<03日21時の予報>	19.3	113.8	975	30m/s(60kt)	45m/s(85kt)
台風22号	<04日21時の予報>	21.0	110.7	970	35m/s(65kt)	50m/s(95kt)
台風22号	<05日21時の予報>	22.7	108.5	985	25m/s(50kt)	35m/s(70kt)
台風23号	<02日21時の実況>	19.0	166.6	996	18m/s(35kt)	25m/s(50kt)
台風23号	<03日21時の予報>	19.7	162.9	990	23m/s(45kt)	35m/s(65kt)
台風23号	<04日21時の予報>	20.8	157.5	985	25m/s(50kt)	35m/s(70kt)
台風23号	<05日21時の予報>	22.5	151.8	975	30m/s(60kt)	45m/s(85kt)

## leafletで描写
# カラーパレット作成
colpal <- colorNumeric(palette = grDevices::heat.colors(n=80), domain = c(930,1000))
pal <- colorFactor(c("darkgreen","darkblue"),domain=c("台風22号","台風23号"))
# ポップアップ作成
res <- dplyr::mutate(res, popup = paste(timing,paste("中心気圧",hpa, "hPa"),paste("最大風速",c_wspeed),paste("瞬間最大風速",m_wspeed),sep = "<br/>"))
# 説明用テキスト
text <- paste(paste(Sys.time(),"時点の情報です"),"点をクリックすると情報が出ます","詳細は<a href='http://www.jma.go.jp/jp/typh/'>気象庁の台風情報</a>を確認ください。",sep = "<br/>")

m <- leaflet::leaflet(res) %>% 
  addTiles() %>% 
  setView(lng = 139.0000, lat = 35.0000, zoom = 3) %>% 
  addCircleMarkers(
    ~lon, ~lat, group = "台風22号", data = dplyr::filter(.data=res, id=="台風22号"),
    radius = 10, weight = 2,
    fillOpacity = ~(1000-hpa)/(1000-930), color = ~pal(id),
    stroke = TRUE, popup = ~popup
  ) %>% 
  addPolylines(
    ~lon, ~lat, group = "台風22号", data = dplyr::filter(.data=res, id=="台風22号"),
    color = ~pal(id), weight = 3
  ) %>% 
    addCircleMarkers(
    ~lon, ~lat, group = "台風23号", data = dplyr::filter(.data=res, id=="台風23号"),
    radius = 10, weight = 2,
    fillOpacity = ~(1000-hpa)/(1000-930), color = ~pal(id),
    stroke = TRUE, popup = ~popup
  ) %>% 
  addPolylines(
    ~lon, ~lat, group = "台風23号", data = dplyr::filter(.data=res, id=="台風23号"),
    color = ~pal(id), weight = 3
  ) %>% 
  addPopups(lng = 125.0000, lat = 42.0000, text,
            option = popupOptions(closeButton = FALSE)) %>% 
  addLegend(position = "topright", pal = colpal, values = ~hpa,
            title = "中心気圧", labFormat=labelFormat(suffix = " hpa")) %>% 
  addLegend(position = "topright", pal = pal, value = ~id, title = NULL) %>% 
  addLayersControl(overlayGroups = c("台風22号","台風23号"),
                   options = layersControlOptions(collapsed = FALSE))
m

台風情報にはくれぐれも注意しましょう。