Programacion y aprendizaje de maquina

Contexto

Estarás trabajando con un subconjunto de datos provenientes de un conjunto más robusto, generado por la organización ProPublica, en torno a las predicciones de la herramienta COMPAS. utilizada por la Corte en los Estados Unidos para evaluar la probabilidad de que una persona acusada se convierta en reincidente.

Con este documento se busca replicar un modelo de aprendizaje de maquína, que sea sometido a pruebas rigurosad para identificar variables que ayuden a mejorar el modelo, así como para probar sus resultados en torno a métodos que promuevan la aplicación su aplicación justa en decisiones del gobierno.

Establecimiento del ambiente de trabajo

# Instalación del ambiente de trabajo

library(tidymodels)

## ── Attaching packages ────────────────────────────────────── tidymodels 1.0.0 ──

## ✔ broom        1.0.3     ✔ recipes      1.0.4
## ✔ dials        1.1.0     ✔ rsample      1.1.1
## ✔ dplyr        1.1.2     ✔ tibble       3.2.1
## ✔ ggplot2      3.4.2     ✔ tidyr        1.3.0
## ✔ infer        1.0.4     ✔ tune         1.0.1
## ✔ modeldata    1.1.0     ✔ workflows    1.1.2
## ✔ parsnip      1.0.3     ✔ workflowsets 1.0.0
## ✔ purrr        1.0.1     ✔ yardstick    1.1.0

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter()  masks stats::filter()
## ✖ dplyr::lag()     masks stats::lag()
## ✖ recipes::step()  masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/

library(dplyr)
library(ggplot2)
library(caret)

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following objects are masked from 'package:yardstick':
## 
##     precision, recall, sensitivity, specificity

## The following object is masked from 'package:purrr':
## 
##     lift

Cargamos nuestro directorio de trabajo y nuestro data.frame

set.seed(210)
getwd()

## [1] "/Users/javier94231/Desktop/Ciencia de datos 1"

setwd("/Users/javier94231/Desktop/Ciencia de datos 1")

datos_compas <- read.csv("compas_train.csv")

Paso 1. Modelo de clasificación

Separa en conjunto de prueba y entrenamiento

datos_split <- initial_split(
  data = datos_compas,
  prop = 0.7,
  strata = score_text
)
entrenamiento <- training(datos_split)
prueba <- testing(datos_split)

Modelos usados

Se establecen los modelos a usar. En este documento se usan k-Nearest Neighbors (k-NN), árboles de decisión y bosques aleatorios. Más adelante se avaluan estos modelos para determinar el que mejor se ajuste a los parámetros solicitados.

# Establecimiento de los modelos

clasificacion_knn <- nearest_neighbor() %>% 
  set_engine("kknn") %>% 
  set_mode("classification") %>% 
  set_args(
    neighbors = tune(), 
    weight_func = tune(),
    dist_power = tune()
  )

clasificacion_arbol <- decision_tree() %>% 
  set_engine("rpart") %>% 
  set_mode("classification") %>% 
  set_args(
    cost_complexity = tune(),
    tree_depth = tune(),
    min_n = tune()
  )

clasificacion_bosque <- rand_forest() %>% 
  set_engine("ranger") %>% 
  set_mode("classification") %>% 
  set_args(
    mtry = tune(),
    trees = tune(),
    min_n = tune()
  )

Esta es la receta, es decir, la formula con las variables a usar para clasificar la varibale score_text, que es la clasificación de riesgo de la persona acusada. Las variables que elegí fueron: length_of_stay (es decir, tiempo en que estuvo retenido en los centros penitenciarios), juv_fel_count (no sé que signifique), race (es decir, la raza del acusado) y priors_count_ (es decir, conteo de antecedentes penales)

# Definir receta
receta <- recipe(
  formula = score_text ~ length_of_stay + juv_fel_count + race + priors_count_,
  data = entrenamiento
) %>%
  step_dummy(all_nominal_predictors())

Validación cruzada

Para la validación cruzada la receta y los modelos definidos. Esta técnica divide el conjunto de datos en múltiples subconjuntos llamados “folds” o “pliegues” y con ellos realiza iteraciones de entrenamiento y evaluación del modelo en distintas combinaciones, con el objetivo de reducir la varianza y el sesgo del modelo. Y volverlo más preciso.

