WASPC Motor Vehicle Theft Data

Next Steps Washington

library(readxl)
library(tidyverse)
library(plotly)

MVthefts.2021 <- read_excel("Data/WASPC/MVthefts.xlsx", 
                       sheet = "2021")
MVthefts.2022 <- read_excel("Data/WASPC/MVthefts.xlsx", 
                            sheet = "2022") %>%
  select(County:MAR, YTD)

change <- left_join(MVthefts.2021, MVthefts.2022,
                    by = "County") %>%
  rowwise() %>%
  mutate(q2021.1 = sum(c_across(JAN.x:MAR.x)),
         q2021.2 = sum(c_across(APR:JUN)),
         q2021.3 = sum(c_across(JUL:SEP)),
         q2021.4 = sum(c_across(OCT:DEC)),
         q2022.1 = sum(c_across(JAN.y:MAR.y)),
         total = YTD.x + YTD.y,
         before = mean(c_across(q2021.1:q2021.2)),
         after = mean(c_across(q2021.3:q2022.1)),
         pct.chg = after/before - 1,
         pct.cat = cut(pct.chg, c(-1.8, 0, 0.25, 0.50, 1, 7)),
         large = ifelse(max(c(q2021.1, q2021.2, q2021.3, q2021.4, q2022.1)) < 20, 0, 1)) %>%
  select(County, q2021.1:large)


first <- pivot_longer(MVthefts.2021, cols=JAN:YTD,
                      names_to = "mon",
                      values_to = "num") %>%
  mutate(year = 2021,
         index = match(str_to_title(mon), month.abb))

second <- pivot_longer(MVthefts.2022, cols=JAN:YTD,
                       names_to = "mon",
                       values_to = "num") %>%
  mutate(year = 2022,
         index = match(str_to_title(mon), month.abb)+12)
  
MVthefts <- bind_rows(first, second) %>%
  mutate(county = fct_relevel(factor(County), "TOTAL", after = Inf))

This report focuses on the trends in motor vehicle thefts over time.

We use the data made available by WASPC: County level total number of motor vehicle thefts reported by law enforcement agencies each month, from January 2021 thru March 2022.

Monthly trends by county

This graphic shows the trend over time in the number of thefts reported each month by county, and for the State (“TOTAL” in the last plot). The black vertical line is July 2021, the month that HB 1054 took effect.

• The y-axis scale for each plot is county-specific due to the wide range in monthly totals across the counties: from 0 cases (in the smaller counties) to over 1400 (King). All y-axes start at 0, but the maximum is determined by the numbers for that county, allowing the plots to highlight the county-level trends.

• Note that counties with low theft numbers display high monthly volatility.

• There were a few negative counts in the WASPC data, we have removed those here.

ggplot(MVthefts %>% filter(mon != "YTD"), 
       aes(x=index, y = num, color = county)) +
  geom_point(show.legend = FALSE) +
  geom_line(show.legend = FALSE) +
  geom_vline(xintercept=7) +
  
  labs(title = "Motor Vehicle Thefts: Jan 2021 - Mar 2022",
       x = "Month",
       y = "Number") +
  
  xlim(c(0, 17)) + ylim(c(0,NA)) +
  
  scale_x_continuous(breaks = c(1,4,7,10,13,15),
                     labels = c("Jan", "Apr", "Jul", "Oct", "Jan", "Mar")) +
  
  
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  
  facet_wrap(~county, ncol = 5, scales = "free_y")

Percent change by county

To compare before and after HB 1054 we take the average monthly motor vehicle thefts by county before and after HB 1054 took effect (July 2021), and calculate the percentage change.

• The plot is restricted to counties with at least 30 thefts/month before HB 1054, as percentage changes tend to be volatile and unreliable for smaller numbers.

• The data for all counties can be viewed (and downloaded) from the Table tab.

Plot

This plot is interactive:

• Hover over the bar to bring up the stats for the average monthly thefts before and after HB 1054, and the percentage change.

• The statewide percentage change bar (“TOTAL”) is highlighted with a black border.

# County changes (all on one barplot)
# for counties with an average of at least 30/mo before

df <- change %>% filter(before >= 30)

# Set up margin values for subtitle

m <- list(
    l = 80,
    r = 80,
    b = 80,
    t = 80,
    pad = 0
  )

p <- ggplot(df,
            aes(x=pct.chg, y=reorder(County, pct.chg), 
                fill = pct.chg,
                col=factor(ifelse(County=="TOTAL", 1, 0)),
                text=paste(County, "<br>",
                           "before:", round(before, 1), "<br>",
                           "after:", round(after, 1), "<br>",
                           "change:", scales::percent(pct.chg, acc=1)))) +
  
  geom_bar(stat="identity") +
  
  scale_color_manual(values = c("grey", "black")) +
  scale_fill_gradient(
    low = "seashell", 
    high = "firebrick") +
  
  scale_x_continuous(labels = scales::percent) + #_format(acc=1)) +
  
  theme(axis.text.y=element_text(size=rel(0.6)), 
        legend.position = "none") +
  labs(#title = "Percent change in average monthly MV thefts by county",
       x="Percent change: After vs. Before 1054",
       y="County")

ggplotly(p, tooltip = "text") %>%
  layout(
    title = list(
      text = paste0('Percent change in average monthly MV thefts by county', 
                    '<br>',
                    '<sup>',
                    'Restricted to counties with 30+ thefts/mo on average',
                    '</sup>'),
      x=0.09), # this controls the position of the title, default is center
      margin=m)

Table

change %>%
  select(County, `Before 1054` = before, 
         `After 1054` = after, 
         `Percent Change` = pct.chg) %>%
  DT::datatable(rownames = F,
                caption = "Monthly average MV Thefts by County",
                filter = 'top',
                escape = FALSE,
                extensions = 'Buttons', 
                options = list(
                  dom = 'Bfrtip',
                  buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))
                ) %>%
  DT::formatPercentage("Percent Change", 1) %>%
  DT::formatRound(c("Before 1054", "After 1054"), 1)

---