Les régulateurs s’attendent à ce que les compagnies d’assurance, les banques et autres ne fassent pas de discrimination raciale, mais les entreprises ne sont pas autorisées à recueillir la race de leurs clients. Une solution pour tester la discrimination globale consiste à utiliser les données du recensement américain pour estimer la race probable de chaque client en fonction de son nom et de sa situation géographique. (Les données raciales du recensement sont auto-identifiées et excluent une catégorie multiraciale ; je laisserai aux sociologues le soin de discuter des problèmes liés à ces choses et de savoir si les Hispaniques sont une race.)

L’algorithme courant pour estimer la race à partir des noms et de la géographie est le BISG (Bayesian Improvementd Surname Geocoding). À titre d’exemple, supposons qu’il y ait une cliente Mary Johnson qui vit dans le comté d’Essex, dans le New Jersey. Si nous voulons prédire sa race uniquement à partir de son nom de famille, nous utilisons les probabilités du recensement national telles que P(Noir ∣ Johnson) = 0,3441, P(Blanc ∣ Johnson) = 0,5438, etc.

Pour améliorer la prévision, nous ajoutons son comté, en utilisant des pondérations géographiques telles que la densité relative de chaque race dans l’Essex par rapport à l’ensemble du pays. La probabilité résultante P(Black | Johnson & Essex) = (Prob national noir × Poids géographique noir) / ∑_course (probation nationale de race × poids géographique de la race) = 0,7393.

Enfin, on ajoute son prénom. Sous une hypothèse naïve de Bayes selon laquelle le nom, le lieu et le prénom sont conditionnellement indépendants d’une race donnée, la règle de Bayes nous permet de multiplier les composants : P(race ∣ nom & géo & prénom) ≈ P(race) x P(nom ∣ race) x P(géo ∣ race) x P(premier ∣ race). La probabilité P(Black ∣ Johnson & Mary & Essex) devient 0,7158.

Un résumé de ces probabilités est le suivant :

Ces calculs peuvent être effectués avec le package R wru (Qui êtes-vous ?). Vous aurez besoin d’une clé API du recensement pour télécharger les données du recensement, disponibles sur .

Je souhaitais mesurer l’exactitude des prédictions du BISG. Il n’est pas facile de trouver des données réelles (non simulées) reliant le nom et la race. Cependant, plusieurs États rendent publics leurs registres d’inscription sur les listes électorales. J’ai demandé et téléchargé les données d’enregistrement des votes en Floride depuis Harvard Dataverse ( ). J’ai limité mon étude à un seul comté de Floride, Lee, qui comptait plus de 500 000 électeurs inscrits.

Les données du vote en Floride ont nécessité un nettoyage considérable des données. Parmi les problèmes de données amusants, il y a le fait que certains électeurs du comté de Lee se sont inscrits avec un code postal de boîte postale spécialisée, ou un code postal avec une faute de frappe, ou un code postal hors de l’État. Les deux premières catégories ont été cartographiées au niveau du comté et la troisième catégorie a été abandonnée.

Il y avait 545 187 électeurs inscrits dans le comté de Lee, répartis par race comme suit :

J’ai exécuté le même algorithme BISG que ci-dessus, par rapport aux données d’inscription des électeurs de Floride pour le comté de Lee. La précision globale est de 88 %, mais cela est trompeur car les données de Floride sont fortement déséquilibrées en faveur de la race blanche. Une meilleure mesure de précision est celle qui est calculée séparément pour chaque race, et j’ai choisi Précision équilibrée = (Sensibilité + Spécificité)/2. La sensibilité mesure dans quelle mesure l’algorithme trouve les personnes de cette race spécifique, et la spécificité mesure dans quelle mesure l’algorithme évite de classer à tort les personnes d’autres races dans cette race spécifique.

Mes résultats de précision équilibrée en comparant les prévisions de course BISG avec les données de course auto-identifiées en Floride sont les suivants :

Je pense que ces résultats sont plutôt bons pour les Hispaniques et les Blancs, pas aussi bons pour les Noirs et les Asiatiques, et bien sûr assez mauvais pour les Autres. Les autres comprennent les Amérindiens, les Hawaïens et autres, et représentent un faible pourcentage global de la population du comté.

La citation pour les données sur les électeurs de Floride est : Sood, Gaurav, 2017, « Florida Voter Registration Data (2017 and 2022) », Harvard Dataverse, V2.

Voici mon code R pour prédire 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
##################################################################################

Voici mon code R pour mesurer l’exactitude des prédictions du BISG par rapport aux électeurs du comté de Lee. Une partie considérable du code est destinée au nettoyage des données d’inscription des électeurs de Floride.

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

Fin