Charla: predicciones y decisiones, más allá de los errores cuadráticos

El próximo 29 de noviembre (de 2018) de febrero daré una charla dentro del ciclo de Data Konferences de Kschool.

Para la mía han creado el siguiente cartelito:

El resumen que preparé es:

Se hace ciencia de datos para tomar decisiones. Las predicciones, mejores o peores, alimentan procesos de decisión (p.e., ¿se concede este préstamo?). Sin embargo, existe una brecha enorme (en términos de equipos responsables y de comunicación entre ambos) entre quienes construyen los procesos predictivos y quienes toman las decisiones finales. A falta de mejor criterio, los científicos de datos utilizan funciones de pérdida genéricas (p.e., el RMSE) y prestan una atención excesiva a la estimación puntual. Ambas son decisiones subóptimas. Integrar el proceso predictivo en el de toma de decisiones conduciría de forma natural a la adopción de funciones de pérdida distintas y a prestar mucha menos atención al hecho de acertar con las predicciones y más a la idoneidad de las decisiones.

Colinealidad y posterioris

En esta entrada voy a crear un conjunto de datos donde dos variables tienen una correlación muy alta, ajustar un modelo de regresión y obtener la siguiente representación de la distribución a posteriori de los coeficientes,

donde se aprecia el efecto de la correlación entre x1 y x2.

El código,

library(mvtnorm)
library(rstan)
library(psych)

n <- 100
corr_coef <- .9

x <- rmvnorm(n, c(0, 0),
  sigma = matrix(c(1, corr_coef, corr_coef, 1), 2, 2))
plot(x)

x1 <- x[,1]
x2 <- x[,2]
x3 <- runif(n) - 0.5

y <- 1 + .4 * x1 - .2 * x2 + .1 * x3 + rnorm(n, 0, .1)

summary(lm(y ~ x1 + x2 + x3))

stan_code <- "
data {
  int N;
  vector[N] y;
  vector[N] x1;
  vector[N] x2;
  vector[N] x3;
}
parameters {
  real a;
  real a1;
  real a2;
  real a3;
  real sigma;
}

model {
  a ~ cauchy(0,10);
  a1 ~ cauchy(0,2.5);
  a2 ~ cauchy(0,2.5);
  a3 ~ cauchy(0,2.5);

  y ~ normal(a + a1 * x1 + a2 * x2 + a3 * x3, sigma);
}"


datos_stan <- list(
    N = n,
    y = y,
    x1 = x1,
    x2 = x2,
    x3 = x3
)

fit2 <- stan(model_code = stan_code,
              data = datos_stan,
              iter = 10000, warmup = 2000,
              chains = 2, thin = 4)

res <- as.data.frame(fit2)
pairs.panels(res[, c("a", "a1", "a2", "a3", "sigma")])

Sentido de la proporción

Es el segundo de los síntomas de naïveté económica discutidos aquí. Que, por supuesto, no se circunscribe a discusiones de naturaleza económica. Recomendadísimo.

Modelos y sesgos (discriminatorios): unas preguntas

A raíz de mi entrada del otro día he tenido una serie de intercambios de ideas. Que han sido infructuosos porque no han dejado medianamente asentadas las respuestas a una serie de preguntas relevantes.

Primero, contexto: tenemos un algoritmo que decide sobre personas (p.e., si se les concede hipotecas) usando las fuentes de información habitual. El algoritmo ha sido construido con un único objetivo: ser lo más eficiente (y cometer el mínimo número de errores) posible. Usa además datos históricos reales. Lo habitual.

Goodhart, Lucas y márketing

Abundo sobre lo de ayer.

Una empresa clasifica a sus clientes y los asigna a grupos: malotes, estrella, psepsé, etc. Examina las características de los clientes estrella y entonces reorienta su política comercial en la siguiente dirección:

Tratemos de que nuestros clientes infraóptimos asuman formalmente las características formales de aquellos que más nos gustan.

En gran medida, según lo discutido ayer, el principal logro de ese tipo de políticas es la de debilitar el vínculo entre esas características identificadas por los modelos y la rentabilidad de los clientes.

Goodhart, Lucas y todas esas cosas

Como me da vergüenza que una búsqueda de Goodhart en mi blog no dé resultados, allá voy. Lo de Goodhart, independientemente de lo que os hayan contado, tiene que ver con

