My original exploratory analysis on the topic can be found at Firearm Sales: How are Americans coping with 2020?
This post is a quick #rstats follow-up to visualize the final tally for 2020 data.
Load libraries
library(tidyverse)
library(lubridate)
library(scales)
Download & parse data
df_raw <- read_csv("https://raw.githubusercontent.com/BuzzFeedNews/nics-firearm-background-checks/master/data/nics-firearm-background-checks.csv")
df <- df_raw
df_clean <- df %>%
filter(month >= "2016-01" & month < "2021-01") %>%
select(month, state, handgun, long_gun) %>%
arrange((month)) %>%
mutate(month = as.Date(paste0(month, "-01"))) %>%
group_by(month) %>%
summarize(handgun = sum(handgun),
long_gun = sum(long_gun)) %>%
mutate(index_month = as.factor(month(month, label = TRUE)),
index_year = as.factor(year(month))) %>%
ungroup()
Visualize data
df_clean %>%
group_by(index_year) %>%
mutate(handgun = cumsum(handgun),
long_gun = cumsum(long_gun)) %>%
ungroup() %>%
select(month, index_month, index_year, handgun, long_gun) %>%
pivot_longer(handgun:long_gun, names_to = "type") %>%
ggplot(aes(index_month, value, color = index_year, group = index_year)) +
geom_line() +
geom_point() +
scale_y_continuous(labels = comma_format()) +
scale_color_brewer(palette = 'Paired') +
expand_limits(y = 0) +
facet_grid(type ~ .) +
labs(color = NULL, x = NULL, y = NULL,
title = "NICS Firearm Background Checks: monthly cumulative per year by type",
caption = "by: @eeysirhc\nsource: Federal Bureau of Investigation") +
theme_bw() +
theme(legend.position = 'top')
With the above completed we now have a year-over-year summary:
- Handgun: +75% increase for an incremental 5.1M in circulation compared to +3% and 226K from the previous year
- Long gun: +50% increase which is an extra 2.4M in the public as opposed to a -4% decline and -172K from the year prior