#..............................Set Up.............................
# Load necessary libraries.
library(tidyverse)
library(dplyr)
library(paletteer)
library(lubridate)
library(showtext)
library(sysfonts)
library(stringr)
library(ggstream)
library(cowplot)
library(ggplot2)
library(rnaturalearth)
library(sf)
library(ggimage)
library(countrycode)
library(janitor)
library(gghighlight)
library(ARTofR)
library(waffle)
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Load Data ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Read in natural disaster world data.
nat_dis <- read_csv(here::here("posts",
"eds240-blog-post",
"data",
"pend-gdis-1960-2018-disasterlocations-csv",
"pend-gdis-1960-2018-disasterlocations.csv")) %>%
mutate(year = as.integer(year)) %>%
filter(disastertype %in% c("earthquake",
"flood",
"storm",
"drought",
"extreme temperature"))
# Read in population data.
pop <- read_csv(here::here("posts",
"eds240-blog-post",
"data",
"world_population",
"population.csv"),
skip = 4,
show_col_types = FALSE) %>%
select(where(~ !all(is.na(.))))
# Read in displaced data (2008 -2018)
displaced <- read_csv(here::here("posts",
"eds240-blog-post",
"data",
"internally-displaced-persons-from-disasters",
"internally-displaced-persons-from-disasters.csv")) %>%
rename("displaced" = "Internally displaced persons, new displacement associated with disasters (number of cases)")
#.................Select Fonts and Color Palette.................
# Add special fonts
font_add_google(name = "Space Grotesk", family = "sans-serif") # axis details and numbers
font_add_google(name = "Bricolage Grotesque", family = "bricolage") # titles, captions
# Define infographic colors.
"grey_blue" <- "#8896A7" # bar colors
"pale_blue" <- "#A1BBDD" # text colors
"dark_grey" <- "#4D4D4D" # plot background details
# Create color palette for disaster type.
pal <- c("drought" = "#663317",
"earthquake" = "#0B4A32",
"extreme temperature" = "#783682",
"flood" = "#75B9B0",
"storm" = "#E89300")
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Total Natural Disaster Trend (1960-2018) ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#.........................Summarize Data.........................
# Create the `yearly_total` dataframe.
yearly_total <- nat_dis %>%
# Get the total number of disasters per year.
count(year, name = "total_disasters")
#............................Line Plot...........................
showtext.auto(enable = TRUE)
# Create a line graph.
line_trend <- ggplot(data = yearly_total, aes(x = year, y = total_disasters)) +
geom_line() +
geom_point(size = 0.4) +
scale_x_continuous(limits = c(1960, 2018),
breaks = c(seq(1960, 2015, by = 20), 2018)) +
scale_y_continuous(labels = scales::label_comma()) +
labs(y = "Total Natural Disasters",
) +
theme_minimal(base_size = 17) +
# Theme adjustments.
theme(
axis.text = element_text(family = "sans-serif",
color = pale_blue),
axis.text.y = element_text(size = rel(1.5),
color = pale_blue),
axis.text.x = element_text(size = rel(1.5),
color = pale_blue),
axis.title.x = element_blank(),
axis.title.y = element_text(family = "bricolage",
size = rel(1.8),
margin = margin(t = 15,
r = 12),
color = pale_blue),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linetype = "dashed",
color = dark_grey),
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA))
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Total Natural Disasters by Country ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#.........................Summarize Data.........................
# Create the `top_10` dataframe.
top10_df <- nat_dis %>%
# Get the yearly totals for each country.
count(country, year, name = "disaster_count") %>%
# Calculate the total of all events between 1960-2018.
group_by(country) %>%
summarize(country_sum = sum(disaster_count),
.groups = "drop") %>%
# Select the top 10 countries.
slice_max(country_sum, n = 10) %>%
# Add flag image source as a new column.
mutate(iso2 = countrycode(country,
origin = "country.name",
destination = "iso2c"),
flag = paste0("https://flagcdn.com/w40/", tolower(iso2), ".png"),
country = fct_reorder(country, country_sum))
#............................Bar Plot............................
showtext.auto(enable = TRUE)
# Create a bar chart.
top10 <- ggplot(top10_df, aes(x = country_sum, y = country)) +
geom_col(fill = grey_blue,
alpha = 0.5) +
# Add the total value to the end of the bar.
geom_text(aes(label = scales::comma(country_sum)),
hjust = -0.4,
color = pale_blue,
size = 7,
family = "sans-serif") +
# Add flag images to associated country.
geom_image(aes(image = flag),
x = max(top10_df$country_sum) * 0.03,
size = 0.05,
by = "width") +
# Expand the x-axis for for flag and total value placement.
scale_x_continuous(labels = scales::label_comma(),
expand = expansion(mult = c(0, 0.1))) +
labs(x = "Number of Natural Disasters",) +
theme_minimal(base_size = 17) +
# Theme adjustments.
theme(
axis.text = element_text(family = "bricolage",
size = rel(1.5),
color = pale_blue),
axis.text.y = element_text(size = rel(1),
color = pale_blue),
axis.text.x = element_blank(),
axis.title.x = element_text(family = "bricolage",
size = rel(2.5),
color = pale_blue),
axis.title.y = element_blank(),
panel.grid = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA))
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Disaster Events by Population ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#.........................Summarize Data.........................
# Create top 10 country list from referencing `top_10` bar plot.
top10_list <- c("United States",
"Philippines",
"India",
"China",
"Japan",
"Thailand",
"Indonesia",
"Bangladesh",
"Vietnam",
"Peru")
# Create `pop_avg_top10` dataframe.
pop_avg_top10 <- pop_long %>%
# Filter data by the designated time frame and countries of interest.
filter(year >= 1960, year <= 2018) %>%
filter(country_name %in% top10_list) %>%
# Calculate the average population for each country.
group_by(country_name) %>%
summarise(avg_population = mean(population, na.rm = TRUE), .groups = "drop")
# Create `disaster_percap` dataframe.
disaster_percap <- top10_df %>%
# Join population average dataframe to disaster totals by country dataframe.
left_join(pop_avg_top10, by = c("country" = "country_name")) %>%
# Calculate the amount of disasters per million people in each country.
mutate(dis_per_million = country_sum / avg_population * 1e6) %>%
# Add flag image source as a new column.
mutate(iso2 = countrycode(country, origin = "country.name", destination = "iso2c"),
flag = paste0("https://flagcdn.com/w40/", tolower(iso2), ".png"),
country = fct_reorder(country, country_sum))
#............................Bar Plot............................
# Create a bar chart.
pop_bar <- ggplot(disaster_percap, aes(x = dis_per_million, y = country)) +
# Fill by the conditional statement to highlight the Philippines.
geom_col(aes(fill = country == "Philippines"), alpha = 0.5) +
# Add the total value to the end of the bar.
geom_text(
aes(label = scales::comma(dis_per_million)),
hjust = -0.85,
color = pale_blue,
size = 7,
family = "sans-serif") +
# Add flag images to associated country.
geom_image(aes(image = flag), x = max(disaster_percap$dis_per_million) * 0.03,
size = 0.05,
by = "width") +
# Bars are colored by true/false statements with designated colors.
scale_fill_manual(
values = c("TRUE" = "#DFEDF6", "FALSE" = grey_blue),
guide = "none") +
# Expand the x-axis for for flag and total value placement.
scale_x_continuous(labels = scales::label_comma(),
expand = expansion(mult = c(0, 0.18))) +
labs(x = "Number of Natural Disasters per Million People") +
theme_minimal(base_size = 17) +
# Theme adjustments.
theme(
axis.text = element_text(family = "sans-serif",
size = rel(1.5)),
axis.title.x = element_text(family = "bricolage",
size = rel(2.3),
color = pale_blue),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_text(size = rel(1),
margin = margin(r = -0.5),
family = "bricolage",
color = pale_blue),
panel.grid = element_blank(),
panel.grid.major.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA))
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Population Displaced from Disasters (2008-2018) ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#.........................Summarize Data.........................
# Create top 5 country list from referencing `top_10` bar plot.
top5_list <- c("United States", "Philippines", "India", "China", "Japan")
# Create a `displaced_top5` dataframe.
displaced_top5 <- displaced %>%
# Filter data by the designated time frame (2008-2018) and countries of interest.
filter(Entity %in% top5_list,
Year >= 2008, Year <= 2018) %>%
# Calculate the average amount of people displaced by country.
group_by(Entity) %>%
summarise(avg_displaced = mean(displaced, na.rm = TRUE), .groups = "drop")
# Create a `pop_top5` dataframe.
pop_avg_top5 <- pop_avg_top10 %>%
# Filter data by countries of interest.
filter(country_name %in% top5_list)
# Create a `displaced_pop` dataframe.
displaced_pop <- displaced_top5 %>%
# Join displaced dataframe to population average dataframe.
left_join(pop_avg_top5, by = c("Entity" = "country_name")) %>%
# Calculate the amount of people displaced per million people.
mutate(displaced_per_million = avg_displaced / avg_population * 1e6,
# Divide by 1000 so that 1 square represents ~1000 displaced people per million.
# Cap the value at 100 so it fits in a 10x10 waffle grid.
displaced_sq = pmin(100, round(displaced_per_million / 1000)),
# Calculate people not displaced.
not_displaced_sq = 100 - displaced_sq) %>%
# Select columns needed for waffle plot.
select(Entity, displaced_sq, not_displaced_sq) %>%
# Make data long.
pivot_longer(
cols = c(displaced_sq, not_displaced_sq),
names_to = "group",
values_to = "n") %>%
# Rename category levels.
mutate(group = recode(group,
displaced_sq = "Displaced",
not_displaced_sq = "Not displaced"))
#..........................Waffle Plot...........................
# Create waffle chart.
waffle <- ggplot(displaced_pop, aes(fill = group, values = n)) +
geom_waffle(n_rows = 10,
size = 0.1,
color = "white") +
# Create a waffle chart for each country.
facet_wrap(~ Entity, ncol = 5) +
# Set displacement colors.
scale_fill_manual(values = c("Displaced" = "navy",
"Not displaced" = "grey85")) +
labs(
subtitle = "Each 10×10 waffle:\n1 square ≈ 1,000 displaced people per million",
fill = NULL) +
theme_minimal() +
# Theme adjustments.
theme(
plot.subtitle = ggtext::element_markdown(family = "bricolage",
lineheight = .5,
size = rel(1),
margin = margin(b = 1),
hjust = 0.5),
plot.margin = margin(t = 2, r = 2, b = 2, l = 2),
panel.spacing = unit(0.1, "lines"),
panel.grid = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
strip.text = element_text(family = "bricolage",
size = rel(2),
margin = margin(b = .5,
t = 1)),
legend.position = "none",
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA))
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## Proportion of Natural Disasters by Country ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#.........................Summarize Data.........................
# Create top 5 country list from referencing `top_10` bar plot.
top5_countries <- c("United States", "Philippines", "India", "China", "Japan")
# Create a `type_country` dataframe.
type_country <- nat_dis %>%
filter(country %in% top5_countries) %>%
# Calculate the proportion of types of disaster for each country.
group_by(country, disastertype) %>%
summarise(disastertype_count = n(),
.groups = "drop")
#........................Stacked Bar Plot........................
# Create a stacked bar chart.
stacked_bar <- ggplot(data = type_country, aes(x = country, y = disastertype_count, fill = disastertype, color = "white")) +
geom_col(position = "fill", alpha = 0.65) +
# Color disaster type by designated palette.
scale_fill_manual(values = pal,
labels = c("drought" = "Drought",
"earthquake" = "Earthquake",
"extreme temperature" = "Extreme\nTemperature",
"flood" = "Flood",
"storm" = "Storm")) +
scale_color_manual(values = "white")+
# Make y-axis labels appear as percents.
scale_y_continuous(labels = scales::label_percent(scale = 100)) +
labs(x = "Country",
y = "Percentage of Disasters",
title = "Distribution of Disaster Types, by Percentages",
fill = "Disaster Type") +
theme_minimal() +
# Theme adjustments.
theme(
plot.title = ggtext::element_markdown(family = "bricolage",
face = "bold",
lineheight = 1.2),
axis.text = element_text(family = "sans-serif",
size = rel(0.7)),
axis.title.x = element_blank(),
axis.title.y = element_text(family = "bricolage",
size = rel(0.75),
margin = margin(t = 15)),
legend.position = "bottom",
legend.title.position = "bottom",
legend.direction = "horizontal",
legend.text = element_text(family = "bricolage",
size = rel(0.75),
margin = margin(t = 2)),
legend.title = element_blank(),
legend.key.width = unit(0.5, "cm"),
legend.key.height = unit(0.5, "cm"),
panel.grid = element_blank())