US Post Offices ✉️
Plot No. 1
By Sylvi Rzepka (@SylviRz)
library(tidytuesdayR)
library(tidyverse)
library(ggtextures) # for geom_isotype_col()
library(magick) #for image_read
library(grid) # for the geom_isotype_col
postoffice <- tidytuesdayR::tt_load('2021-04-13')$post_offices
#summary statistics
table(postoffice$state)
summary(postoffice$established)
summary(postoffice$discontinued)
#data preparation
postofffice_prep<-postoffice %>%
select(id, established, discontinued, continuous) %>%
filter(established>1600) %>%
filter((discontinued>1600 & discontinued<2002) | is.na(discontinued)) %>%
# some post offices close earlier than they open (inconsistency)
filter(established<=discontinued | is.na(discontinued))
#counting post office openings each 50 years
openings <- postofffice_prep %>%
mutate(years=case_when(
established>=1600 & established<1800 ~ "1600-1800",
established>=1800 & established<1820 ~ "1800-1820",
established>=1820 & established<1840 ~ "1820-1840",
established>=1840 & established<1860 ~ "1840-1860",
established>=1860 & established<1880 ~ "1860-1880",
established>=1880 & established<1900 ~ "1880-1900",
established>=1900 & established<1920 ~ "1900-1920",
established>=1920 & established<1940 ~ "1920-1940",
established>=1940 & established<1960 ~ "1940-1960",
established>=1960 & established<1980 ~ "1960-1980",
established>=1980 ~ "1980-2002")
) %>%
group_by(years) %>%
summarise(number_openings=n()) %>%
mutate(ever_open=cumsum(number_openings)) #cumulative number of postoffices that were ever opened
#counting post office openings each 50 years
closures <- postofffice_prep %>%
mutate(years=case_when(
discontinued>=1600 & discontinued<1800 ~ "1600-1800",
discontinued>=1800 & discontinued<1820 ~ "1800-1820",
discontinued>=1820 & discontinued<1840 ~ "1820-1840",
discontinued>=1840 & discontinued<1860 ~ "1840-1860",
discontinued>=1860 & discontinued<1880 ~ "1860-1880",
discontinued>=1880 & discontinued<1900 ~ "1880-1900",
discontinued>=1900 & discontinued<1920 ~ "1900-1920",
discontinued>=1920 & discontinued<1940 ~ "1920-1940",
discontinued>=1940 & discontinued<1960 ~ "1940-1960",
discontinued>=1960 & discontinued<1980 ~ "1960-1980",
discontinued>=1980 ~ "1980-2002")
) %>%
group_by(years) %>%
summarise(number_closure=n()) %>% # assuming NA indicates count of post offices that never closed
mutate(ever_close=cumsum(number_closure))
letter_img <- image_read("/Users/rzepka/Documents/Correlaid/TidyTuesday/TidyTuesday/letter2.png")
# https://thenounproject.com/coquet_adrien/collection/mail/?i=953541")
open_close<-merge(openings, closures, all=TRUE) %>%
filter(!is.na(years)) %>% # dropping count of post offices that never closed
mutate(years=as.factor(years)) %>%
mutate(number_closure=ifelse(is.na(number_closure), 0, number_closure)) %>%
#subtract closures frin current open number of post offices
mutate(current_number=round((ever_open-ever_close),0), # each letter will stand for a 100 postoffices
letter_img="/Users/rzepka/Documents/Correlaid/TidyTuesday/TidyTuesday/letter2.png")
#Plotting
#Load a font from Google Fonts
sysfonts::font_add_google("Homemade Apple", regular.wt = 400)
sysfonts::font_add_google("Raleway", regular.wt = 400)
showtext::showtext_auto()
#quartz() # to make the font work
#Rise and fall of the US Post Offices
open_closeplot<-ggplot(open_close, aes(x=years, y=current_number, image = letter_img)) +
#geom_bar(stat="identity") +
geom_isotype_col(img_width = grid::unit(0.9, "native"), img_height = NULL,
ncol = 1, hjust = 0, vjust = 0.5) +
theme_minimal() +
theme(text = element_text(size = 11, colour = "black", family="Raleway"),
plot.title = element_text(size = 24, face = "bold", family="Homemade Apple"),
plot.title.position="plot", #left align title
plot.subtitle= element_text(margin=margin(b=50)), #trbl #increase space between subtitle and plot
plot.background =element_rect(fill = "cornsilk"),
panel.grid = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)), #increase space between label and axis
axis.title.y = element_text(margin = margin(r = 10)),
axis.text.x = element_text(margin = margin(t = 0)), # move the labels closer to the bars
axis.ticks = element_blank() ) +
labs(title = "Rise and Fall of Post Offices in the US",
subtitle = "In the US, the number of post offices peaked in the early 1900s. \nEver since, more post offices close than open every year.",
x= "Period",
y= "Number of Open Post Offices",
caption = "Data: Blevins & Helbock, 2021, US Post Offices, \nhttps://doi.org/10.7910/DVN/NUKCNA \nDataViz @SylviRz") +
scale_x_discrete(guide = guide_axis(n.dodge=2)) # so that x-axis labels don't overlap
open_closeplot
Plot No. 2
By Andreas Neumann