Testarea predicțiilor rasiale cu BISG

Autoritățile de reglementare se așteaptă ca companiile de asigurări, băncile și altele să nu facă discriminări în funcție de rasă, dar companiile nu au voie să colecteze rasa clienților lor. O soluție pentru testarea discriminării în ansamblu este utilizarea datelor recensământului din SUA pentru a estima rasa probabilă a fiecărui client pe baza numelui clientului și a locației geografice. (Datele privind rasa recensământului sunt autoidentificate și exclud o categorie multi rasă; voi lăsa sociologilor să discute problemele cu aceste lucruri și dacă hispanica este o rasă.)

Algoritmul comun pentru estimarea rasei din nume și geografie este BISG (Bayesian Improved Surname Geocoding). De exemplu, să presupunem că există o clientă Mary Johnson care locuiește în comitatul Essex, NJ. Dacă vrem să-i prezicem rasa numai din numele ei de familie, folosim probabilitățile recensământului la nivel național, cum ar fi P(Negru ∣ Johnson) = 0,3441, P(Alb ∣ Johnson) = 0,5438 etc.

Pentru a îmbunătăți predicția, adăugăm județul ei, utilizând ponderi geografice, cum ar fi densitatea relativă a fiecărei rase din Essex, comparativ cu la nivel național. Probabilitatea rezultată P(Negru | Johnson & Essex) = (Problemă națională neagră × Greutate geografică neagră) / ∑_rasă (rasă națională problema × rasă geografică greutate) = 0,7393.

În cele din urmă, adăugăm prenumele ei. În baza unei ipoteze naive Bayes că numele de familie, locația și prenumele sunt condițional independente date de rasă, regula lui Bayes ne permite să înmulțim componentele: P(rasa ∣ nume & geo & primul) ≈ P(rasa) x P(nume ∣ rasă) x P(geo ∣ rasă) x P(prima ∣ rasă). Probabilitatea P(Negru ∣ Johnson & Mary & Essex) devine 0,7158.

Un rezumat al acestor probabilități este:

Aceste calcule se pot face cu pachetul R wru (Cine ești?). Veți avea nevoie de o cheie API pentru recensământ pentru a descărca datele recensământului, disponibile de la https://api.census.gov/data/key_ssignup.html .

