Skip to content

Instantly share code, notes, and snippets.

@uribo

uribo/01-file_download.R

Last active September 22, 2019 18:48
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save uribo/156b7bcd740e1b0339883e96baacb699 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save uribo/156b7bcd740e1b0339883e96baacb699 to your computer and use it in GitHub Desktop.
Download ZIP
令和元年台風第15号に係る鉄道運行状況(千葉県)
Raw
01-file_download.R
library(drake)
library(dplyr)
library(purrr)
library(assertr)
library(tabulizer)
matrix_to_tbl <- function(data) {
data %>%
as.data.frame(stringsAsFactors = FALSE) %>%
janitor::clean_names() %>%
dplyr::mutate_if(is.character, stringi::stri_trans_nfkc) %>%
tibble::as_tibble()
}
col_carry <- function(data, ...) {
vars <- names(data)
vars_n <- length(vars)
data[, vars_n + seq.int(1, ...)] <- NA_character_
data %>%
dplyr::select(names(data)[!names(data) %in% vars], vars[seq_len(vars_n - ...)]) %>%
purrr::set_names(vars)
}
fix_railway_table <- function(data) {
fix_names_railway <-
c("事業者名", "線名", "運転休止区間",
paste("運転休止", c("日付", "時刻"), sep = "_"),
paste("運転再開", c("日付", "時刻"), sep = "_"),
"主な被害状況等")
data <-
data %>%
purrr::reduce(rbind) %>%
purrr::set_names(fix_names_railway) %>%
dplyr::slice(-1L) %>%
dplyr::mutate_all(na_if, y = "") %>%
tibble::rowid_to_column()
d_tmp <-
data %>%
dplyr::slice(stringr::str_which(data$`事業者名`, "線$"))
if (nrow(d_tmp) > 0) {
data_a <-
data %>%
dplyr::slice(stringr::str_which(data$`事業者名`, "線$", negate = TRUE)) %>%
dplyr::bind_rows(d_tmp %>%
select(-rowid) %>%
col_carry(1L) %>%
dplyr::bind_cols(d_tmp %>%
dplyr::select(rowid)) %>%
dplyr::select(rowid, fix_names_railway))
if (nrow(data_a) > 0) {
data <-
data %>%
dplyr::filter(!rowid %in% data_a$rowid) %>%
dplyr::bind_rows(data_a) %>%
dplyr::arrange(rowid)
}
}
d_tmp2 <-
data %>%
dplyr::slice(stringr::str_which(data$`事業者名`, "^.+~.+$"))
if (nrow(d_tmp2) > 0) {
data_b <-
data %>%
dplyr::slice(stringr::str_which(data$`事業者名`, "^.+~.+$", negate = TRUE)) %>%
dplyr::bind_rows(d_tmp2 %>%
dplyr::select(-rowid) %>%
col_carry(2L) %>%
dplyr::bind_cols(d_tmp2 %>%
dplyr::select(rowid)) %>%
dplyr::select(rowid, fix_names_railway))
if (nrow(data_b) > 0) {
data <-
data %>%
dplyr::filter(!rowid %in% data_b$rowid) %>%
dplyr::bind_rows(data_b) %>%
dplyr::arrange(rowid)
}
}
d_tmp3 <-
data %>%
dplyr::filter(stringr::str_detect(運転休止区間, "/"))
if (nrow(d_tmp3) > 0) {
d_tmp3 <-
d_tmp3 %>%
tibble::add_column(tmp = NA_character_, .before = 3) %>%
dplyr::select(rowid, 事業者名, tmp, names(d_tmp3)[2:length(names(d_tmp3)) - 1]) %>%
purrr::set_names(c("rowid", fix_names_railway))
data <-
data %>%
dplyr::filter(stringr::str_detect(運転休止区間, "/", negate = TRUE)) %>%
dplyr::bind_rows(d_tmp3) %>%
dplyr::arrange(rowid) %>%
dplyr::select(-rowid) %>%
tidyr::fill(`事業者名`, .direction = "down") %>%
tidyr::fill(`線名`, .direction = "down") %>%
dplyr::mutate_if(is.character, list(~ stringr::str_trim(.) %>%
stringr::str_squish() %>%
stringr::str_remove_all("[[:space:]]")))
}
data
}
# File Download -----------------------------------------------------------
file_path <- "r1typhoon15_19.pdf"
download.file("http://www.bousai.go.jp/updates/r1typhoon15/pdf/r1typhoon15_19.pdf",
destfile = file_path)
file_path <- "~/Documents/projects2019/jp-disaster/data-raw/r1typhoon15_19.pdf"
plan_collect_data <- drake_plan(
df_railway_raw =
list(
# 42
extract_tables(file_path,
pages = 9,
area = list(c(250, 95, 780, 510)),
output = "matrix"),
# 43-102(60), 103-160(58)
extract_tables(file_path,
pages = seq.int(10, 11),
output = "matrix")) %>%
flatten() %>%
map(matrix_to_tbl),
df_railway =
df_railway_raw %>%
fix_railway_table() %>%
verify(dim(.) == c(160, 8)) %>%
mutate_at(vars(ends_with("日付")),
list(~ if_else(is.na(.),
lubridate::ymd(NA),
lubridate::ymd(paste0("2019/", .)))))
)
make(plan_collect_data)
Raw
02-datasetup.R
source("01-file_download.R")
library(dplyr)
library(purrr)
library(sf)
library(zipangu)
library(lubridate)
library(drake)
loadd(df_railway)
filter_area_by_stname <- function(data, operationCompany = NULL, railwayLineName = NULL, stations) {
op_company = rlang::enquo(operationCompany)
line_name = rlang::enquo(railwayLineName)
rfid_range <-
data %>%
dplyr::filter(operationCompany == !!op_company,
railwayLineName == !!line_name) %>%
filter(stationName %in% stations) %>%
pull(rfid) %>%
stringr::str_remove("EB03_") %>%
as.numeric() %>%
range()
filter_area_stations(data, operationCompany, railwayLineName, rfid_range[1], rfid_range[2])
}
filter_area_stations <- function(data, operationCompany = NULL, railwayLineName = NULL, rfid1, rfid2) {
op_company = rlang::enquo(operationCompany)
line_name = rlang::enquo(railwayLineName)
data %>%
dplyr::filter(operationCompany == !!op_company,
railwayLineName == !!line_name) %>%
dplyr::mutate(rfid_num = stringr::str_remove(rfid, "EB03_") %>%
as.numeric()) %>%
dplyr::filter(dplyr::between(rfid_num, rfid1, rfid2)) %>%
dplyr::arrange(rfid_num) %>%
dplyr::select(-rfid_num)
}
split_suspend_area <- function(data) {
d <-
sf_railroad_pref12 %>%
dplyr::filter(operationCompany == data$operationCompany[1],
railwayLineName == data$railwayLineName[1])
d2 <-
sf_railstation_pref12 %>%
dplyr::filter(operationCompany == data$operationCompany[1],
railwayLineName == data$railwayLineName[1]) %>%
arrange(rfid)
if (data$suspend_all == TRUE) {
sts <-
d2 %>%
slice(c(1, nrow(.))) %>%
pull(stationName)
data <-
data %>%
mutate(st1 = sts[1],
st2 = sts[2])
}
d <-
d %>%
lwgeom::st_split(
d2 %>%
filter(stationName %in% c(data$st1[1],
data$st2[1]))
) %>%
st_collection_extract("LINESTRING") %>%
tibble::rowid_to_column() %>%
left_join(data %>%
select(operationCompany, railwayLineName, st1, st2,
start_date, start_time, end_date, end_time, suspend_all),
by = c("operationCompany", "railwayLineName")) %>%
select(-trid, -trrm, -remark, -rfrm)
d <-
d %>%
mutate(suspend_area = st_crosses(geometry,
filter_area_by_stname(sf_railstation_pref12,
operationCompany = data$operationCompany[1],
railwayLineName = data$railwayLineName[1],
c(data$st1[1],
data$st2[1])) %>%
summarise(do_union = FALSE) %>%
st_cast("LINESTRING"),
sparse = FALSE)[, 1]) %>%
select(railwayLineName, operationCompany, st1, st2,
start_date, start_time, end_date, end_time,
suspend_all, suspend_area)
d
}
read_ksj_n05(.year = 2016, .download = TRUE)
# data --------------------------------------------------------------------
plan_dataset <-
drake::drake_plan(
# 千葉県
sf_pref12 =
read_ksj_n03(.year = 2019, .pref_code = 12) %>%
st_union() %>%
st_sf() %>%
st_transform(crs = 4326) %>%
st_simplify(dTolerance = 0.0005),
# 路線、駅データ
df_ksj_n05 =
read_ksj_n05(.year = 2018, .type = "station") %>%
filter(timePeriod_End == "9999") %>%
mutate(operationCompany = recode(
operationCompany,
`東日本旅客鉄道（旧国鉄）` = "東日本旅客鉄道")),
df_ksj_n05_railroad =
read_ksj_n05(.year = 2018, .type = "railroad") %>%
filter(timePeriod_End == "9999") %>%
mutate(operationCompany = recode(
operationCompany,
`東日本旅客鉄道（旧国鉄）` = "東日本旅客鉄道")),
sf_railstation_pref12 =
df_ksj_n05 %>%
st_join(sf_pref12,
join = st_intersects,
left = FALSE),
sf_railroad_pref12 =
df_ksj_n05_railroad %>%
st_intersection(sf_pref12),
sf_railstation_pref12_beginend =
sf_railstation_pref12 %>%
st_drop_geometry() %>%
select(railwayLineName, operationCompany, stationName, rfid) %>%
group_by(railwayLineName, operationCompany) %>%
arrange(rfid) %>%
group_modify(
~ rbind(head(.x, 1),
tail(.x, 1))
) %>%
ungroup()
)
drake::make(plan_dataset)
drake::loadd(list = plan_dataset$target)
df_railway <-
df_railway %>%
set_names(c("operationCompany", "railwayLineName", "suspend_area",
"start_date", "start_time",
"end_date", "end_time",
"note")) %>%
mutate(operationCompany = recode(operationCompany,
`JR東日本` = "東日本旅客鉄道")) %>%
mutate(suspend_all = if_else(suspend_area == "全線", TRUE, FALSE),
suspend_area = if_else(suspend_all == TRUE, NA_character_, suspend_area)) %>%
inner_join(sf_railstation_pref12_beginend %>%
group_by(railwayLineName, operationCompany) %>%
mutate(be_area = paste0(stationName, collapse = "~")) %>%
slice(1L) %>%
ungroup() %>%
select(railwayLineName, operationCompany, be_area),
by = c("operationCompany", "railwayLineName")) %>%
mutate(suspend_area = if_else(suspend_all == TRUE,
be_area,
suspend_area)) %>%
tidyr::separate(suspend_area, into = c("st1", "st2"), sep = "~") %>%
select(-note, -be_area)
df_railway %>%
distinct(operationCompany, railwayLineName) %>%
anti_join(sf_railstation_pref12_beginend %>%
distinct(operationCompany, railwayLineName),
by = c("operationCompany", "railwayLineName")) %>%
assertr::verify(nrow(.) == 0L)
df_suspend_area <-
df_railway %>%
inner_join(sf_railstation_pref12 %>%
select(railwayLineName, operationCompany, stationName, rfid) %>%
st_drop_geometry(),
by = c("railwayLineName", "operationCompany",
"st1" = "stationName",
"st2" = "stationName")) %>%
filter(start_date >= "2019-09-08",
end_date != "2019-09-09" | is.na(end_date))
df_suspend_area <-
seq_len(nrow(df_suspend_area)) %>%
# map_dfr がつかwないので.idもだめ
purrr::map(
~ split_suspend_area(df_suspend_area[.x, ]) %>%
mutate(index = .x)) %>%
purrr::reduce(rbind)
df_railline_label <-
df_suspend_area %>%
filter(suspend_area == TRUE) %>%
mutate(longitude = sf::st_coordinates(st_centroid(geometry))[, 1],
latitude = sf::st_coordinates(st_centroid(geometry))[, 2]) %>%
st_drop_geometry() %>%
select(-suspend_all) %>%
distinct(operationCompany, railwayLineName, .keep_all = TRUE) %>%
mutate(nudge_x = 0,
nudge_y = 0,
operationCompany = recode(
operationCompany,
`東日本旅客鉄道` = "JR東日本"
),
operation_railway = paste(operationCompany, railwayLineName, sep = "\n"))
# 運転再開した区間
df_suspend_area_daily <-
df_suspend_area %>%
filter(suspend_area == TRUE) %>%
select(railwayLineName, operationCompany, start_date, end_date) %>%
mutate(`2019-09-09`= int_overlaps(interval(start_date, end_date),
interval(ymd("20190910"), ymd("20190910"))),
`2019-09-10` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190911"), ymd("20190911"))),
`2019-09-11` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190912"), ymd("20190912"))),
`2019-09-12` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190913"), ymd("20190913"))),
`2019-09-13` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190914"), ymd("20190914"))),
`2019-09-14` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190915"), ymd("20190915"))),
`2019-09-15` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190916"), ymd("20190916"))),
`2019-09-16` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190917"), ymd("20190917"))),
`2019-09-17` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190918"), ymd("20190918"))),
`2019-09-18` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190919"), ymd("20190919"))),
`2019-09-19` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190920"), ymd("20190920"))),
`2019-09-20` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190921"), ymd("20190921"))),
`2019-09-21` = int_overlaps(interval(start_date, end_date),
interval(ymd("20190922"), ymd("20190922")))) %>%
tidyr::pivot_longer(cols = starts_with("2019-"),
names_to = "date",
values_to = "suspend",
values_drop_na = FALSE) %>%
mutate(suspend = if_else(is.na(suspend), TRUE, suspend),
suspend = case_when(
suspend == TRUE ~ "運転休止",
suspend == FALSE ~ "運転再開"
)) %>%
st_sf()
Raw
03-mapping.R
source("02-datasetup.R")
library(ggplot2)
library(ggrepel)
library(ggtext)
library(cowplot)
# mapping -----------------------------------------------------------------
p_base <-
ggplot() +
geom_sf(data = sf_pref12, fill = "gray", alpha = 0.3) +
geom_sf(data = sf_railroad_pref12, size = 0.25) +
coord_sf(datum = NA) +
theme_void(base_family = "IPAexGothic", base_size = 9) +
labs(
title = "令和元年台風第15号に係る鉄道運行状況(千葉県)",
subtitle = "2019年9月21日14:00現在の情報を元に作成\nwww.bousai.go.jp/updates/r1typhoon15/pdf/r1typhoon15_19.pdf",
caption = "データソース: 内閣府 防災情報のページ<br>
国土数値情報 行政区域データ(2019年 N03)<br>
国土数値情報 鉄道時系列データ(2018年 N05)<br>
加工・編集: 瓜生真也 (<span style='font-family: \"Font Awesome 5 Brands\"; color:#55acee'>&#61593;</span>@u_ribo)<br>") +
theme(
plot.caption = element_markdown())
p_pref12_railroad <-
p_base +
labs(title = "千葉県内の鉄道路線",
subtitle = NULL,
caption = "データソース: 国土数値情報 行政区域データ(2019年 N03)<br>
国土数値情報 鉄道時系列データ(2018年 N05)<br>
加工・編集: 瓜生真也 (<span style='font-family: \"Font Awesome 5 Brands\"; color:#55acee'>&#61593;</span>@u_ribo)<br>")
p_pref12_suspend_railroad <-
p_base +
geom_sf(data = df_suspend_area %>%
filter(suspend_area == TRUE) %>%
mutate(operationCompany = recode(
operationCompany,
`東日本旅客鉄道` = "JR東日本"
),
operation_railway = paste(operationCompany, railwayLineName)),
aes(color = operation_railway),
linetype = 1,
show.legend = "line") +
geom_label_repel(data = df_railline_label,
aes(x = longitude, y = latitude,
label = operation_railway),
family = "IPAexGothic",
size = 2,
nudge_x = 0.02,
nudge_y = 0.04) +
guides(color = guide_legend(
title = "運転休止のあった路線・区間"
)) +
labs(
subtitle = NULL)
plot_grid(p_pref12_railroad, p_pref12_suspend_railroad, ncol = 2, rel_widths = c(1, 1.5))
ggsave("reiwa01_typhoon15_pref12_railroad.png", last_plot(), width = 10, height = 5)
p_pref12_suspend_railroad_daily <-
p_base +
geom_sf(data = df_suspend_area_daily, aes(color = suspend), show.legend = "line") +
scale_color_manual(values = c("運転休止" = "red", "運転再開" = "blue")) +
guides(color = guide_legend(
title = NULL
)) +
theme(legend.position = "top") +
facet_wrap(~ date, nrow = 2, ncol = 7)
ggsave("reiwa01_typhoon15_pref12_railroad_daily_status.png",
p_pref12_suspend_railroad_daily,
width = 10, height = 5)
@uribo
Copy link
Author

uribo commented Sep 22, 2019

reiwa01_typhoon15_pref12_railroad

reiwa01_typhoon15_pref12_railroad_daily_status

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment