---
title: "IA para Científicos Sociales"
subtitle: "Sesión 5.3: Laboratorio 9 - Modelos locales y auditoría de sesgo"
author:
  - name: Danilo Freire
    orcid: 0000-0002-4712-6810
    email: danilofreire@gmail.com
    affiliations: "Department of Data and Decision Sciences <br> Emory University"
format:
  clean-revealjs:
    self-contained: true
    footer: "[Sesión 5.3](https://danilofreire.github.io/introduccion-ia-ucu/clases/dia-05/19-laboratorio-09.html)"
    transition: slide
    transition-speed: default
    scrollable: true
revealjs-plugins:
  - multimodal
engine: knitr
editor:
  render-on-save: true
lang: es
execute:
  echo: true
---

```{r setup, include=FALSE}
options(htmltools.dir.version = FALSE)
library(knitr)
opts_chunk$set(
  prompt = T,
  fig.align = "center",
  dpi = 300,
  cache = T,
  message = FALSE,
  warning = FALSE,
  engine.opts = list(bash = "-l")
)

knit_hooks$set(
  prompt = function(before, options, envir) {
    options(
      prompt = if (options$engine %in% c("sh", "bash", "zsh")) "$ " else "R> ",
      continue = if (options$engine %in% c("sh", "bash", "zsh")) "$ " else "+ "
    )
  }
)

options(repos = c(CRAN = "https://cran.rstudio.com/"))
options(cli.progress_show_after = Inf)

if (!require("fontawesome", character.only = TRUE)) {
  install.packages("fontawesome", dependencies = TRUE)
  library(fontawesome, character.only = TRUE)
}
```

# Laboratorio 9: Modelos locales y auditoría de sesgo {background-color="#2d4563"}

## Objetivos del laboratorio

:::{style="margin-top: 30px; font-size: 24px;"}
:::{.columns}
:::{.column width=50%}
**Parte 1: un LLM en tu máquina (sesión 5.1)**