# Definir validación cruzada
validacion_cruzada <- vfold_cv(data = entrenamiento, v = 5)

compas_workflow = workflow_set(
  preproc = list(receta=receta),
  models = list(
        cla_knn = clasificacion_knn,
        cla_arbol = clasificacion_arbol,
        cla_bosque = clasificacion_bosque
  )
) %>% 
  workflow_map(
    resamples = validacion_cruzada,
    grid = 20,
    verbose = TRUE
  )

## i 1 of 3 tuning:     receta_cla_knn

## ✔ 1 of 3 tuning:     receta_cla_knn (57.4s)

## i 2 of 3 tuning:     receta_cla_arbol

## ✔ 2 of 3 tuning:     receta_cla_arbol (8.7s)

## i 3 of 3 tuning:     receta_cla_bosque

## i Creating pre-processing data to finalize unknown parameter: mtry

## ✔ 3 of 3 tuning:     receta_cla_bosque (2m 15.2s)

Selección del modelo

Se selecciona el modelo más adecuado en función de la precisión y del área bajo la curva (que es otra medida para probar su exactitud) superiores al 70%. El modelo seleccionado resultó ser por bosques aleatorios.

# Rankear modelo con mejores metricas
rank_results(compas_workflow, rank_metric = "roc_auc")

## # A tibble: 120 × 9
##    wflow_id         .config .metric  mean std_err     n preprocessor model  rank
##    <chr>            <chr>   <chr>   <dbl>   <dbl> <int> <chr>        <chr> <int>
##  1 receta_cla_bosq… Prepro… accura… 0.711 0.00760     5 recipe       rand…     1
##  2 receta_cla_bosq… Prepro… roc_auc 0.772 0.00266     5 recipe       rand…     1
##  3 receta_cla_bosq… Prepro… accura… 0.716 0.00542     5 recipe       rand…     2
##  4 receta_cla_bosq… Prepro… roc_auc 0.771 0.00248     5 recipe       rand…     2
##  5 receta_cla_bosq… Prepro… accura… 0.714 0.00567     5 recipe       rand…     3
##  6 receta_cla_bosq… Prepro… roc_auc 0.771 0.00247     5 recipe       rand…     3
##  7 receta_cla_bosq… Prepro… accura… 0.713 0.00622     5 recipe       rand…     4
##  8 receta_cla_bosq… Prepro… roc_auc 0.771 0.00243     5 recipe       rand…     4
##  9 receta_cla_bosq… Prepro… accura… 0.712 0.00555     5 recipe       rand…     5
## 10 receta_cla_bosq… Prepro… roc_auc 0.768 0.00314     5 recipe       rand…     5
## # ℹ 110 more rows

rank_results(compas_workflow, rank_metric = "accuracy")

## # A tibble: 120 × 9
##    wflow_id         .config .metric  mean std_err     n preprocessor model  rank
##    <chr>            <chr>   <chr>   <dbl>   <dbl> <int> <chr>        <chr> <int>
##  1 receta_cla_bosq… Prepro… accura… 0.716 0.00542     5 recipe       rand…     1
##  2 receta_cla_bosq… Prepro… roc_auc 0.771 0.00248     5 recipe       rand…     1
##  3 receta_cla_bosq… Prepro… accura… 0.714 0.00567     5 recipe       rand…     2
##  4 receta_cla_bosq… Prepro… roc_auc 0.771 0.00247     5 recipe       rand…     2
##  5 receta_cla_bosq… Prepro… accura… 0.713 0.00622     5 recipe       rand…     3
##  6 receta_cla_bosq… Prepro… roc_auc 0.771 0.00243     5 recipe       rand…     3
##  7 receta_cla_bosq… Prepro… accura… 0.712 0.00555     5 recipe       rand…     4
##  8 receta_cla_bosq… Prepro… roc_auc 0.768 0.00314     5 recipe       rand…     4
##  9 receta_cla_bosq… Prepro… accura… 0.712 0.00612     5 recipe       rand…     5
## 10 receta_cla_bosq… Prepro… roc_auc 0.767 0.00322     5 recipe       rand…     5
## # ℹ 110 more rows

# Generar gráficas de selección del mejor modelo.
autoplot(compas_workflow, metric = "roc_auc")

