U.S. Incarceration Data Visualization Analysis with Functional Programming

Prison Summary

First off, let’s analyze the overall prison summary.

prison_summary <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-01-22/prison_summary.csv")

prison_summary

## # A tibble: 1,000 x 4
##     year urbanicity pop_category rate_per_100000
##    <dbl> <chr>      <chr>                  <dbl>
##  1  1983 rural      Black                 1117. 
##  2  1983 rural      Female                  22.8
##  3  1983 rural      Male                   574. 
##  4  1983 rural      Other                  315. 
##  5  1983 rural      Total                  248. 
##  6  1983 rural      White                  155. 
##  7  1983 small/mid  Black                 1138. 
##  8  1983 small/mid  Female                  26.6
##  9  1983 small/mid  Male                   550. 
## 10  1983 small/mid  Other                   87.5
## # ... with 990 more rows

Total prison rate among different regions

p1 <- prison_summary %>% 
  filter(pop_category == "Total") %>%
  ggplot(aes(year, rate_per_100000, color = urbanicity)) +
  geom_line() +
  geom_point() +
  facet_wrap(~urbanicity) +
  theme(
    legend.position = "none",
    strip.text = element_text(size = 15, face = "bold")
  ) +
  scale_x_continuous(breaks = seq(1970, 2020, by = 5)) +
  labs(y = "rate per 100,000",
       title = "Yearly Total Prison Rate Among Different Regions")

Prison rate among men and women

p2 <- prison_summary %>%
  filter(pop_category %in% c("Male", "Female")) %>%
  mutate(pop_category = fct_reorder(pop_category, -rate_per_100000, sum)) %>%
  ggplot(aes(year, rate_per_100000, color = pop_category)) +
  geom_line() +
  geom_point() +
  facet_wrap(~urbanicity) +
  theme(
    strip.text = element_text(size = 15, face = "bold")
  ) +
  scale_x_continuous(breaks = seq(1970, 2020, by = 10)) +
  labs(y = "rate per 100,000",
       title = "Yearly Gender Prison Rate Among Different Regions",
       color = NULL) 

Prison rate from different races

p3 <- prison_summary %>%
  filter(pop_category %in% c("Asian", "Black", "Latino", "Native American", "White")) %>%
  ggplot(aes(year, rate_per_100000, color = urbanicity)) +
  geom_line() +
  geom_point() +
  facet_wrap(~pop_category) +
  theme(
    strip.text = element_text(size = 15, face = "bold")
  ) +
  scale_x_continuous(breaks = seq(1970, 2020, by = 10)) +
  labs(y = "rate per 100,000",
       title = "Yearly Prison Rate from Various Races Among Different Regions",
       color = NULL)  

Now using patchwork to bind the three plot objects together

p1 / p2 / p3

prison_pop <- read_csv("https://github.com/rfordatascience/tidytuesday/blob/master/data/2019/2019-01-22/prison_population.csv?raw=true")

skimr::skim(prison_pop)

prison_pop_map <- function(metric){
  prison_pop %>%
  filter(pop_category == metric) %>%
  group_by(state, year) %>%
  mutate(state_pop_year = sum(population),
         prison_pop_year = sum(prison_population, na.rm = TRUE)) %>%
  ungroup() %>% 
  filter(prison_pop_year > 0) %>%
  mutate(prison_percentage = prison_pop_year/state_pop_year) %>%
  ggplot(aes(year, prison_percentage, color = state)) +
  geom_line(size = 1, show.legend = F) +
  facet_geo(~state) +
  scale_y_continuous(labels = percent) +
  labs(y = "yearly prison population percentage",
       title = paste("State-wise Prison Population Percentage among", metric),
       subtitle = "Missing values are prevalent in the dataset. A state without any line does not indicate it does not have any prisoner but rather due to missing values")
  
}

map(unique(prison_pop$pop_category), prison_pop_map)

## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

## 
## [[7]]

## 
## [[8]]

## 
## [[9]]

pre_summary <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-01-22/pretrial_summary.csv")


pre_summary %>%
  mutate(urbanicity = fct_reorder(urbanicity, -rate_per_100000, sum)) %>%
  ggplot(aes(year, rate_per_100000, color = urbanicity)) +
  geom_line(size = 1) +
  geom_point() +
  facet_wrap(~pop_category, ncol = 1) +
  labs(y = "rate per 100,000",
       color = NULL,
       title = "Pretrial Rates among Different Regions") +
  scale_x_continuous(breaks = seq(1970, 2020, 5)) +
  theme(
    strip.text = element_text(size = 15, face = "bold")
  )

pre_pop <- read_csv("https://github.com/rfordatascience/tidytuesday/blob/master/data/2019/2019-01-22/pretrial_population.csv?raw=true")


pre_pop_func <- function(category_metric){
  pre_pop %>%
  filter(pop_category == category_metric) %>%
  group_by(year, region) %>%
  summarize(pop = sum(population, na.rm = T),
            pre_pop = sum(pretrial_population, na.rm = T)) %>%
  ungroup() %>%
  mutate(pre_percentage = pre_pop/pop) %>%
  ggplot(aes(year, pre_percentage, color = region)) +
  geom_line(size = 1) +
  geom_point() +
  scale_y_continuous(labels = percent) +
  labs(y = "pretrial percentage",
       title = paste("Pretrial Percentage among", category_metric),
       subtitle = "Pretrial percentage is computed by using # of pretrial cases divides by total population in the region")
  
}

map(unique(pre_pop$pop_category)[1:3], pre_pop_func)

## [[1]]

## 
## [[2]]

## 
## [[3]]