Stop and Frisk: Hypothesis Testing

Using infer for hypothesis testing

• Let’s first create the processed version of sqf by taking out (null) inside suspect_race_description and lumping suspect_race_description into two groups of race: BLACK and NON-BLACK.

sqf_testing <- sqf %>% 
  filter(suspect_race_description != "(null)") %>% 
  mutate(suspect_race_description = if_else(suspect_race_description == "BLACK HISPANIC", "BLACK",
                                                         suspect_race_description)) %>% 
  mutate(suspect_race_description = if_else(suspect_race_description != "BLACK", "NON-BLACK",
                                                         suspect_race_description))

• Then, we use specify to formulate the response and explanatory variables. Let’s use frisked_flag as the response variable and obviously, suspect_race_description as the explanatory variable. The argument success = "Y" reveals that we are interested in the proportion of “Y” in the frisked_flag column.

sqf_testing %>% 
  specify(formula = frisked_flag ~ suspect_race_description, success = "Y") 

• Now, we set meta data required for hyphotesis testing where we set null = "independence" for two sample (BLACK and NON-BLACK) hypothesis testing.

sqf_testing %>% 
  specify(formula = frisked_flag ~ suspect_race_description, success = "Y") %>% 
  hypothesize(null = "independence") 

• Here, we generate replicates of “shuffled” datasets assuming the null hypothesis is true.

sqf_testing %>% 
  specify(formula = frisked_flag ~ suspect_race_description, success = "Y") %>% 
  hypothesize(null = "independence") %>% 
  generate(reps = 1000, type = "permute")

• Now, we calculate the appropriate summary statistic for each of our 1000 shuffles, called the test statistic. According to Modern Dive, “…since the unknown population parameter of interest is the difference in population proportions, the test statistic of interest here is the difference in sample proportions” We have 1000 values of stat and we assign this dataframe to null_distribution

null_distribution <- sqf_testing %>% 
  specify(formula = frisked_flag ~ suspect_race_description, success = "Y") %>% 
  hypothesize(null = "independence") %>% 
  generate(reps = 1000, type = "permute") %>% 
  calculate(stat = "diff in props", order = c("BLACK", "NON-BLACK"))

• Here, we calculate the observed difference in proportion between blacks and non-blacks by using the same code as above except we remove hypothesize and generate

obs_diff_prop <- sqf_testing %>% 
  specify(formula = frisked_flag ~ suspect_race_description, success = "Y") %>% 
  calculate(stat = "diff in props", order = c("BLACK", "NON-BLACK"))

• Now, we visualize the null_distribution (values of the difference in proportions assuming that there is no racial discrimination) with a histogram and then “add what happened in real-life” with a red line and shades. Here, the shaded region is the p-value:

A p-value is the probability of obtaining a test statistic just as or more extreme than the observed test statistic assuming the null hypothesis is true.

visualize(null_distribution, bins = 10) + 
  shade_p_value(obs_stat = obs_diff_prop, direction = "right")

• In the above graph, we clearly see that the p-value is extremely low. We calculate the exact p-value (“fraction that the null distribution is shaded”) with get_p_value

null_distribution %>% 
  get_p_value(obs_stat = obs_diff_prop, direction = "right")

## # A tibble: 1 x 1
##   p_value
##     <dbl>
## 1       0

• Below, we create a wrapper function that does all the steps we just covered so that we can iterate this hypothesis testing on all our desired columns.

# Wrapper Function
run_hypothesis_test <- function(response_var) {
  
  f <- as.formula(
  paste(response_var, 
        "suspect_race_description", 
        sep = " ~ "))
  
  null_distribution <- sqf_testing  %>% 
    specify(formula = f, success = "Y") %>% 
    # "independence" for hypotheses involving two samples
    hypothesize(null = "independence") %>% 
    generate(reps = 1000, type = "permute") %>% 
    calculate(stat = "diff in props", order = c("BLACK", "NON-BLACK"))
  
  
  obs_diff_prop <- sqf_testing %>% 
    specify(formula = f, success = "Y") %>% 
    calculate(stat = "diff in props", order = c("BLACK", "NON-BLACK"))
  
  # Calculate P-value
  null_distribution %>% 
    get_p_value(obs_stat = obs_diff_prop, direction = "right") # Because P(BLACK) > P(NON-BLACK)
}


# Find desired variables
testing_names <- sqf %>% 
  select(contains("physical"), contains("frisked"), contains("searched")) %>% 
  names()

results <- testing_names %>% 
  map_df(~(data.frame(p_value = run_hypothesis_test(.x))),
         .id = "response_variable")

All response variables have p-values that are bigger than 0.05 except for physical_force_restraint_used_flag and frisked_flag. This signifies that we reject the null hypothesis for these variables and conclude that there is evidence to suggest that police frisk and use physical force on blacks suspects more than non-black suspects.