autoplot(compas_workflow, metric = "accuracy")

# Selecciona el mejor modelo
mejor_modelo = compas_workflow %>%
  # Extrae el conjunto de resultados del algoritmo con mejor desempeño
  extract_workflow_set_result("receta_cla_bosque") %>%
  # Selecciona el mejor modelo basado en las métricas
  select_best(metric = "roc_auc")

compas_split = initial_split(datos_compas)

# Finaliza el flujo de trabajo 
modelo_compas = compas_workflow %>% 
  # Extrae el flujo de trabjao
  extract_workflow("receta_cla_bosque")  %>%  
  # Finaliza el flujo con el mejor modelo
  finalize_workflow(mejor_modelo) %>% 
  # Realiza el ultimo ajuste
  last_fit(compas_split)

# Revisar metricas de predicción
modelo_compas %>% 
  collect_metrics()

## # A tibble: 2 × 4
##   .metric  .estimator .estimate .config             
##   <chr>    <chr>          <dbl> <chr>               
## 1 accuracy binary         0.713 Preprocessor1_Model1
## 2 roc_auc  binary         0.779 Preprocessor1_Model1

Paso 2. Validación del modelo

Este paso es sencillo, pues solamente se prueba el modelo elegido en un data.frame con datos distintos para determinar su categorización. A través de esta prueba se puede determinar si el modelo funciona de manera precisa tras la inclusión de nueva información.

prueba_compas <- read.csv("compas_test.csv")
prueba_compas <- rename(prueba_compas, priors_count_ = priors_count)

# Genera una predicción
prediccion_muestra <- modelo_compas %>% 
  # Extrae el flujo de trabajo
  extract_workflow("receta_cla_bosque") %>% 
  # Aplica el método agument en el conjunto de datos nuevo
  augment(prueba_compas)

# Seleccionar las columnas con los resultados de la predicción.
columnas_seleccionadas <- prediccion_muestra[, c("id", ".pred_class")]

# Guardar en un archivo csv.
write.csv(columnas_seleccionadas, file = "A01026500.csv", row.names = FALSE)

Paso 3. Métricas de auditoría de Sesgo y Equidad [Aequitas]

Las auditorías de sesgo y equidad se utilizan para analizar y evaluar posibles sesgos y disparidades injustas en los resultados de los modelos de aprendizaje automático. Son usadas esencialmente en áreas donde las decisiones automatizadas pueden afectar a las personas de manera significativa.Su objetivo principal es identificar cualquier sesgo o discriminación sistemática que pueda estar presente en los resultados del modelo. Por esto son importantes para el análisis de algoritmos de justicia, como el que se analiza en este documento

Matriz de confusión

En primer lugar, se crea una matriz de confusión para las variables del modelo original. Se busca clasificar los valores “High” y “Low” que arrojaron el modelo de prueba y el de testeo.

# Genera una predicción para el modelo original
prediccion_compas <- modelo_compas %>% 
  # Extrae el flujo de trabajo
  extract_workflow("receta_cla_bosque") %>% 
  # Aplica el método agument en el conjunto de datos nuevo
  augment(datos_compas)

# Crear matriz de confusión
# Convertir las variables en factores con los mismos niveles
pred_class_factor <- factor(prediccion_compas$.pred_class, levels = unique(prediccion_compas$score_text))
score_text_factor <- factor(prediccion_compas$score_text, levels = unique(prediccion_compas$score_text))
matriz_score_text <- confusionMatrix(data = pred_class_factor, reference = score_text_factor)
matriz_score_text

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  Low High
##       Low  2951 1279
##       High  412 1358
##                                           
##                Accuracy : 0.7182          
##                  95% CI : (0.7066, 0.7295)
##     No Information Rate : 0.5605          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.4069          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.8775          
##             Specificity : 0.5150          
##          Pos Pred Value : 0.6976          
##          Neg Pred Value : 0.7672          
##              Prevalence : 0.5605          
##          Detection Rate : 0.4918          
##    Detection Prevalence : 0.7050          
##       Balanced Accuracy : 0.6962          
##                                           
##        'Positive' Class : Low             
##

Evaluación de métricas para la variable sex (sexo)

Con esto se busca encontrar disparidades entre los valores para hombres y mujeres.