1. Verificar Ollama y conversar con [Granite](https://ollama.com/library/granite4.1) desde la terminal y desde R
2. Codificar datos sensibles (simulados) con [`quallmer`]{.alert} y el modelo local
3. [Validar]{.alert} la codificación contra un gold standard humano
:::

:::{.column width=50%}
**Parte 2: auditoría de equidad (sesión 5.2)**

4. Auditar un modelo de crédito con [`fairmodels`](https://modeloriented.github.io/fairmodels/index.html)
5. Calcular e interpretar [métricas de equidad]{.alert} por grupo
6. Discutir [mitigación]{.alert} y sus trade-offs
:::
:::

:::{style="margin-top: 20px; text-align: center; font-size: 24px;"}
[Las dos partes son las dos caras de la ética de hoy: proteger los datos de las personas y verificar que nuestros modelos no las traten de forma desigual]{.alert}
:::
:::

# Parte 1: Un LLM en tu máquina {background-color="#2d4563"}

## Verificar la instalación

:::{style="margin-top: 30px; font-size: 23px;"}
:::{.columns}
:::{.column width=52%}
En la terminal (no en R), verificá que Ollama está instalado y bajá el modelo de hoy:

```bash
ollama --version
ollama pull granite4.1:3b
```

[IBM Granite](https://www.ibm.com/granite) (~2,1 GB) responde directo, [sin razonar antes]{.alert}, y está afinado para [salida estructurada]{.alert}. Para codificar es justo lo que queremos: rápido y estable

**Probarlo en la terminal**

```bash
ollama run granite4.1:3b
```

Escribí un par de preguntas y salí con `/bye`
:::

:::{.column width=48%}
:::{style="font-size: 21px;"}
**¿Por qué no un modelo con razonamiento?**

Hay muchos modelos disponibles, incluso los *thinking models*, que razonan antes de responder. Para chatear están bien, pero para codificar tienen dos problemas:

- "Piensan" uno o dos minutos [por cada texto]{.alert}
- En Ollama, apagarles el razonamiento suele romper la [salida estructurada]{.alert} que `quallmer` necesita

:::{.callout-note}
**Pista**: elegir el modelo correcto es parte del oficio. Un modelo con razonamiento para problemas difíciles; uno directo y afinado para salida estructurada, como Granite, para tareas repetitivas como la codificación
:::
:::
:::
:::
:::

## Conectar desde R

:::{style="margin-top: 30px; font-size: 22px;"}
El mismo `ellmer` del lab 7, otro proveedor: `chat_ollama()` en lugar de `chat_openrouter()`. Sin API key, sin internet

```{r}
#| echo: true
#| eval: true
#| cache: true
library(tidyverse)
library(ellmer)
library(quallmer)

chat <- chat_ollama(
  model = "granite4.1:3b",
  system_prompt = "Sos un asistente de investigación social. Respondé en español, en una sola oración."
)

chat$chat("¿Qué es una encuesta de victimización?")
```

:::{style="margin-top: 15px;"}
La primera llamada tarda unos segundos: el modelo se está cargando en memoria. Las siguientes son más rápidas
:::
:::

## El caso: entrevistas que no pueden salir de la máquina

:::{style="margin-top: 30px; font-size: 21px;"}
:::{.columns}
:::{.column width=55%}
- Un equipo entrevistó a [víctimas de delitos que no hicieron la denuncia]{.alert} (un problema clásico de las encuestas de victimización)
- Los fragmentos contienen [detalles identificables]{.alert}: barrios, rutinas, conflictos con vecinos
- El consentimiento informado y el comité de ética [prohíben transferir]{.alert} el material a terceros, lo que incluye una API en la nube
- Queremos codificar el [motivo principal]{.alert} por el que cada persona no denunció

| Código | Significado |
|---|---|
| `desconfianza` | No cree que la policía o la justicia hagan algo |
| `miedo` | Teme represalias del agresor |
| `costo` | El trámite cuesta tiempo o esfuerzo |
| `poca_gravedad` | No consideró el hecho suficientemente grave |
| `resolucion_propia` | Lo resolvió por otra vía |
:::

:::{.column width=45%}
:::{style="font-size: 21px;"}
**Los datos**

```{r}
#| echo: true
#| eval: true
#| cache: true
entrevistas <- read_csv("datos/entrevistas_confianza.csv")
# Leé el archivo directo desde la web:
# entrevistas <- read_csv("https://raw.githubusercontent.com/danilofreire/introduccion-ia-ucu/main/clases/dia-05/datos/entrevistas_confianza.csv")

entrevistas |> count(motivo_humano)
```

`motivo_humano` es el gold standard: la codificación manual del equipo

:::{.callout-warning}
Los datos son simulados, pero el flujo de trabajo es exactamente el que usarían con entrevistas reales
:::
:::
:::
:::
:::

## Paso 1: definir el codebook

:::{style="margin-top: 20px; font-size: 20px;"}
El mismo `qlm_codebook()` del lab 8. La diferencia: la variable es [nominal]{.alert} (categorías), no una escala de intervalo

```{r}
#| echo: true
#| eval: true
#| cache: true
codebook_motivos <- qlm_codebook(
  name = "motivos_no_denuncia",
  instructions = "Leé el fragmento de entrevista. La persona fue víctima de un delito
  y no hizo la denuncia. Clasificá el MOTIVO PRINCIPAL en una de estas categorías:
  - desconfianza: no cree que la policía o la justicia investiguen o resuelvan nada
  - miedo: teme represalias del agresor o de su entorno
  - costo: el trámite implica demasiado tiempo, viajes o burocracia
  - poca_gravedad: considera que el hecho no fue suficientemente grave
  - resolucion_propia: resolvió el problema por su cuenta o por otra vía
  Elegí UNA sola categoría, la que mejor capture el motivo central del relato.",
  schema = type_object(
    motivo = type_enum(
      c("desconfianza", "miedo", "costo", "poca_gravedad", "resolucion_propia"),
      "El motivo principal por el que no denunció"
    ),
    justificacion = type_string("Una oración que justifique la categoría elegida")
  ),
  role = "Sos un investigador experto en criminología y encuestas de victimización.",
  levels = list(motivo = "nominal", justificacion = "nominal")
)
```
:::

## Paso 2: codificar con el modelo local

:::{style="margin-top: 30px; font-size: 21px;"}
:::{.columns}
:::{.column width=55%}
El mismo `qlm_code()` de ayer. Lo único que cambia es el string del modelo: `"ollama/..."` en lugar de `"openrouter/..."`

```{r}
#| echo: true
#| eval: true
#| cache: true
codificado <- qlm_code(
  entrevistas$texto,
  codebook_motivos,
  model = "ollama/granite4.1:3b",
  max_active = 1,
  params = params(temperature = 0),
  name = "granite_local"
)
```
:::

:::{.column width=45%}
:::{style="font-size: 21px;"}
**Qué está pasando**

- Cada fragmento viaja al servidor local de Ollama, [no a internet]{.alert}
- El modelo devuelve la categoría y una justificación, con el esquema garantizado por `type_enum()`

:::{.callout-warning}
`max_active = 1` es importante: el servidor local procesa de a un pedido. Con varios pedidos en paralelo, los demás esperan y dan timeout. No hay errores `400` de la API, pero el paralelismo de la nube acá no existe
:::
:::
:::
:::
:::

## Inspeccionar los resultados

:::{style="margin-top: 30px; font-size: 21px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true
resultados <- as_tibble(codificado) |>
  mutate(texto = str_trunc(entrevistas$texto, 60), gold = entrevistas$motivo_humano) |>
  select(texto, motivo, gold)

resultados
```

:::{style="margin-top: 10px;"}
A simple vista: ¿dónde coincide con el equipo humano y dónde no?
:::
:::

## Paso 3: validar contra el gold standard

:::{style="margin-top: 30px; font-size: 21px;"}
:::{.columns}
:::{.column width=55%}
```{r}
#| echo: true
#| eval: true
#| cache: true
gold <- qlm_humancoded(
  tibble(
    .id = seq_len(nrow(entrevistas)),
    motivo = entrevistas$motivo_humano
  ),
  name = "humano",
  codebook = codebook_motivos
)

validacion <- qlm_validate(
  codificado,
  gold = gold,
  by = "motivo",
  level = "nominal"
)

as_tibble(validacion) |> select(measure, value)
```
:::

:::{.column width=45%}
:::{style="font-size: 21px;"}
**Cómo leer esto**

- [Accuracy]{.alert}: proporción de coincidencias exactas
- [Kappa / alpha]{.alert}: acuerdo corregido por azar. Con 5 categorías, adivinar da ~20%, así que el acuerdo bruto exagera
- La referencia del lab 8 sigue valiendo: kappa ≥ 0,7 para confiar en el codificador

:::{.callout-note appearance="simple" icon=false}
**Pista**: si el modelo local rinde cerca del humano, ganamos un codificador gratuito, privado y reproducible. Si no, el ejercicio 1 muestra el primer remedio: mejorar el codebook
:::
:::
:::
:::
:::

## ¿Dónde se equivoca?

:::{style="margin-top: 30px; font-size: 21px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true
resultados |> filter(motivo != gold)
```

:::{style="margin-top: 15px;"}
- Los errores rara vez son aleatorios: suelen concentrarse en [fronteras entre categorías]{.alert} (¿"desconfianza" o "miedo"? ¿"costo" o "poca_gravedad"?)
- Esas fronteras confusas también confunden a codificadores humanos. La solución clásica es la misma: [reglas de decisión explícitas]{.alert} en el codebook
:::

[[Ejercicio 1: mejorar el codebook]{.button}](#sec:exercise01)
:::

# Parte 2: Auditoría de equidad {background-color="#2d4563"}

## De los LLMs a nuestros propios modelos

:::{style="margin-top: 30px; font-size: 23px;"}
:::{.columns}
:::{.column width=50%}
**Lo que acabamos de hacer**

Auditar la [calidad]{.alert} de un codificador automático: ¿acierta?

**Lo que sigue**

Auditar la [equidad]{.alert} de un clasificador como los de los días 1 y 2: ¿acierta [igual para todos los grupos]{.alert}?
:::

:::{.column width=50%}
:::{style="font-size: 23px;"}
**El caso de estudio**

El dataset [German Credit](https://archive.ics.uci.edu/dataset/144/statlog+german+credit+data), un clásico en estudios de sesgo algorítmico:

- 1000 solicitudes de crédito
- Variable objetivo: buen/mal pagador
- Atributo protegido: sexo
- La pregunta de la sesión 5.2: ¿el modelo trata igual a hombres y mujeres?
:::
:::
:::
:::

## Preparación

:::{style="margin-top: 30px; font-size: 24px;"}

```{r}
#| echo: true
#| eval: true

# Instalar paquetes si no están disponibles
if (!require("fairmodels")) install.packages("fairmodels")
if (!require("DALEX")) install.packages("DALEX")

# Cargar paquetes
library(tidymodels)
library(fairmodels)
library(DALEX)
```

[`fairmodels`](https://modeloriented.github.io/fairmodels/index.html) usa explicadores de DALEX para auditar modelos. Funciona con cualquier modelo de clasificación

Para más informaciones, ver la [documentación oficial]{.alert} y el [artículo oficial]{.alert}: <https://modeloriented.github.io/fairmodels/articles/fairmodels.html> y <https://arxiv.org/abs/2104.00507>
:::

## El dataset German Credit

:::{style="margin-top: 30px; font-size: 22px;"}
:::{.columns}
:::{.column width=50%}
```{r}
#| echo: true
#| eval: true
#| cache: true
# Cargar datos incluidos en fairmodels
data("german", package = "fairmodels")

# Explorar estructura
glimpse(german)
```
:::

:::{.column width=50%}
**Variables clave:**

- `Risk`: variable objetivo (good/bad)
- `Sex`: atributo protegido
- `Age`: otro atributo sensible
- Variables de crédito: monto, duración, historial

El dataset es de los años 1990 y tiene [sesgos históricos conocidos]{.alert}. Documentación completa: <https://archive.ics.uci.edu/dataset/144/statlog+german+credit+data>
:::
:::
:::

## Explorar el atributo protegido

:::{style="margin-top: 30px; font-size: 22px;"}

```{r}
#| echo: true
#| eval: true
#| fig-width: 10
#| fig-height: 4
#| cache: true

# Distribución de Risk por Sex
german |>
  count(Sex, Risk) |>
  group_by(Sex) |>
  mutate(prop = n / sum(n)) |>
  ggplot(aes(x = Sex, y = prop, fill = Risk)) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = c("good" = "#2d4563", "bad" = "#e63946")) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "Distribución de riesgo crediticio por sexo",
       y = "Proporción", x = "Sexo", fill = "Riesgo") +
  theme_minimal(base_size = 14)
```

:::{style="margin-top: 10px;"}
Las [tasas base]{.alert} son similares entre grupos, lo que facilita la comparación de métricas
:::
:::

## Preparar los datos

:::{style="margin-top: 30px; font-size: 22px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true

# Dividir en train/test (estratificado por el resultado)
set.seed(123)
split <- initial_split(german, prop = 0.7, strata = Risk)
train_data <- training(split)
test_data <- testing(split)

cat("Entrenamiento:", nrow(train_data), "filas\n")
cat("Test:", nrow(test_data), "filas\n")
```

Usaremos el conjunto de [test]{.alert} para evaluar equidad, ya que representa datos no vistos
:::

## Entrenar una regresión logística

:::{style="margin-top: 30px; font-size: 22px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true

# Resultado binario y datos sin Sex (el atributo protegido)
datos_modelo <- train_data |>
  mutate(buen_pagador = ifelse(Risk == "good", 1, 0)) |>
  select(-Risk, -Sex)

# Regresión logística: el clasificador clásico del día 2
modelo <- glm(buen_pagador ~ ., data = datos_modelo, family = binomial)

# Probabilidad de "good" en test y decisión a 0.5
pred_probs <- predict(modelo, test_data, type = "response")
pred_class <- ifelse(pred_probs > 0.5, "good", "bad")

# Accuracy global
accuracy <- mean(pred_class == test_data$Risk)
cat("Accuracy global:", round(accuracy, 3), "\n")
```

[El modelo no usa Sex como variable]{.alert}, pero ¿eso garantiza que sea justo? La sesión 5.2 sugiere que no: los proxies existen
:::

## Crear el explicador DALEX

:::{style="margin-top: 30px; font-size: 22px;"}
:::{.columns}
:::{.column width=55%}
```{r}
#| echo: true
#| eval: true
#| cache: true

# Crear explicador DALEX
explainer <- DALEX::explain(
  model = modelo,
  data = test_data |> select(-Risk, -Sex),
  y = as.numeric(test_data$Risk == "good"),
  label = "Regresión logística",
  verbose = FALSE
)
```

Ver [Wiśniewski y Biecek (2022)](https://arxiv.org/abs/2104.00507) para más detalles sobre los métodos de clasificación de sesgos
:::

:::{.column width=45%}
:::{style="font-size: 22px;"}
Un [explicador]{.alert} es un objeto que envuelve todo lo que fairmodels necesita para auditar:

- El modelo entrenado
- Los datos de test
- La variable objetivo (0/1)

Para un `glm`, DALEX ya sabe cómo pedir las predicciones: no hace falta una [función a medida]{.alert}

Es el paso intermedio: modelo → explicador → auditoría
:::
:::
:::
:::

## La auditoría: fairness_check()

:::{style="margin-top: 30px; font-size: 22px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true

# Crear objeto fairness con Sex como atributo protegido
fobject <- fairness_check(
  explainer,
  protected = test_data$Sex,
  privileged = "male",  # grupo de referencia
  cutoff = 0.5,         # umbral de decisión
  verbose = TRUE
)

# Ver resumen
print(fobject)
```

El grupo [privilegiado]{.alert} es el de referencia. Las métricas comparan otros grupos con este
:::

## Visualizar métricas de equidad

:::{style="margin-top: 30px; font-size: 22px;"}
La zona verde es la [regla del 80%]{.alert} de la sesión 5.2: un ratio entre 0,8 y 1,25 se considera aceptable. Fuera de ella hay disparidad

```{r}
#| echo: true
#| eval: true
#| fig-width: 10
#| fig-height: 5
#| cache: true

plot(fobject)
```
:::

## Interpretar las métricas {#sec:interpretar-metricas}

:::{style="margin-top: 20px; font-size: 20px;"}
Cada fila de la salida (y cada barra del gráfico anterior) es un [ratio entre grupos]{.alert} (mujeres ÷ hombres): 1,0 es igualdad perfecta y la zona verde (0,8 a 1,25) es la regla del 80%. El resultado "positivo" acá es [recibir el crédito]{.alert} (que el modelo prediga `good`)

| Nombre en la salida | Fórmula | Qué pregunta, en crédito | En una frase |
|---|---|---|---|
| [Accuracy equality]{.alert} (ACC) | (TP+TN)/total | ¿Acierta con la misma frecuencia en cada grupo? | Mismo nivel de aciertos |
| [Equal opportunity]{.alert} (TPR) | TP/(TP+FN) | De quienes [sí]{.alert} pagarían, ¿qué proporción recibe el crédito? | Igualdad de oportunidades |
| [Predictive equality]{.alert} (FPR) | FP/(FP+TN) | De quienes [no]{.alert} pagarían, ¿qué proporción se aprueba por error? | Mismo nivel de errores costosos |
| [Predictive parity]{.alert} (PPV) | TP/(TP+FP) | De quienes el modelo [aprueba]{.alert}, ¿qué proporción sí paga? | Calibración: "aprobado" significa lo mismo |
| [Statistical parity]{.alert} (STP) | (TP+FP)/total | ¿Qué proporción de cada grupo recibe un "aprobado"? | Paridad demográfica |

:::{style="margin-top: 10px;"}
La tabla de confusión, en crédito: [TP]{.alert} aprobado y paga · [FP]{.alert} aprobado y no paga · [TN]{.alert} rechazado y no pagaría · [FN]{.alert} rechazado pero sí pagaría
:::
:::

## Mitigación: umbrales diferenciados {#sec:mitigacion}

:::{style="margin-top: 30px; font-size: 20px;"}
:::{.columns}
:::{.column width=70%}
Una estrategia de [post-procesamiento]{.alert} (sesión 5.2): umbrales distintos por grupo para igualar un tipo de error

```{r}
#| echo: true
#| eval: true
#| cache: true

# Un umbral por grupo: 0.5 para hombres, 0.4 para mujeres
umbral <- ifelse(test_data$Sex == "male", 0.5, 0.4)
mitigated_pred <- ifelse(pred_probs > umbral, "good", "bad")

test_data |>
  mutate(orig = pred_class, mitig = mitigated_pred) |>
  group_by(Sex) |>
  summarise(
    fpr_orig = sum(orig == "good" & Risk == "bad") / sum(Risk == "bad"),
    fpr_mitig = sum(mitig == "good" & Risk == "bad") / sum(Risk == "bad"),
    acc_orig = mean(orig == Risk),
    acc_mitig = mean(mitig == Risk),
    .groups = "drop"
  ) |>
  mutate(across(where(is.numeric), ~round(., 3)))
```
:::

:::{.column width=30%}
:::{style="font-size: 21px;"}
**Consideraciones**

- ¿Es justo usar [umbrales diferentes]{.alert} por grupo? Algunos lo llaman discriminación inversa; otros, corrección de un sesgo sistémico
- La mitigación [mueve]{.alert} el problema: mejora una métrica y empeora otra

:::{style="margin-top: 15px; background: rgba(45, 69, 99, 0.1); padding: 15px; border-radius: 10px;"}
[La decisión de usar umbrales diferenciados es política, no técnica]{.alert}
:::

[[Apéndice: explorar umbrales en detalle]{.button}](#sec:apendice-umbrales)
:::
:::
:::
:::

# Discusión {background-color="#2d4563"}

## Actividad: recomendación al banco

:::{style="margin-top: 30px; font-size: 22px;"}
:::{.columns}
:::{.column width=50%}
**Escenario:**

Son consultores de un banco uruguayo que quiere implementar un modelo de scoring crediticio

El análisis muestra que el modelo tiene:

- [FPR más alto para mujeres]{.alert}: más mujeres buenas pagadoras son rechazadas
- [Accuracy similar]{.alert} entre grupos
- [Calibración correcta]{.alert}: las probabilidades significan lo mismo

El banco les pide una recomendación
:::

:::{.column width=50%}
**Preguntas para discutir (5 min):**

1. ¿Deberían usar [umbrales diferenciados]{.alert} por sexo?
2. Si lo hacen, ¿es [discriminación positiva]{.alert} o simplemente [corrección de sesgo]{.alert}?
3. ¿Qué [métrica de equidad]{.alert} priorizarían y por qué?
4. ¿Cómo [comunicarían]{.alert} la decisión a los clientes?
5. ¿La ley uruguaya permite trato diferenciado por sexo en decisiones de crédito?

:::{style="margin-top: 15px; background: rgba(45, 69, 99, 0.1); padding: 15px; border-radius: 10px;"}
**Divídanse en grupos de 4**
:::
:::
:::
:::

# Ejercicios {background-color="#2d4563"}

## Ejercicio 1: mejorar el codebook {#sec:exercise01}

:::{style="margin-top: 30px; font-size: 22px;"}
:::{.columns}
:::{.column width=55%}
**Tarea (5 min):**

Vimos que los errores del modelo se concentran en fronteras entre categorías. Mejoren el codebook con [reglas de decisión explícitas]{.alert} y midan si la validación mejora

1. Copien `codebook_motivos` y agreguen a `instructions` reglas para los casos límite. Por ejemplo: si hay amenazas o temor a represalias, es `miedo` aunque también haya desconfianza
2. Re-codifiquen con `qlm_code()` y el modelo local
3. Vuelvan a correr `qlm_validate()` y comparen las métricas
:::

:::{.column width=45%}
:::{style="font-size: 22px;"}
**Pistas**

- Las reglas de decisión y el orden de prioridad entre categorías son práctica estándar en codebooks cualitativos. El LLM las aprovecha igual que un asistente humano
- Revisen los errores de la diapositiva "¿Dónde se equivoca?" para decidir qué reglas escribir

[[Solución]{.button}](#sec:appendix01)
:::
:::
:::
:::

## Ejercicio 2: auditar con otra variable protegida {#sec:exercise02}

:::{style="margin-top: 30px; font-size: 22px;"}
:::{.columns}
:::{.column width=55%}
**Tarea:**

Repitan la auditoría de la Parte 2 usando [edad]{.alert} como variable protegida.

1. Crear grupos de edad (jóvenes < 30, adultos 30-50, mayores > 50)
2. Crear un nuevo `fairness_check()` con esos grupos
3. Visualizar y identificar qué grupo es más perjudicado

**Código inicial:**

```{r}
#| echo: true
#| eval: false
#| cache: true
test_data <- test_data |>
  mutate(
    Age_group = case_when(
      Age < 30 ~ "joven",
      Age < 50 ~ "adulto",
      TRUE ~ "mayor"
    )
  )

fobject_age <- fairness_check(
  explainer,
  protected = test_data$Age_group,
  privileged = "adulto",
  cutoff = 0.5,
  verbose = FALSE
)

plot(fobject_age)
```
:::

:::{.column width=45%}
**Preguntas a responder:**

1. ¿Qué grupo de edad tiene peor rendimiento?

2. ¿En qué métricas hay mayor disparidad?

3. ¿Tiene sentido que [adultos]{.alert} sean el grupo privilegiado?

4. ¿Cómo se compara el sesgo por edad con el sesgo por sexo?

:::{style="margin-top: 20px; background: rgba(230, 57, 70, 0.1); padding: 15px; border-radius: 10px;"}
Trabajen individualmente o en parejas. Pueden consultar la documentación de fairmodels
:::

[[Solución]{.button}](#sec:appendix02)
:::
:::
:::

## Resumen del laboratorio

:::{style="margin-top: 30px; font-size: 23px;"}
:::{.columns}
:::{.column width=50%}
**Parte 1: el modelo local**

- `chat_ollama()` y `model = "ollama/..."`: el flujo de los labs 7 y 8, [sin que los datos salgan de la máquina]{.alert}
- El codebook con [reglas de decisión]{.alert} es la herramienta para mejorar al codificador
- Validar contra gold standard sigue siendo [obligatorio]{.alert}, local o nube
:::

:::{.column width=50%}
**Parte 2: la auditoría**

- Un modelo [sin variables sensibles]{.alert} puede seguir siendo sesgado
- `fairness_check()` compara métricas entre grupos; la zona verde es la regla del 80%
- La [mitigación]{.alert} implica trade-offs y las decisiones de equidad son políticas, no sólo técnicas
:::
:::

:::{style="margin-top: 20px; text-align: center;"}
[En la próxima sesión: mini-propuestas de investigación y cierre del curso]{.alert}
:::
:::

# Apéndice {background-color="#2d4563"}

## Solución Ejercicio 1 {#sec:appendix01}

:::{style="margin-top: 20px; font-size: 19px;"}
Un codebook con reglas de decisión para los casos límite:

```{r}
#| echo: true
#| eval: true
#| cache: true
codebook_motivos_v2 <- qlm_codebook(
  name = "motivos_no_denuncia_v2",
  instructions = "Leé el fragmento de entrevista. La persona fue víctima de un delito
  y no hizo la denuncia. Clasificá el MOTIVO PRINCIPAL en una de estas categorías:
  - desconfianza: no cree que la policía o la justicia investiguen o resuelvan nada
  - miedo: teme represalias del agresor o de su entorno
  - costo: el trámite implica demasiado tiempo, viajes o burocracia
  - poca_gravedad: considera que el hecho no fue suficientemente grave
  - resolucion_propia: resolvió el problema por su cuenta o por otra vía
  Reglas de decisión, en orden de prioridad:
  1. Si menciona amenazas, represalias o temor por su seguridad o la de su familia,
     es 'miedo', aunque también exprese desconfianza en la policía.
  2. Si el problema ya se resolvió por otra vía (acuerdo, devolución, gestión propia),
     es 'resolucion_propia', aunque el hecho fuera menor.
  3. Si el obstáculo es el trámite (tiempo, distancia, burocracia, sistemas caídos),
     es 'costo', aunque el monto perdido sea chico.
  4. 'poca_gravedad' sólo cuando el argumento central es que el hecho no era serio.
  Elegí UNA sola categoría.",
  schema = type_object(
    motivo = type_enum(
      c("desconfianza", "miedo", "costo", "poca_gravedad", "resolucion_propia"),
      "El motivo principal por el que no denunció"
    ),
    justificacion = type_string("Una oración que justifique la categoría elegida")
  ),
  role = "Sos un investigador experto en criminología y encuestas de victimización.",
  levels = list(motivo = "nominal", justificacion = "nominal")
)
```
:::

## Solución Ejercicio 1 (continuación)

:::{style="margin-top: 30px; font-size: 21px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true
codificado_v2 <- qlm_code(
  entrevistas$texto,
  codebook_motivos_v2,
  model = "ollama/granite4.1:3b",
  max_active = 1,
  params = params(temperature = 0),
  name = "granite_local_v2"
)

validacion_v2 <- qlm_validate(
  codificado_v2,
  gold = gold,
  by = "motivo",
  level = "nominal"
)

as_tibble(validacion_v2) |> select(measure, value)
```

:::{style="margin-top: 15px;"}
- Comparen con la validación original. Con 16 textos, cada caso vale [6 puntos]{.alert} de accuracy, así que la mejora puede ser chica o nula en esta muestra. El efecto de las reglas se nota en corpus grandes y en la [estabilidad]{.alert} entre corridas
- La lección metodológica: cuando el codificador falla, el primer sospechoso es el [codebook]{.alert}, no el modelo
:::

[[Volver al ejercicio]{.button}](#sec:exercise01)
:::

## Solución Ejercicio 2 {#sec:appendix02}

:::{style="margin-top: 30px; font-size: 20px;"}

```{r}
#| echo: true
#| eval: true
#| fig-width: 10
#| fig-height: 4
#| cache: true
# Crear grupos de edad
test_data <- test_data |>
  mutate(
    Age_group = case_when(
      Age < 30 ~ "joven",
      Age < 50 ~ "adulto",
      TRUE ~ "mayor"
    )
  )

# Crear objeto fairness por edad
fobject_age <- fairness_check(
  explainer,
  protected = test_data$Age_group,
  privileged = "adulto",
  cutoff = 0.5,
  verbose = FALSE
)

# Visualizar
plot(fobject_age)
```

[[Volver al ejercicio]{.button}](#sec:exercise02)
:::

## Apéndice: explorar umbrales en detalle {#sec:apendice-umbrales}

:::{style="margin-top: 30px; font-size: 21px;"}

```{r}
#| echo: true
#| eval: true
#| cache: true
# Función para calcular métricas con umbral personalizado
calc_metrics_threshold <- function(data, probs, threshold) {
  pred <- ifelse(probs > threshold, "good", "bad")
  data |>
    mutate(pred = pred) |>
    group_by(Sex) |>
    summarise(
      threshold = threshold,
      accuracy = mean(pred == Risk),
      tpr = sum(pred == "good" & Risk == "good") / sum(Risk == "good"),
      fpr = sum(pred == "good" & Risk == "bad") / sum(Risk == "bad"),
      .groups = "drop"
    )
}

# Probar varios umbrales
thresholds <- c(0.3, 0.4, 0.5, 0.6, 0.7)
results <- map_dfr(thresholds, ~calc_metrics_threshold(test_data, pred_probs, .x))

results |>
  arrange(Sex, threshold) |>
  mutate(across(where(is.numeric), ~round(., 3)))
```
:::

[[Volver a mitigación]{.button}](#sec:mitigacion)

## Apéndice: visualizar el trade-off

:::{style="margin-top: 30px; font-size: 22px;"}

```{r}
#| echo: true
#| eval: true
#| fig-width: 10
#| fig-height: 4
#| cache: true
results |>
  pivot_longer(cols = c(accuracy, tpr, fpr), names_to = "metric", values_to = "value") |>
  ggplot(aes(x = factor(threshold), y = value, color = Sex, group = Sex)) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  facet_wrap(~metric, scales = "free_y") +
  scale_color_manual(values = c("female" = "#e63946", "male" = "#2d4563")) +
  labs(title = "Efecto del umbral en métricas por grupo",
       x = "Umbral", y = "Valor") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "bottom")
```

:::{style="margin-top: 10px;"}
[Diferentes umbrales afectan a los grupos de manera diferente.]{.alert} En crédito: un falso positivo es un préstamo que no se paga; un falso negativo, un buen cliente rechazado
:::

[[Volver a mitigación]{.button}](#sec:mitigacion)
:::

## Apéndice: ¿cuánta calidad cuesta la privacidad?

:::{style="margin-top: 30px; font-size: 21px;"}
:::{.columns}
:::{.column width=55%}
Si los datos [no fueran]{.alert} sensibles, podríamos comparar el codificador local contra uno de la nube. `qlm_replicate()` acepta un modelo distinto:

```{r}
#| echo: true
#| eval: false
#| cache: true
codificado_nube <- qlm_replicate(
  codificado,
  model = "openrouter/nvidia/nemotron-3-super-120b-a12b:free",
  max_active = 3,
  name = "nemotron_nube"
)

qlm_compare(
  codificado, codificado_nube,
  by = "motivo", level = "nominal"
)

qlm_validate(
  codificado_nube,
  gold = gold, by = "motivo", level = "nominal"
)
```
:::

:::{.column width=45%}
:::{style="font-size: 21px;"}
**Para qué sirve**

- `qlm_compare()` mide cuánto coinciden los dos codificadores
- Las dos validaciones contra el gold standard responden la pregunta de la sesión 5.1: [¿cuánta precisión cuesta correr local?]{.alert}

:::{.callout-warning}
Requiere la API key de OpenRouter del lab 7, por eso no se ejecuta en estas diapositivas. Pruébenlo en casa con los datos simulados (nunca con datos sensibles reales)
:::
:::
:::
:::
:::

# Nos vemos en la sesión 5.4 😊 {background-color="#2d4563"}