Am fost interesat de măsurarea acurateței predicțiilor BISG. Nu este ușor să găsiți date reale (nu simulate) care leagă numele și rasa. Cu toate acestea, mai multe state își fac publice dosarele de înregistrare a alegătorilor. Am solicitat și descărcat datele de înregistrare a votului din Florida de la Harvard Dataverse ( https://dataverse.harvard.edu/dataset.xhtml?persistentId=doi:10.7910/DVN/UBIG3F ). Mi-am limitat studiul la un singur comitat din Florida, Lee, care avea peste 500.000 de alegători înregistrați.

Datele de vot din Florida au necesitat o curățare considerabilă a datelor. Printre problemele amuzante ale datelor se numără faptul că unii alegători din județul Lee s-au înregistrat cu un cod poștal de cutie poștală de specialitate sau un cod poștal cu o greșeală de tipar sau un cod poștal din afara statului. Primele două au fost mapate la nivel de județ, iar a treia categorie a fost abandonată.

Au fost 545.187 de alegători înregistrați în județul Lee, repartizați după rasă, după cum urmează:

Am efectuat același algoritm BISG ca mai sus, față de datele de înregistrare a alegătorilor din Florida pentru județul Lee. Precizia generală este de 88%, dar acest lucru este înșelător, deoarece datele din Florida sunt foarte dezechilibrate față de rasa albă. O măsură de precizie mai bună este una care se calculează separat pentru fiecare cursă, iar eu am ales Balanced Accuracy = (Sensibilitate + Specificitate)/2. Sensibilitatea măsoară cât de bine algoritmul găsește oamenii din acea rasă specifică, iar specificitatea măsoară cât de bine algoritmul evită clasificarea greșită a persoanelor din alte rase în rasa respectivă.

Rezultatele mele Balanced Accuracy din compararea predicțiilor curselor BISG cu datele de cursă autoidentificate din Florida sunt următoarele:

Cred că aceste rezultate sunt destul de bune pentru hispanici și albi, nu la fel de bune pentru negri și asiatici și, bineînțeles, destul de slabe pentru alte persoane. Alții includ nativi americani, nativi hawaiani și alții și reprezintă un mic procent total din populația județului.

Citarea pentru datele alegătorilor din Florida este: Sood, Gaurav, 2017, „Florida Voter Registration Data (2017 and 2022)”, https://doi.org/10.7910/DVN/UBIG3F, Harvard Dataverse, V2.

Iată codul meu R pentru a o prezice pe Mary Johnson.

library(wru)
library(dplyr)

# 1. Create a 1-row dataset for Mary Johnson in Essex County, NJ (FIPS "013")
test_voter <- data.frame(
  surname = "JOHNSON",
  first = "MARY",
  state = "NJ",
  county = "013", # Essex County FIPS
  stringsAsFactors = FALSE
)

# 2. Grab the live Census geographic data for New Jersey
nj_census <- get_census_data(
  key = "xxxx",
  states = "NJ",
  age = FALSE,
  sex = FALSE
)

# 3. Generate the 3 prediction variations
pred_baseline  <- predict_race(voter.file = test_voter, surname.only = TRUE)
pred_geo       <- predict_race(voter.file = test_voter, census.data = nj_census, census.geo = "county")
pred_first_geo <- predict_race(voter.file = test_voter, census.data = nj_census, census.geo = "county", names.to.use = "surname, first")

# 4. Format and clean output to perfectly fit the RStudio layout
combined_predictions <- bind_rows(
  pred_baseline  %>% mutate(model_type = "Surname Only"),
  pred_geo       %>% mutate(model_type = "Surname+Geo"),
  pred_first_geo %>% mutate(model_type = "Surname+First+Geo")
) %>%
  rename(
    White = pred.whi,
    Black = pred.bla,
    Hispan = pred.his,
    Asian = pred.asi,
    Other = pred.oth
  ) %>%
  mutate(across(c(White, Black, Hispan, Asian, Other), ~ round(., 4))) %>%
  select(model_type, surname, first, White, Black, Hispan, Asian, Other)

# 5. Display the output summary
print(combined_predictions, row.names = FALSE)
# End of Mary Johnson prediction
##################################################################################

Iată codul meu R pentru a măsura acuratețea predicțiilor BISG împotriva alegătorilor din județul Lee. O parte considerabilă a codului este pentru curățarea datelor din datele de înregistrare a alegătorilor din Florida.

library(data.table)
library(dplyr)
library(stringr)
library(caret)
library(wru)

voter_file_path <- "xxxx/LEE_20220621.txt"
Sys.setenv(CENSUS_API_KEY = "xxxx")

raw_lines <- fread(
  file = voter_file_path,
  sep = NULL, # Read the row as a single string to lock layout shifting
  header = FALSE,
  col.names = "raw_row"
)

wru_ready_data <- raw_lines %>%
  mutate(
    # Extract structural components securely out of text blocks
    surname = str_match(raw_row, "\d{9}\s+(\w+)")(,2),
    first = str_match(raw_row, "\d{9}\s+\w+\s+(\w+)")(,2),
    zipcode = str_extract(raw_row, "\b3\d{4}\b"),
    raw_race = str_match(raw_row, "\b((MF))\s+(\d)\b")(,3)
  ) %>%
  # Filter out empty records or text extraction errors
  filter(!is.na(surname) & !is.na(raw_race)) %>%
  # Map Florida's state administrative codes to wru categories
  mutate(
    true_race = case_when(
      raw_race == "5" ~ "white",
      raw_race == "3" ~ "black",
      raw_race == "4" ~ "hispanic",
      raw_race == "2" ~ "asian",
      raw_race %in% c("1", "6", "7") ~ "other",
      TRUE ~ NA_character_ # Automatically standardizes missing responses to NA
    )
  )

# Clean data of invalid zip codes and reroute PO Boxes to residential ZCTAs
wru_ready_data <- wru_ready_data %>%
  # Exclude out-of-state ZIP codes (Georgia 30xxx/31xxx, Alabama 35xxx/36xxx)
  filter(!substr(zipcode, 1, 2) %in% c("30", "31", "35", "36")) %>%
  # Map missing/typos and PO boxes directly to matching valid residential ZCTAs
  mutate(
    zipcode = case_when(
      # Defunct / Typos / Missing data map to Central Lee County Baseline
      zipcode %in% c("fl-NA", "33929", "33932", "33945", "33970") ~ "33901",
     
      # PO Box explicit routing to residential census counterparts
      zipcode == "33902" ~ "33901",  # Fort Myers PO Box -> Fort Myers Residential
      zipcode == "33906" ~ "33907",  # Fort Myers PO Box -> South Fort Myers Residential
      zipcode == "33910" ~ "33904",  # Cape Coral PO Box -> Cape Coral Residential
      zipcode == "33915" ~ "33919",  # Fort Myers PO Box -> Cypress Lake Residential
      zipcode == "33918" ~ "33903",  # N. Fort Myers PO Box -> N. Fort Myers Residential
      zipcode == "33994" ~ "33928",  # Bonita Springs PO Box -> Estero/Bonita Residential
      zipcode == "34106" ~ "34102",  # Naples PO Box -> Naples Residential
      zipcode == "34133" ~ "34135",  # Bonita Springs PO Box -> Bonita Residential
      zipcode == "34136" ~ "34135",  # Bonita Springs PO Box -> Bonita Residential
     
      TRUE ~ zipcode # Keep all other valid residential ZCTAs as they are
    ),
    # Ensure wru recognizes the geographic county boundary for the fallback imputation
    county = "12071" # FIPS code for Lee County, FL
  )

nrow(wru_ready_data)
table(wru_ready_data$true_race, useNA = "always")

lee_county_test <- as.data.table(wru_ready_data) %>%
  filter(!is.na(true_race)) %>%
  mutate(
    state = "fl",
    surname = as.character(surname),
    first = as.character(first),
    zcta = as.character(zipcode) # Required column label mapping for ZCTA use
  )

florida_zcta_layers <- wru::get_census_data(
  key = Sys.getenv("CENSUS_API_KEY"),
  state = "FL",
  age = FALSE,
  sex = FALSE,
  census.geo = "zcta",
  county.list = NULL # Required parameter boundary choice for independent ZCTAs
)

predicted_lee_county <- wru::predict_race(
  voter.file = lee_county_test,
  census.surname = TRUE,
  surname.only = FALSE,
  census.geo = "zcta",
  census.data = florida_zcta_layers,
  impute.missing = TRUE, # Forces wru to fall back to County priors if needed
  skip_bad_geos = TRUE
)

# "53233 (10.1%) individuals' last names were not matched, but ZCTA's baseline geographic racial demographics to calculate the prediction.

evaluation_ready_data <- predicted_lee_county %>%
  rowwise() %>%
  mutate(
    # Isolate which of the five columns held the highest posterior probability string
    max_prob_col = c("white", "black", "hispanic", "asian", "other")(
      which.max(c(pred.whi, pred.bla, pred.his, pred.asi, pred.oth))
    )
  ) %>%
  ungroup() %>%
  # Convert fields into factor arrays to prevent tracking sequence errors
  mutate(
    true_race = factor(true_race, levels = c("white", "black", "hispanic", "asian", "other")),
    predicted_map = factor(max_prob_col, levels = c("white", "black", "hispanic", "asian", "other"))
  )

# Compute the final metric confusion matrix tracking loop
accuracy_report <- confusionMatrix(
  data = evaluation_ready_data$predicted_map,
  reference = evaluation_ready_data$true_race
)

print(accuracy_report$overall("Accuracy")) # Overall model precision
print(accuracy_report$byClass(, "Balanced Accuracy")) # Success broken down per group

Sfârşit