# Creación de la tabla de métricas por sex
sex_metricas <- prediccion_compas %>%
  group_by(sex) %>%
  summarise(
    Positivo_pronósticado = sum(.pred_class == "High"),
    Pronóstico_predictivo_total = sum(score_text == "High"),
    Negativo_previsto = sum(.pred_class == "Low"),
    Prevalencia_prevista = mean(score_text == "High"),
    Tasa_positiva_prevista = sum(.pred_class == "High") / n(),
    Falsos_positivos = sum(.pred_class == "High" & score_text == "Low"),
    Falsos_negativos = sum(.pred_class == "Low" & score_text == "High"),
    Verdaderos_positivos = sum(.pred_class == "High" & score_text == "High"),
    Verdaderos_negativos = sum(.pred_class == "Low" & score_text == "Low"),
    Tasa_de_descubrimiento_falso = sum(.pred_class == "High" & score_text == "Low") / sum(.pred_class == "High"),
    Tasa_de_omisión_falsa = sum(.pred_class == "Low" & score_text == "High") / (sum(.pred_class == "Low" & score_text == "High") + sum(.pred_class == "Low" & score_text == "Low")),
    Tasa_de_falsos_positivos = sum(.pred_class == "High" & score_text == "Low") / sum(score_text == "Low"),
    Tasa_de_falsos_negativos = sum(.pred_class == "Low" & score_text == "High") / sum(score_text == "High")
  )

# Imprimir la tabla de métricas por sex
print.data.frame(sex_metricas)

##      sex Positivo_pronósticado Pronóstico_predictivo_total Negativo_previsto
## 1 Female                   228                         452               910
## 2   Male                  1542                        2185              3320
##   Prevalencia_prevista Tasa_positiva_prevista Falsos_positivos Falsos_negativos
## 1            0.3971880              0.2003515               57              281
## 2            0.4494035              0.3171534              355              998
##   Verdaderos_positivos Verdaderos_negativos Tasa_de_descubrimiento_falso
## 1                  171                  629                    0.2500000
## 2                 1187                 2322                    0.2302205
##   Tasa_de_omisión_falsa Tasa_de_falsos_positivos Tasa_de_falsos_negativos
## 1             0.3087912               0.08309038                0.6216814
## 2             0.3006024               0.13261113                0.4567506

Evaluación de métricas para la variable age_cat (categoría de edad)

Con esto se busca encontrar disparidades entre los valores de personas de entre 25 y 45 años, mayores de 45 años y menores de 25 años.

# Creación de la tabla de métricas por edad
edad_metricas <- prediccion_compas %>%
  group_by(age_cat) %>%
  summarise(
    Positivo_pronósticado = sum(.pred_class == "High"),
    Pronóstico_predictivo_total = sum(score_text == "High"),
    Negativo_previsto = sum(.pred_class == "Low"),
    Prevalencia_prevista = mean(score_text == "High"),
    Tasa_positiva_prevista = sum(.pred_class == "High") / n(),
    Falsos_positivos = sum(.pred_class == "High" & score_text == "Low"),
    Falsos_negativos = sum(.pred_class == "Low" & score_text == "High"),
    Verdaderos_positivos = sum(.pred_class == "High" & score_text == "High"),
    Verdaderos_negativos = sum(.pred_class == "Low" & score_text == "Low"),
    Tasa_de_descubrimiento_falso = sum(.pred_class == "High" & score_text == "Low") / sum(.pred_class == "High"),
    Tasa_de_omisión_falsa = sum(.pred_class == "Low" & score_text == "High") / (sum(.pred_class == "Low" & score_text == "High") + sum(.pred_class == "Low" & score_text == "Low")),
    Tasa_de_falsos_positivos = sum(.pred_class == "High" & score_text == "Low") / sum(score_text == "Low"),
    Tasa_de_falsos_negativos = sum(.pred_class == "Low" & score_text == "High") / sum(score_text == "High")
  )

# Imprimir la tabla de métricas por age_cat
print.data.frame(edad_metricas)

