10 changed files with 668 additions and 52 deletions
@ -0,0 +1,72 @@ |
|||
library(stringi) |
|||
library(tigris) |
|||
library(hrbrthemes) |
|||
library(tidyverse) |
|||
|
|||
jsonlite::fromJSON("https://github.com/CivilServiceUSA/us-house/raw/master/us-house/data/us-house.json") %>% |
|||
as_tibble() %>% |
|||
left_join( |
|||
distinct(fips_codes, STATEFP=state_code, state_name) |
|||
) %>% |
|||
mutate(district = ifelse(is.na(district), 0, district)) %>% |
|||
mutate(GEOID = sprintf("%s%02s", STATEFP, district)) -> house |
|||
|
|||
congressional_districts(TRUE, "20m", year = 2018, class="sf") %>% |
|||
left_join( |
|||
distinct(fips_codes, STATEFP=state_code, state_name) |
|||
) %>% |
|||
filter(!(STATEFP %in% c("02", 15, 60:78))) %>% |
|||
left_join(house) %>% |
|||
filter(!is.na(party)) %>% |
|||
mutate(party = stri_trans_totitle(party)) -> cd |
|||
|
|||
ggplot() + |
|||
geom_sf(data = cd, aes(fill = party), color = "white", size = 0.25) + |
|||
coord_sf(crs=albersusa::us_laea_proj, datum = NA) + |
|||
scale_fill_manual( |
|||
values = c( |
|||
"Republican" = "#a50026", |
|||
"Democrat" = "#313695" |
|||
), name = NULL |
|||
) + |
|||
labs( |
|||
x = NULL, y = NULL, |
|||
title = "116th Congress District Borders", |
|||
caption = "Data source: {tigris}\nhttps://git.rud.is/hrbrmstr/y2019-30daymapchallenge • #30DayMapChallenge" |
|||
) + |
|||
theme_ft_rc(grid="") + |
|||
theme(legend.position = c(0.5, 0.95)) + |
|||
theme(legend.position = "horizontal") |
|||
|
|||
map(cd$state_name, ~{ |
|||
|
|||
f <- filter(cd, state_name == .x) |
|||
|
|||
ggplot() + |
|||
geom_sf(data = f, aes(fill = party), color = "white", size = 0.125) + |
|||
scale_fill_manual( |
|||
values = c( |
|||
"Republican" = "#a50026", |
|||
"Democrat" = "#313695" |
|||
), name = NULL |
|||
) + |
|||
coord_sf(crs=albersusa::us_laea_proj, datum = NA) + |
|||
labs( |
|||
x = NULL, y = NULL, |
|||
title = f$state_name[[1]] |
|||
) + |
|||
theme_ipsum_rc(grid="") + |
|||
theme(legend.position = "none") -> gg |
|||
|
|||
ggsave( |
|||
here::here(sprintf("out/13/%s.png", tolower(f$state_name[[1]]))), |
|||
plot = gg, width=250/72, height=250/72 |
|||
) |
|||
|
|||
gg |
|||
|
|||
}) -> gd |
|||
|
|||
|
|||
|
|||
|
|||
@ -0,0 +1,95 @@ |
|||
library(sf) |
|||
library(rgeocodio) |
|||
library(rvest) |
|||
library(stringi) |
|||
library(pdftools) |
|||
library(hrbrthemes) |
|||
library(albersusa) |
|||
library(tidyverse) |
|||
library(magrittr) |
|||
|
|||
if (!file.exists(here::here("data/russe.rds"))) { |
|||
russe_pg <- read_html("https://www.businessinsider.com/charlotte-russe-bankruptcy-stores-closing-list-2019-2") |
|||
|
|||
html_nodes(russe_pg, xpath=".//p[contains(., 'of the closing')]/following-sibling::ul/li") %>% |
|||
html_text() -> russe |
|||
|
|||
russe_g <- rgeocodio::gio_batch_geocode(russe) |
|||
|
|||
saveRDS(russe_g, here::here("data/russe.rds")) |
|||
} |
|||
|
|||
if (!file.exists(here::here("data/sears.rds"))) { |
|||
|
|||
sears_pg <- read_html("https://www.businessinsider.com/sears-closes-80-more-stores-2018-12") |
|||
html_nodes(sears_pg, xpath=".//span[contains(., 'of the latest')]/../../p") %>% |
|||
html_text() %>% |
|||
keep(stri_detect_regex, "^(Sears|Kmart)") %>% |
|||
stri_replace_first_regex("^(Sears[\\*]*|Kmart)", "") %>% |
|||
stri_trim_both() -> sears |
|||
|
|||
sears2_pg <- read_html("https://www.businessinsider.com/sears-kmart-stores-closing-list-2018-10") |
|||
html_nodes(sears2_pg, xpath=".//h2[text()='Sears' or text()='Kmart']/following-sibling::ul/li ") %>% |
|||
html_text() %>% |
|||
stri_trim_both() -> sears2 |
|||
|
|||
sears_g <- rgeocodio::gio_batch_geocode(c(sears, sears2)) |
|||
saveRDS(sears_g, here::here("data/sears.rds")) |
|||
|
|||
} |
|||
|
|||
dressbarn <- as_tibble(jsonlite::stream_in(gzcon(url("https://rud.is/dl/dressbarn-locations.json.gz")))) |
|||
|
|||
payless <- read_csv("http://rud.is/dl/2019-payless-store-closings.csv") |
|||
|
|||
saveRDS(dressbarn, here::here("data/dressbarn.rds")) |
|||
saveRDS(payless, here::here("data/payless.rds")) |
|||
|
|||
bind_rows( |
|||
filter(sears_g, map_lgl(response_results, ~nrow(.x) > 0)) %>% |
|||
mutate(ll = map(response_results, ~select(.x, location.lng, location.lat) %>% slice(1))) %>% |
|||
select(ll) %>% |
|||
unnest(ll) %>% |
|||
set_names(c("lng", "lat")) %>% |
|||
mutate(brand = "Sears/Kmart"), |
|||
|
|||
filter(russe_g, map_lgl(response_results, ~nrow(.x) > 0)) %>% |
|||
mutate(ll = map(response_results, ~select(.x, location.lng, location.lat) %>% slice(1))) %>% |
|||
select(ll) %>% |
|||
unnest(ll) %>% |
|||
set_names(c("lng", "lat")) %>% |
|||
mutate(brand = "Russe"), |
|||
|
|||
select(payless, lng = longitude, lat=latitude) %>% |
|||
mutate(brand = "Payless"), |
|||
|
|||
select(dressbarn, lng = lon, lat) %>% |
|||
mutate(brand = "Dressbarn") |
|||
) %>% |
|||
filter(lng > -130, lat > 21) -> continental |
|||
|
|||
usa <- usa_sf("laea") %>% filter(!(name %in% c("Alaska", "Hawaii"))) |
|||
|
|||
st_as_sf(continental, coords = c("lng", "lat"), crs = us_longlat_proj) %>% |
|||
st_transform(albersusa::us_laea_proj) -> continental |
|||
|
|||
ggplot() + |
|||
geom_sf(data = usa, fill = "#252525", size = 0.125, color = "#b2b2b277") + |
|||
geom_sf(data = continental, aes(color = brand), size = 0.25, alpha = 1/3, show.legend = "point") + |
|||
ggthemes::scale_color_tableau(name = NULL) + |
|||
coord_sf(datum = NA) + |
|||
guides( |
|||
colour = guide_legend( |
|||
override.aes = list(size = 2, alpha=1) |
|||
) |
|||
) + |
|||
labs( |
|||
x = NULL, y = NULL, |
|||
title = "Places of the 2019 Retail Apocalpyse", |
|||
subtitle = "Locations of four major brands store closings in 2019 alone (~3,100 stores in total)", |
|||
caption = "Data source: (various + {rgeocodio})\nhttps://git.rud.is/hrbrmstr/y2019-30daymapchallenge • #30DayMapChallenge" |
|||
) + |
|||
theme_ft_rc(grid="") + |
|||
theme(legend.position = c(0.5, 0.95)) + |
|||
theme(legend.direction = "horizontal") + |
|||
theme(axis.text = element_blank()) |
|||
@ -0,0 +1,59 @@ |
|||
library(sf) |
|||
library(albersusa) |
|||
library(rnaturalearth) |
|||
library(hrbrthemes) |
|||
library(asam) # hrbrmstr/asam |
|||
|
|||
zones <- asam_subregions() |
|||
|
|||
incidents <- read_asam() |
|||
incidents <- st_as_sf(incidents, coords = c("longitude", "latitude"), crs = us_longlat_proj) |
|||
|
|||
zones %>% |
|||
left_join( |
|||
st_intersection(incidents, select(zones, SUBREGION)) %>% |
|||
as_tibble() %>% |
|||
count(SUBREGION) |
|||
) -> locs |
|||
|
|||
world <- ne_countries(scale = "medium", returnclass = "sf") |
|||
|
|||
ggplot() + |
|||
geom_sf( |
|||
data = world, color = "#2b2b2b", size = 0.125, fill="#d9d9d9" |
|||
) + |
|||
geom_sf( |
|||
data = select(locs, SUBREGION, n), aes(fill = n), |
|||
size = 0.125, alpha=1/2, color = "#b3000077" |
|||
) + |
|||
geom_sf_text( |
|||
data = select(locs, SUBREGION, n), |
|||
aes( |
|||
label = I(ifelse(is.na(n), "", scales::comma(n))), |
|||
color = I(ifelse(n > 900, "black", "white")) |
|||
), |
|||
family = font_es_bold, size = 3.33 |
|||
) + |
|||
geom_sf_text( |
|||
data = select(locs, SUBREGION, n), |
|||
aes( |
|||
label = I(ifelse(is.na(n), "", scales::comma(n))), |
|||
color = I(ifelse(n > 900, "white", "black")) |
|||
), |
|||
family = font_es_bold, size = 3.25 |
|||
) + |
|||
scale_fill_viridis_c( |
|||
name = "Number of Anti-Shipping Incidents", |
|||
option = "magma", direction = -1, na.value = "white", |
|||
label = scales::comma |
|||
) + |
|||
labs( |
|||
x = NULL, y = NULL, |
|||
title = "Total Anti-Shipping Activity since 1978 by Sub-Region Zone", |
|||
subtitle = "Zones depicted with red border; counts are total incidents (mostly piracy)", |
|||
caption = "Data source: {asam}\nhttps://git.rud.is/hrbrmstr/y2019-30daymapchallenge • #30DayMapChallenge" |
|||
) + |
|||
theme_ipsum_es(grid="") + |
|||
theme(legend.position = "top") + |
|||
theme(legend.key.width = unit(2, "lines")) + |
|||
theme(legend.direction = "horizontal") |
|||
Binary file not shown.
Binary file not shown.
|
Binary file not shown.
Binary file not shown.
Loading…
Reference in new issue