es decir, un gráfico causal hiperbásico. Si la variable de interés y es difícil de medir, resulta tentador prestar atención a la variable observable x y usarla como proxy. Todo bien.

Pero también puede interesar operar sobre y y a cierta gente le puede sobrevenir la ocurrencia de operar sobre x con la esperanza de que eso influya sobre y.

¿Siguen votando igual los diputados?

Hace seis años escribí esto. Hoy actualizo aquella entrada para crear

Y, por supuesto, el código (que he tenido que reescribir en gran medida):

library(xml2)
library(reshape2)
library(plyr)

# descarga y manipulación de datos

dia_votacion <- function(n.votacion){
  dir.create("tmp")
  url <- paste("https://app.congreso.es/votacionesWeb/OpenData?sesion=",
                n.votacion, "&completa;=1&legislatura;=12", sep = "")
  download.file( url, destfile = "./tmp/votos.zip")
  try(unzip("./tmp/votos.zip", exdir = "./tmp"), TRUE)

  ficheros <- dir("./tmp", pattern = ".*xml", full.names = T)

  if (length(ficheros) == 0)
    return(NULL)

  res <- lapply(ficheros, function(fichero){

    print(fichero)

    datos <- as_list(read_xml(fichero))

    sesion <- datos$Resultado$Informacion$Sesion
    numero <- datos$Resultado$Informacion$NumeroVotacion

    try(datos <- ldply(datos$Resultado$Votaciones, unlist), TRUE)

    if (class(datos) == "try-error")
      return(NULL)

    if (class(datos) != "data.frame")
      return(NULL)

    if(nrow(datos) == 0)
      return(NULL)

    datos$sesion <- sesion
    datos$numero <- numero

    datos
  })

  unlink("./tmp", recursive = T)      # borra el directorio temporal

  res
}

tmp <- lapply(1:156, dia_votacion)

datos <- tmp[!sapply(tmp, is.null)]
datos <- lapply(datos, function(x) do.call(rbind, x))
datos <- do.call(rbind, datos)

datos$numero <- as.numeric(unlist(datos$numero))
datos$sesion <- as.numeric(unlist(datos$sesion))

datos$asunto <- as.character(1000000 + 1000 * datos$sesion + datos$numero)

datos$ind <- 0
datos$ind[datos$Voto == "No"] <- -1
datos$ind[datos$Voto == "Sí"] <- 1

tmp <- dcast(datos, asunto ~ Diputado, value.var = "ind", fill = 0)
matriz_votos <- as.matrix(tmp[, -1])

rownames(matriz_votos) <- NULL
colnames(matriz_votos) <- NULL

heatmap(matriz_votos, xlab = "Diputados", ylab = "Asuntos", scale = "none")

No sé si alguien querrá sacarle más punta a la no historia de hoy.

Cuando oigáis que los algoritmos discriminan, acordaos de esto que cuento hoy

Generalmente, cuando construyes uno de esos modelos para clasificar gente entre merecedores de una hipoteca o no; de un descuento o no; de… vamos, lo que hacen cientos de científicos de datos a diario, se utilizan dos tipos de fuentes de datos: individuales y grupales.

La información grupal es la que se atribuye a un individuo por el hecho de pertenecer a un sexo, a un grupo de edad, a un código postal, etc. Típicamente tiene una estructura seccional (invariante en el tiempo).

¿Qué hay de malo en gorronear investigación básica?

El artículo Endogenous Technological Change de Paul Romer (nóbel de economia de este año) ofrece algunas pistas sobre la relación entre investigación (o I+D o como quiera llamarse) y desarrollo económico. En él se lee (con mi subrayado):

Rivalry and excludability are closely linked because most rival goods are excludable. (A parking space in a shopping center parking lot is an example of a good that is effectively nonexcludable because the cost of enforcing excludability is too high relative to the value of the good.) The interesting case for growth theory is the set of goods that are nonrival yet excludable. The third premise cited in the Introduction implies that technology is a nonrival input. The second premise implies that technological change takes place because of the actions of self-interested individuals, so improvements in the technology must confer benefits that are at least partially excludable. The first premise therefore implies that growth is driven fundamentally by the accumulation of a partially excludable, nonrival input.