##           age_cat Positivo_pronósticado Pronóstico_predictivo_total
## 1         25 - 45                  1167                        1525
## 2 Greater than 45                   342                         272
## 3    Less than 25                   261                         840
##   Negativo_previsto Prevalencia_prevista Tasa_positiva_prevista
## 1              2253            0.4459064              0.3412281
## 2               929            0.2140047              0.2690795
## 3              1048            0.6417112              0.1993888
##   Falsos_positivos Falsos_negativos Verdaderos_positivos Verdaderos_negativos
## 1              239              597                  928                 1656
## 2              154               84                  188                  845
## 3               19              598                  242                  450
##   Tasa_de_descubrimiento_falso Tasa_de_omisión_falsa Tasa_de_falsos_positivos
## 1                   0.20479863            0.26498003               0.12612137
## 2                   0.45029240            0.09041981               0.15415415
## 3                   0.07279693            0.57061069               0.04051173
##   Tasa_de_falsos_negativos
## 1                0.3914754
## 2                0.3088235
## 3                0.7119048

Evaluación de métricas para la variable race (raza)

Con esto se busca encontrar disparidades entre los valores de personas afroamericanas, asiaticas, blancas, hispanas, nativas americanas y de otro tipo de raza.

# Creación de la tabla de métricas por race
race_metricas <- prediccion_compas %>%
  group_by(race) %>%
  summarise(
    Positivo_pronósticado = sum(.pred_class == "High"),
    Pronóstico_predictivo_total = sum(score_text == "High"),
    Negativo_previsto = sum(.pred_class == "Low"),
    Prevalencia_prevista = mean(score_text == "High"),
    Tasa_positiva_prevista = sum(.pred_class == "High") / n(),
    Falsos_positivos = sum(.pred_class == "High" & score_text == "Low"),
    Falsos_negativos = sum(.pred_class == "Low" & score_text == "High"),
    Verdaderos_positivos = sum(.pred_class == "High" & score_text == "High"),
    Verdaderos_negativos = sum(.pred_class == "Low" & score_text == "Low"),
    Tasa_de_descubrimiento_falso = sum(.pred_class == "High" & score_text == "Low") / sum(.pred_class == "High"),
    Tasa_de_omisión_falsa = sum(.pred_class == "Low" & score_text == "High") / (sum(.pred_class == "Low" & score_text == "High") + sum(.pred_class == "Low" & score_text == "Low")),
    Tasa_de_falsos_positivos = sum(.pred_class == "High" & score_text == "Low") / sum(score_text == "Low"),
    Tasa_de_falsos_negativos = sum(.pred_class == "Low" & score_text == "High") / sum(score_text == "High")
  )
# Imprimir la tabla de métricas por race
print.data.frame(race_metricas)

##               race Positivo_pronósticado Pronóstico_predictivo_total
## 1 African-American                  1495                        1770
## 2            Asian                     1                           6
## 3        Caucasian                   201                         651
## 4         Hispanic                    46                         132
## 5  Native American                    11                           8
## 6            Other                    16                          70
##   Negativo_previsto Prevalencia_prevista Tasa_positiva_prevista
## 1              1595            0.5728155             0.48381877
## 2                29            0.2000000             0.03333333
## 3              1831            0.3203740             0.09891732
## 4               450            0.2661290             0.09274194
## 5                 0            0.7272727             1.00000000
## 6               325            0.2052786             0.04692082
##   Falsos_positivos Falsos_negativos Verdaderos_positivos Verdaderos_negativos
## 1              335              610                 1160                  985
## 2                0                5                    1                   24
## 3               60              510                  141                 1321
## 4               11               97                   35                  353
## 5                3                0                    8                    0
## 6                3               57                   13                  268
##   Tasa_de_descubrimiento_falso Tasa_de_omisión_falsa Tasa_de_falsos_positivos
## 1                    0.2240803             0.3824451               0.25378788
## 2                    0.0000000             0.1724138               0.00000000
## 3                    0.2985075             0.2785363               0.04344678
## 4                    0.2391304             0.2155556               0.03021978
## 5                    0.2727273                   NaN               1.00000000
## 6                    0.1875000             0.1753846               0.01107011
##   Tasa_de_falsos_negativos
## 1                0.3446328
## 2                0.8333333
## 3                0.7834101
## 4                0.7348485
## 5                0.0000000
## 6                0.8142857

Cálculo de disparidad

Disparidad de la variable Male

