Deaths In USA
Graphs of weekly deaths in the USA using CDC & USCB data
Data
Weekly deaths
State Population
CDC Age & sex tables
Prepare Data
# devtools::install_github("derekmichaelwright/agData")
library(agData)
library(readxl)
# Prep data
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: US CDC\nNote: most recent years data may be incomplete"
myCaption <- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: US CDC & USCB\nNote: most recent years data may be incomplete"
myCaption2 <- c("darkgreen", "darkred", "darkorange", "steelblue", "darkblue", "purple4", "magenta3")
myColors <- c("Under 25 years", "25-44 years", "45-64 years",
myAges1 "65-74 years", "75-84 years", "85 years and older")
<- c("Under 5 years", "5 to 9 years", "10 to 14 years",
myAges2 "15 to 19 years", "20 to 24 years", "25 to 29 years",
"30 to 34 years", "35 to 39 years", "40 to 44 years",
"45 to 49 years", "50 to 54 years", "55 to 59 years",
"60 to 64 years", "65 to 69 years", "70 to 74 years",
"75 to 79 years", "80 to 84 years", "85 years and over")
#
<- read.csv("data_usa_population.csv") %>%
p1 select(Area, Population=X2019) %>%
mutate(Population = as.numeric(gsub(",","",Population)))
#
<- function(xx, myYear) {
fixSheet colnames(xx) <- c("Age", "Both sexes", "Both sexes - Percent",
"Males", "Males - Percent",
"Females", "Females - Percent")
<- xx %>% select(Age, `Both sexes`, Males, Females) %>%
xx mutate(Age = gsub("\\.", "", Age),
Year = myYear) %>%
select(Year, everything()) %>%
gather(Sex, Population, 3:ncol(.)) %>%
mutate(Population = 1000 * Population)
xx
}<- bind_rows(
p2 read_xlsx("data_usa_population.xlsx", "2015", range = "A7:G25") %>% fixSheet(myYear = 2015),
read_xlsx("data_usa_population.xlsx", "2016", range = "A7:G25") %>% fixSheet(myYear = 2016),
read_xlsx("data_usa_population.xlsx", "2017", range = "A7:G25") %>% fixSheet(myYear = 2017),
read_xlsx("data_usa_population.xlsx", "2018", range = "A7:G25") %>% fixSheet(myYear = 2018),
read_xlsx("data_usa_population.xlsx", "2019", range = "A7:G25") %>% fixSheet(myYear = 2019),
read_xlsx("data_usa_population.xlsx", "2020", range = "A7:G25") %>% fixSheet(myYear = 2020),
read_xlsx("data_usa_population.xlsx", "2021", range = "A7:G25") %>% fixSheet(myYear = 2021) ) %>%
mutate(Age = factor(Age, levels = myAges2))
#
<- read.csv("data_usa_deaths.csv") %>%
dd rename(Area=1, Date=Week.Ending.Date) %>%
mutate(Date = as.Date(Date, format = "%m/%d/%Y"),
Year = as.numeric(substr(Date, 1, 4)),
Month = as.numeric(substr(Date, 6, 7)),
Julian.Day = lubridate::yday(Date),
Adj.Julian.Day = ifelse(Month < 8, Julian.Day + 365, Julian.Day),
Age.Group = factor(Age.Group, levels = myAges1),
Group = ifelse(Year < 2020, "<2020", Year),
Group = factor(Group, levels = c("<2020", "2020", "2021", "2022", "2023"))) %>%
arrange(Date)
#
<- paste(2014:2023, 2015:2024, sep = "-")
mySeasons <- c(rep("pre-2020",5), mySeasons[6:length(mySeasons)])
myGroups # Calculate Year Group
#i <- 4695
<- 1
j for(i in 1:nrow(dd)) {
if(dd$Month[i] < 8) { mySwitch <- T }
$Season[i] <- mySeasons[j]
dd$Season.Group[i] <- myGroups[j]
ddif(dd$Month[i] > 7 & mySwitch == T) { j <- j + 1; mySwitch <- F }
}<- dd %>%
dd mutate(Season = factor(Season, levels = mySeasons),
Season.Group = factor(Season.Group, levels = unique(myGroups)))
Weekly Deaths
# Create plotting function
<- function(myArea = "United States") {
ggWeeklyDeaths # Prep data
<- 2015
xmin <- max(dd$Year)
xmax <- as.Date(paste0(as.character(xmin:xmax),"-01-01"))
vv <- dd %>% filter(Area == myArea, Year >= xmin, Type == "Unweighted")
xx #
<- xx %>% filter(Year < 2020) %>% group_by(Date) %>%
myMax summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
pull(Number.of.Deaths) %>% max() / 1000
# Plot
ggplot(xx, aes(x = Date, y = Number.of.Deaths / 1000, fill = Group)) +
geom_col(alpha = 0.7) +
geom_vline(xintercept = vv, lty = 2, alpha = 0.5) +
geom_hline(yintercept = myMax, alpha = 0.2) +
scale_fill_manual(values = myColors) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y",
minor_breaks = "1 year") +
theme_agData(legend.position = "none") +
labs(title = myArea, y = "Weekly Deaths (thousand)",
x = NULL, caption = myCaption)
}
United States
<- ggWeeklyDeaths(myArea = "United States")
mp ggsave("usa_deaths_1_01.png", mp, width = 8, height = 4)
New York
<- ggWeeklyDeaths(myArea = "New York")
mp ggsave("usa_deaths_1_02.png", mp, width = 8, height = 4)
New Jersey
<- ggWeeklyDeaths(myArea = "New Jersey")
mp ggsave("usa_deaths_1_03.png", mp, width = 8, height = 4)
California
<- ggWeeklyDeaths(myArea = "California")
mp ggsave("usa_deaths_1_04.png", mp, width = 8, height = 4)
Texas
<- ggWeeklyDeaths(myArea = "Texas")
mp ggsave("usa_deaths_1_05.png", mp, width = 8, height = 4)
Florida
<- ggWeeklyDeaths(myArea = "Florida")
mp ggsave("usa_deaths_1_06.png", mp, width = 8, height = 4)
Washington
<- ggWeeklyDeaths(myArea = "Washington")
mp ggsave("usa_deaths_1_07.png", mp, width = 8, height = 4)
Montana
<- ggWeeklyDeaths(myArea = "Montana")
mp ggsave("usa_deaths_1_08.png", mp, width = 8, height = 4)
North Dakota
<- ggWeeklyDeaths(myArea = "North Dakota")
mp ggsave("usa_deaths_1_09.png", mp, width = 8, height = 4)
South Dakota
<- ggWeeklyDeaths(myArea = "South Dakota")
mp ggsave("usa_deaths_1_10.png", mp, width = 8, height = 4)
Yearly Deaths
# Create plotting function
<- function(myArea = "United States") {
ggYearlyDeaths # Prep data
<- dd %>%
xx filter(Area == myArea, Type == "Unweighted") %>%
mutate(Year = as.numeric(substr(Date, 1, 4))) %>%
group_by(Area, Year, Group) %>%
summarise(Value = sum(Number.of.Deaths))
# Plot
ggplot(xx, aes(x = Year, y = Value / 1000000, fill = Group, alpha = Group)) +
geom_bar(stat = "identity", color = "black") +
scale_fill_manual(values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8)) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none") +
labs(title = myArea, y = "Million Deaths", x = NULL, caption = myCaption)
}
United States
<- ggYearlyDeaths(myArea = "United States")
mp ggsave("usa_deaths_2_01.png", mp, width = 6, height = 4)
New York
<- ggYearlyDeaths(myArea = "New York")
mp ggsave("usa_deaths_2_02.png", mp, width = 6, height = 4)
New Jersey
<- ggYearlyDeaths(myArea = "New Jersey")
mp ggsave("usa_deaths_2_03.png", mp, width = 6, height = 4)
California
<- ggYearlyDeaths(myArea = "California")
mp ggsave("usa_deaths_2_04.png", mp, width = 6, height = 4)
Texas
<- ggYearlyDeaths(myArea = "Texas")
mp ggsave("usa_deaths_2_05.png", mp, width = 6, height = 4)
Florida
<- ggYearlyDeaths(myArea = "Florida")
mp ggsave("usa_deaths_2_06.png", mp, width = 6, height = 4)
Washington
<- ggYearlyDeaths(myArea = "Washington")
mp ggsave("usa_deaths_2_07.png", mp, width = 6, height = 4)
Montana
<- ggYearlyDeaths(myArea = "Montana")
mp ggsave("usa_deaths_2_08.png", mp, width = 6, height = 4)
North Dakota
<- ggYearlyDeaths(myArea = "North Dakota")
mp ggsave("usa_deaths_2_09.png", mp, width = 6, height = 4)
South Dakota
<- ggYearlyDeaths(myArea = "South Dakota")
mp ggsave("usa_deaths_2_10.png", mp, width = 6, height = 4)
Deaths Vs. Previous Years
# Create plotting function
<- function(myAreas = "United States") {
ggRespSeasons # Prep data
<- dd %>% filter(Area %in% myAreas, Type == "Unweighted") %>%
xx group_by(Area, Year, Group, Season.Group, Season, Date, Adj.Julian.Day) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths))
<- xx %>% filter(Date == "2020-03-14")
zz #
<- c(213, 244, 274, 305, 335,
myBreaks 366, 397, 425, 456, 486, 517, 547, 577)
<- c("Aug","Sept","Oct","Nov","Dec",
myLabels "Jan","Feb","Mar","Apr", "May","June","July","Aug")
# Plot
ggplot(xx, aes(x = Adj.Julian.Day, y = Number.of.Deaths / 1000, group = Season,
color = Season.Group, alpha = Season.Group, size = Season.Group)) +
geom_line() +
geom_point(data = zz, size = 2, pch = 13, color = "black", alpha = 0.7) +
facet_wrap(Area ~ ., scales = "free_y", ncol = 5) +
scale_color_manual(name = NULL, values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8,0.8)) +
scale_size_manual(name = NULL, values = c(0.5,1,1,1,1,1)) +
scale_x_continuous(breaks = myBreaks, labels = myLabels) +
guides(color = guide_legend(nrow = 1)) +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(y = "Thousand Deaths Per Week", x = NULL, caption = myCaption)
}
United States
<- ggRespSeasons(myArea = "United States")
mp ggsave("usa_deaths_3_01.png", mp, width = 7, height = 4)
New York
<- ggRespSeasons(myArea = "New York")
mp ggsave("usa_deaths_3_02.png", mp, width = 7, height = 4)
New Jersey
<- ggRespSeasons(myArea = "New Jersey")
mp ggsave("usa_deaths_3_03.png", mp, width = 7, height = 4)
California
<- ggRespSeasons(myArea = "California")
mp ggsave("usa_deaths_3_04.png", mp, width = 7, height = 4)
Texas
<- ggRespSeasons(myArea = "Texas")
mp ggsave("usa_deaths_3_05.png", mp, width = 7, height = 4)
Florida
<- ggRespSeasons(myArea = "Florida")
mp ggsave("usa_deaths_3_06.png", mp, width = 7, height = 4)
Washington
<- ggRespSeasons(myArea = "Washington")
mp ggsave("usa_deaths_3_07.png", mp, width = 7, height = 4)
Montana
<- ggRespSeasons(myArea = "Montana")
mp ggsave("usa_deaths_3_08.png", mp, width = 7, height = 4)
North Dakota
<- ggRespSeasons(myArea = "North Dakota")
mp ggsave("usa_deaths_3_09.png", mp, width = 7, height = 4)
South Dakota
<- ggRespSeasons(myArea = "South Dakota")
mp ggsave("usa_deaths_3_10.png", mp, width = 7, height = 4)
Selected States
<- ggRespSeasons(myAreas = c("New York", "Texas", "Montana"))
mp ggsave("usa_deaths_3_11.png", mp, width = 12, height = 4)
Weekly Deaths by Age Group
# Create plotting function
<- function(myArea = "United States") {
ggRespSeasonsAge # Prep data
<- dd %>% filter(Area %in% myArea, Type == "Unweighted")
xx <- xx %>% filter(Date == "2020-03-14")
zz #
<- c(213, 244, 274, 305, 335,
myBreaks 366, 397, 425, 456, 486, 517, 547, 577)
<- c("Aug","Sept","Oct","Nov","Dec",
myLabels "Jan","Feb","Mar","Apr", "May","June","July","Aug")
# Plot
ggplot(xx, aes(x = Adj.Julian.Day, y = Number.of.Deaths / 1000, group = Season,
color = Season.Group, alpha = Season.Group, size = Season.Group)) +
geom_line() +
geom_point(data = zz, size = 2, pch = 13, color = "black", alpha = 0.7) +
facet_grid(. ~ Age.Group) +
scale_color_manual(name = NULL, values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8,0.8)) +
scale_size_manual(name = NULL, values = c(0.5,1,1,1,1,1)) +
scale_x_continuous(breaks = myBreaks, labels = myLabels) +
guides(color = guide_legend(nrow = 1)) +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = myArea, y = "Thousand Deaths Per Week",
x = NULL, caption = myCaption)
}
United States
<- ggRespSeasonsAge(myArea = "United States")
mp ggsave("usa_deaths_4_01.png", mp, width = 12, height = 5)
ggsave("featured.png", mp, width = 12, height = 5)
New York
<- ggRespSeasonsAge(myArea = "New York")
mp ggsave("usa_deaths_4_02.png", mp, width = 12, height = 5)
New Jersey
<- ggRespSeasonsAge(myArea = "New Jersey")
mp ggsave("usa_deaths_4_03.png", mp, width = 12, height = 5)
California
<- ggRespSeasonsAge(myArea = "California")
mp ggsave("usa_deaths_4_04.png", mp, width = 12, height = 5)
Texas
<- ggRespSeasonsAge(myArea = "Texas")
mp ggsave("usa_deaths_4_05.png", mp, width = 12, height = 5)
Florida
<- ggRespSeasonsAge(myArea = "Florida")
mp ggsave("usa_deaths_4_06.png", mp, width = 12, height = 5)
Washington
<- ggRespSeasonsAge(myArea = "Washington")
mp ggsave("usa_deaths_4_07.png", mp, width = 12, height = 5)
Montana
<- ggRespSeasonsAge(myArea = "Montana")
mp ggsave("usa_deaths_4_08.png", mp, width = 12, height = 5)
North Dakota
<- ggRespSeasonsAge(myArea = "North Dakota")
mp ggsave("usa_deaths_4_09.png", mp, width = 12, height = 5)
South Dakota
<- ggRespSeasonsAge(myArea = "South Dakota")
mp ggsave("usa_deaths_4_10.png", mp, width = 12, height = 5)
Yearly Deaths by Age Group
# Plotting function
<- function(myArea) {
ggYearlyDeathsAge # Prep data
<- dd %>%
xx filter(Type == "Unweighted", Area == myArea, Year < 2023) %>%
group_by(Year, Age.Group, Group) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T))
# Plot
ggplot(xx, aes(x = Year, y = Number.of.Deaths / 1000,
fill = Group, alpha = Group)) +
geom_bar(stat = "identity", color = "black") +
facet_grid(. ~ Age.Group) +
scale_fill_manual(values = myColors) +
scale_alpha_manual(values = c(0.4,0.8,0.8,0.8,0.8)) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = myArea, x = NULL, y = "Thousand Deaths", caption = myCaption)
}
United States
<- ggYearlyDeathsAge(myArea = "United States")
mp ggsave("usa_deaths_5_01.png", mp, width = 12, height = 5)
New York
<- ggYearlyDeathsAge(myArea = "New York")
mp ggsave("usa_deaths_5_02.png", mp, width = 12, height = 5)
New Jersey
<- ggYearlyDeathsAge(myArea = "New Jersey")
mp ggsave("usa_deaths_5_03.png", mp, width = 12, height = 4)
California
<- ggYearlyDeathsAge(myArea = "California")
mp ggsave("usa_deaths_5_04.png", mp, width = 12, height = 5)
Texas
<- ggYearlyDeathsAge(myArea = "Texas")
mp ggsave("usa_deaths_5_05.png", mp, width = 12, height = 5)
Florida
<- ggYearlyDeathsAge(myArea = "Florida")
mp ggsave("usa_deaths_5_06.png", mp, width = 12, height = 5)
Washington
<- ggYearlyDeathsAge(myArea = "Washington")
mp ggsave("usa_deaths_5_07.png", mp, width = 12, height = 5)
Montana
<- ggYearlyDeathsAge(myArea = "Montana")
mp ggsave("usa_deaths_5_08.png", mp, width = 12, height = 5)
North Dakota
<- ggYearlyDeathsAge(myArea = "North Dakota")
mp ggsave("usa_deaths_5_09.png", mp, width = 12, height = 5)
South Dakota
<- ggYearlyDeathsAge(myArea = "South Dakota")
mp ggsave("usa_deaths_5_10.png", mp, width = 12, height = 5)
Death Rates
# Prep data
<- dd %>%
xx filter(Year > 2019, Type == "Unweighted") %>%
group_by(Area, State.Abbreviation, Date) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
ungroup() %>%
left_join(p1, by = "Area") %>%
mutate(Death.Rate = 1000000 * Number.of.Deaths / Population)
# Plot
<- ggplot(xx, aes(x = Date, y = Death.Rate)) +
mp geom_line(color = "darkred", alpha = 0.8, size = 1) +
facet_wrap(Area ~ .) +
scale_color_manual(values = agData_Colors) +
scale_x_date(date_labels = "%Y", date_breaks = "1 year") +
theme_agData(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption2)
ggsave("usa_deaths_6_01.png", mp, width = 12, height = 12)
North vs South Dakota
# Prep data
<- xx %>% filter(State.Abbreviation %in% c("SD","ND"))
x1 # Plot
<- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
mp geom_line(size = 1) +
scale_color_manual(values = c("darkblue","steelblue")) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption2)
ggsave("usa_deaths_6_02.png", mp, width = 6, height = 4)
California vs Texas
# Prep data
<- xx %>% filter(State.Abbreviation %in% c("CA","TX"))
x1 # Plot
<- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
mp geom_line(size = 1) +
scale_color_manual(values = c("darkred","darkblue")) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption2)
ggsave("usa_deaths_6_03.png", mp, width = 6, height = 4)
New York vs New Jersey vs Florida
# Prep data
<- c("darkred", "darkblue", "steelblue")
colors <- xx %>% filter(State.Abbreviation %in% c("FL","NY","NJ"))
x1 # Plot
<- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
mp geom_line(size = 1) +
scale_color_manual(values = colors) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption2)
ggsave("usa_deaths_6_04.png", mp, width = 6, height = 4)
All Data
# Prep data
<- dd %>%
xx filter(Type == "Unweighted",
%in% c("FL","NY","NJ")) %>%
State.Abbreviation group_by(Area, State.Abbreviation, Date) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
ungroup() %>%
left_join(p1, by = "Area") %>%
mutate(Death.Rate = 1000000 * Number.of.Deaths / Population)
# Plot
<- ggplot(xx, aes(x = Date, y = Death.Rate, color = Area)) +
mp geom_line(size = 1) +
scale_color_manual(values = colors) +
scale_x_date(date_breaks = "1 year", date_label = "%Y") +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption2)
ggsave("usa_deaths_6_05.png", mp, width = 6, height = 4)
Death Rate - Ages 65+
# Prep data
<- dd %>%
x1 filter(Area == "United States", Age.Group %in% myAges1[4:6]) %>%
group_by(Year, Group) %>%
summarise(Deaths = sum(Number.of.Deaths, na.rm = T))
<- p2 %>% filter(Sex == "Both sexes", Age %in% myAges2[14:18]) %>%
x2 group_by(Year) %>%
summarise(Population = sum(Population, na.rm = T))
<- left_join(x1, x2, by = "Year") %>%
xx mutate(`Deaths Per 1000 People` = 1000 * Deaths / Population,
`Million Deaths` = Deaths / 1000000) %>%
select(-Population, -Deaths) %>%
gather(Trait, Value, 3:4) %>%
mutate(Trait = factor(Trait, levels = c("Million Deaths","Deaths Per 1000 People")))
# Plot
<- ggplot(xx, aes(x = Year, y = Value, fill = Group)) +
mp geom_col(color = "black", alpha = 0.7) +
facet_wrap(Trait ~ ., scales = "free") +
scale_fill_manual(values = myColors) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "United States - Ages 65+",
x = NULL, y = NULL, caption = myCaption2)
ggsave("usa_deaths_07_01.png", mp, width = 8, height = 4)
Death Rate - Ages 0 - 44
# Prep data
<- dd %>%
x1 filter(Area == "United States", Age.Group %in% myAges1[1:2]) %>%
group_by(Year, Group) %>%
summarise(Deaths = sum(Number.of.Deaths, na.rm = T))
<- p2 %>% filter(Sex == "Both sexes", Age %in% myAges2[1:9]) %>%
x2 group_by(Year) %>%
summarise(Population = sum(Population, na.rm = T))
<- left_join(x1, x2, by = "Year") %>%
xx mutate(`Deaths Per 1000 People` = 1000 * Deaths / Population,
`Million Deaths` = Deaths / 1000000) %>%
select(-Population, -Deaths) %>%
gather(Trait, Value, 3:4) %>%
mutate(Trait = factor(Trait, levels = c("Million Deaths","Deaths Per 1000 People")))
# Plot
<- ggplot(xx, aes(x = Year, y = Value, fill = Group)) +
mp geom_col(color = "black", alpha = 0.7) +
facet_wrap(Trait ~ ., scales = "free") +
scale_fill_manual(values = myColors) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "United States - Ages 0 - 44", x = NULL,
y = "Deaths Per 10,000 People", caption = myCaption2)
ggsave("usa_deaths_7_02.png", mp, width = 8, height = 4)
Weekly Deaths 0 - 44
# Create plotting function
<- function(myArea = "United States") {
ggWeeklyDeaths044 # Prep data
<- 2015
xmin <- max(dd$Year)
xmax <- as.Date(paste0(as.character(xmin:xmax),"-01-01"))
vv <- dd %>% filter(Area == myArea, Year >= xmin, Type == "Unweighted",
xx %in% c("Under 25 years", "25-44 years"))
Age.Group #
<- xx %>% filter(Year < 2020) %>% group_by(Date) %>%
myMax summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
pull(Number.of.Deaths) %>% max()
# Plot
ggplot(xx, aes(x = Date, y = Number.of.Deaths, fill = Group)) +
geom_col(alpha = 0.7) +
geom_vline(xintercept = vv, lty = 2, alpha = 0.5) +
geom_hline(yintercept = myMax, alpha = 0.2) +
scale_fill_manual(values = myColors) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y",
minor_breaks = "1 year") +
theme_agData(legend.position = "none") +
labs(title = paste(myArea, " - Ages 0 - 44"),
y = "Weekly Deaths", x = NULL, caption = myCaption)
}
United States
<- ggWeeklyDeaths044(myArea = "United States")
mp ggsave("usa_deaths_8_01.png", mp, width = 8, height = 4)
New York
<- ggWeeklyDeaths044(myArea = "New York")
mp ggsave("usa_deaths_8_02.png", mp, width = 8, height = 4)
New Jersey
<- ggWeeklyDeaths044(myArea = "New Jersey")
mp ggsave("usa_deaths_8_03.png", mp, width = 8, height = 4)
California
<- ggWeeklyDeaths044(myArea = "California")
mp ggsave("usa_deaths_8_04.png", mp, width = 8, height = 4)
Texas
<- ggWeeklyDeaths044(myArea = "Texas")
mp ggsave("usa_deaths_8_05.png", mp, width = 8, height = 4)
Florida
<- ggWeeklyDeaths044(myArea = "Florida")
mp ggsave("usa_deaths_8_06.png", mp, width = 8, height = 4)
Washington
<- ggWeeklyDeaths044(myArea = "Washington")
mp ggsave("usa_deaths_8_07.png", mp, width = 8, height = 4)
Montana
<- ggWeeklyDeaths044(myArea = "Montana")
mp ggsave("usa_deaths_8_08.png", mp, width = 8, height = 4)
North Dakota
<- ggWeeklyDeaths044(myArea = "North Dakota")
mp ggsave("usa_deaths_8_09.png", mp, width = 8, height = 4)
South Dakota
<- ggWeeklyDeaths044(myArea = "South Dakota")
mp ggsave("usa_deaths_8_10.png", mp, width = 8, height = 4)