Aquí se compara la disparidad entre los resultados de las métricas de sesgo usadas en el paso anterior. En este caso, como son solo dos variables, se cálcula la variable hombre, en función con la variable mujeres.

# Calcular las métricas del grupo de referencia Male
Male_ref <- sex_metricas %>% filter(sex == "Male")

# Calcular las métricas del grupo de referencia Female
Female_ref <- sex_metricas %>% filter(sex == "Female")

# Calcular la disparidad de sesgo para cada métrica y cada grupo
disparidad_male <- Male_ref %>%
  mutate(
    Disparidad_Positivo_pronósticado = Positivo_pronósticado / Female_ref$Positivo_pronósticado,
    Disparidad_Pronóstico_predictivo_total = Pronóstico_predictivo_total / Female_ref$Pronóstico_predictivo_total,
    Disparidad_Negativo_previsto = Negativo_previsto / Female_ref$Negativo_previsto,
    Disparidad_Prevalencia_prevista = Prevalencia_prevista / Female_ref$Prevalencia_prevista,
    Disparidad_Tasa_positiva_prevista = Tasa_positiva_prevista / Female_ref$Tasa_positiva_prevista,
    Disparidad_Falsos_positivos = Falsos_positivos / Female_ref$Falsos_positivos,
    Disparidad_Falsos_negativos = Falsos_negativos / Female_ref$Falsos_negativos,
    Disparidad_Verdaderos_positivos = Verdaderos_positivos / Female_ref$Verdaderos_positivos,
    Disparidad_Verdaderos_negativos = Verdaderos_negativos / Female_ref$Verdaderos_negativos,
    Disparidad_Tasa_de_descubrimiento_falso = Tasa_de_descubrimiento_falso / Female_ref$Tasa_de_descubrimiento_falso,
    Disparidad_Tasa_de_omisión_falsa = Tasa_de_omisión_falsa / Female_ref$Tasa_de_omisión_falsa,
    Disparidad_Tasa_de_falsos_positivos = Tasa_de_falsos_positivos / Female_ref$Tasa_de_falsos_positivos,
    Disparidad_Tasa_de_falsos_negativos = Tasa_de_falsos_negativos / Female_ref$Tasa_de_falsos_negativos
  )
# Imprimir el resultado
print.data.frame(disparidad_male)

##    sex Positivo_pronósticado Pronóstico_predictivo_total Negativo_previsto
## 1 Male                  1542                        2185              3320
##   Prevalencia_prevista Tasa_positiva_prevista Falsos_positivos Falsos_negativos
## 1            0.4494035              0.3171534              355              998
##   Verdaderos_positivos Verdaderos_negativos Tasa_de_descubrimiento_falso
## 1                 1187                 2322                    0.2302205
##   Tasa_de_omisión_falsa Tasa_de_falsos_positivos Tasa_de_falsos_negativos
## 1             0.3006024                0.1326111                0.4567506
##   Disparidad_Positivo_pronósticado Disparidad_Pronóstico_predictivo_total
## 1                         6.763158                               4.834071
##   Disparidad_Negativo_previsto Disparidad_Prevalencia_prevista
## 1                     3.648352                        1.131463
##   Disparidad_Tasa_positiva_prevista Disparidad_Falsos_positivos
## 1                          1.582985                     6.22807
##   Disparidad_Falsos_negativos Disparidad_Verdaderos_positivos
## 1                    3.551601                         6.94152
##   Disparidad_Verdaderos_negativos Disparidad_Tasa_de_descubrimiento_falso
## 1                        3.691574                                0.920882
##   Disparidad_Tasa_de_omisión_falsa Disparidad_Tasa_de_falsos_positivos
## 1                        0.9734811                            1.595987
##   Disparidad_Tasa_de_falsos_negativos
## 1                            0.734702

Disparidad de la variable Less than 25

Aquí se compara la disparidad entre los resultados de las métricas de sesgo usadas en el paso anterior. En este caso se cálcula la variable Menor a 25 en función de las variables entre 25 y 45 años y mayores de 45 años

# Calcular las métricas del grupo de referencia Less than 25
LessThan25_ref <- edad_metricas %>% filter(age_cat == "Less than 25")
# Calcular las métricas del grupo de referencia Greater than 45
GreaterThan45_ref <- edad_metricas %>% filter(age_cat == "Greater than 45")
# Calcular las métricas del grupo de referencia 25 - 45
Entre25_45_ref <- edad_metricas %>% filter(age_cat == "25 - 45")

# Calcular la disparidad de sesgo para cada métrica y cada grupo (LessThan25 respecto a Greater than 45)
disparidad_LessThan25_GreaterThan45 <- LessThan25_ref %>%
  mutate(
    Disparidad_Positivo_pronósticado = Positivo_pronósticado / GreaterThan45_ref$Positivo_pronósticado,
    Disparidad_Pronóstico_predictivo_total = Pronóstico_predictivo_total / GreaterThan45_ref$Pronóstico_predictivo_total,
    Disparidad_Negativo_previsto = Negativo_previsto / GreaterThan45_ref$Negativo_previsto,
    Disparidad_Prevalencia_prevista = Prevalencia_prevista / GreaterThan45_ref$Prevalencia_prevista,
    Disparidad_Tasa_positiva_prevista = Tasa_positiva_prevista / GreaterThan45_ref$Tasa_positiva_prevista,
    Disparidad_Falsos_positivos = Falsos_positivos / GreaterThan45_ref$Falsos_positivos,
    Disparidad_Falsos_negativos = Falsos_negativos / GreaterThan45_ref$Falsos_negativos,
    Disparidad_Verdaderos_positivos = Verdaderos_positivos / GreaterThan45_ref$Verdaderos_positivos,
    Disparidad_Verdaderos_negativos = Verdaderos_negativos / GreaterThan45_ref$Verdaderos_negativos,
    Disparidad_Tasa_de_descubrimiento_falso = Tasa_de_descubrimiento_falso / GreaterThan45_ref$Tasa_de_descubrimiento_falso,
    Disparidad_Tasa_de_omisión_falsa = Tasa_de_omisión_falsa / GreaterThan45_ref$Tasa_de_omisión_falsa,
    Disparidad_Tasa_de_falsos_positivos = Tasa_de_falsos_positivos / GreaterThan45_ref$Tasa_de_falsos_positivos,
    Disparidad_Tasa_de_falsos_negativos = Tasa_de_falsos_negativos / GreaterThan45_ref$Tasa_de_falsos_negativos
  )
print.data.frame(disparidad_LessThan25_GreaterThan45)

##        age_cat Positivo_pronósticado Pronóstico_predictivo_total
## 1 Less than 25                   261                         840
##   Negativo_previsto Prevalencia_prevista Tasa_positiva_prevista
## 1              1048            0.6417112              0.1993888
##   Falsos_positivos Falsos_negativos Verdaderos_positivos Verdaderos_negativos
## 1               19              598                  242                  450
##   Tasa_de_descubrimiento_falso Tasa_de_omisión_falsa Tasa_de_falsos_positivos
## 1                   0.07279693             0.5706107               0.04051173
##   Tasa_de_falsos_negativos Disparidad_Positivo_pronósticado
## 1                0.7119048                        0.7631579
##   Disparidad_Pronóstico_predictivo_total Disparidad_Negativo_previsto
## 1                               3.088235                     1.128095
##   Disparidad_Prevalencia_prevista Disparidad_Tasa_positiva_prevista
## 1                        2.998584                         0.7410036
##   Disparidad_Falsos_positivos Disparidad_Falsos_negativos
## 1                   0.1233766                    7.119048
##   Disparidad_Verdaderos_positivos Disparidad_Verdaderos_negativos
## 1                        1.287234                       0.5325444
##   Disparidad_Tasa_de_descubrimiento_falso Disparidad_Tasa_de_omisión_falsa
## 1                               0.1616659                         6.310682
##   Disparidad_Tasa_de_falsos_positivos Disparidad_Tasa_de_falsos_negativos
## 1                           0.2628001                            2.305215

# Calcular la disparidad de sesgo para cada métrica y cada grupo (LessThan25 respecto a 25-45)
disparidad_LessThan25_25_45 <- LessThan25_ref %>%
  mutate(
    Disparidad_Positivo_pronósticado = Positivo_pronósticado / Entre25_45_ref$Positivo_pronósticado,
    Disparidad_Pronóstico_predictivo_total = Pronóstico_predictivo_total / Entre25_45_ref$Pronóstico_predictivo_total,
    Disparidad_Negativo_previsto = Negativo_previsto / Entre25_45_ref$Negativo_previsto,
    Disparidad_Prevalencia_prevista = Prevalencia_prevista / Entre25_45_ref$Prevalencia_prevista,
    Disparidad_Tasa_positiva_prevista = Tasa_positiva_prevista / Entre25_45_ref$Tasa_positiva_prevista,
    Disparidad_Falsos_positivos = Falsos_positivos / Entre25_45_ref$Falsos_positivos,
    Disparidad_Falsos_negativos = Falsos_negativos / Entre25_45_ref$Falsos_negativos,
    Disparidad_Verdaderos_positivos = Verdaderos_positivos / Entre25_45_ref$Verdaderos_positivos,
    Disparidad_Verdaderos_negativos = Verdaderos_negativos / Entre25_45_ref$Verdaderos_negativos,
    Disparidad_Tasa_de_descubrimiento_falso = Tasa_de_descubrimiento_falso / Entre25_45_ref$Tasa_de_descubrimiento_falso,
    Disparidad_Tasa_de_omisión_falsa = Tasa_de_omisión_falsa / Entre25_45_ref$Tasa_de_omisión_falsa,
    Disparidad_Tasa_de_falsos_positivos = Tasa_de_falsos_positivos / Entre25_45_ref$Tasa_de_falsos_positivos,
    Disparidad_Tasa_de_falsos_negativos = Tasa_de_falsos_negativos / Entre25_45_ref$Tasa_de_falsos_negativos
  )

print.data.frame(disparidad_LessThan25_25_45)

##        age_cat Positivo_pronósticado Pronóstico_predictivo_total
## 1 Less than 25                   261                         840
##   Negativo_previsto Prevalencia_prevista Tasa_positiva_prevista
## 1              1048            0.6417112              0.1993888
##   Falsos_positivos Falsos_negativos Verdaderos_positivos Verdaderos_negativos
## 1               19              598                  242                  450
##   Tasa_de_descubrimiento_falso Tasa_de_omisión_falsa Tasa_de_falsos_positivos
## 1                   0.07279693             0.5706107               0.04051173
##   Tasa_de_falsos_negativos Disparidad_Positivo_pronósticado
## 1                0.7119048                        0.2236504
##   Disparidad_Pronóstico_predictivo_total Disparidad_Negativo_previsto
## 1                              0.5508197                    0.4651576
##   Disparidad_Prevalencia_prevista Disparidad_Tasa_positiva_prevista
## 1                        1.439116                         0.5843272
##   Disparidad_Falsos_positivos Disparidad_Falsos_negativos
## 1                  0.07949791                    1.001675
##   Disparidad_Verdaderos_positivos Disparidad_Verdaderos_negativos
## 1                       0.2607759                       0.2717391
##   Disparidad_Tasa_de_descubrimiento_falso Disparidad_Tasa_de_omisión_falsa
## 1                               0.3554562                          2.15341
##   Disparidad_Tasa_de_falsos_positivos Disparidad_Tasa_de_falsos_negativos
## 1                           0.3212122                            1.818517

Disparidad de la variable Caucasian

Aquí se compara la disparidad entre los resultados de las métricas de sesgo usadas en el paso anterior. En este caso se cálcula la variable Caucasian en función de las variables..

Programacion y aprendizaje de maquina

Javier Adolfo Carrillo Romero

2023-06-12

Programacion y aprendizaje de maquina

Contexto

Establecimiento del ambiente de trabajo

Paso 1. Modelo de clasificación

Separa en conjunto de prueba y entrenamiento

Modelos usados

Validación cruzada

Selección del modelo

Paso 2. Validación del modelo

Paso 3. Métricas de auditoría de Sesgo y Equidad [Aequitas]

Matriz de confusión

Evaluación de métricas para la variable sex (sexo)

Evaluación de métricas para la variable age_cat (categoría de edad)

Evaluación de métricas para la variable race (raza)

Cálculo de disparidad

Disparidad de la variable Male

Disparidad de la variable Less than 25

Disparidad de la variable Caucasian

Generar archivo con todas las métricas

Paso 4. Recomendación

Generar gráfico

Referencias