16  Introducción a inferencia bayesiana

En las secciones anteriores estudiamos métodos de remuestreo para estimar parámetros, y cuantificar la incertidumbre qué tenemos acerca de valores poblacionales.

Otra manera de hacer inferencia es usando modelos probabilísticos para los datos: asumir que los datos tienen cierto comportamiento (por ejemplo, provienen de distribuciones normales), y usar métodos como máxima verosimilitud para hacer estimaciones junto con su incertidumbre.

Una tercera opción es utilizar inferencia bayesiana, que tiene objetivos similares.

El concepto probabilístico básico que utilizamos para construir estos modelos y la inferencia es el de probabilidad condicional: la probabilidad de que ocurran ciertos eventos dada la información disponible del fenómeno que nos interesa.

Un primer ejemplo completo de inferencia bayesiana

Consideremos el siguiente problema simple: Nos dan una moneda, y solo sabemos que la moneda puede tener probabilidad \(3/5\) de tirar sol (está cargada a sol) o puede ser una moneda cargada a águila, con probabilidad \(2/5\) de tirar sol.

Vamos a lanzar la moneda dos veces y observamos su resultado (águila o sol). Queremos decir algo acerca de qué tan probable es que hayamos tirado la moneda cargada a sol o la moneda cargada a águila.

En este caso, tenemos dos variables: \(X\), que cuenta el número de soles obtenidos en el experimento aleatorio, y \(\theta\), que da la probabilidad de que un volado resulte en sol (por ejemplo, si la moneda es justa entonces \(\theta = 0.5\)).

¿Qué cantidades podríamos usar para evaluar qué moneda es la que estamos usando? Si hacemos el experimento, y tiramos la moneda 2 veces, podríamos considerar la probabilidad

\[P(\theta = 0.4 | X = x)\]

donde \(x\) es el número de soles que obtuvimos en el experimento. Esta es la probabilidad condicional de que estemos tirando la moneda con probabilidad de sol 2/5 dado que observamos \(x\) soles. Por ejemplo, si tiramos 2 soles, deberíamos calcular

\[P(\theta=0.4|X=2).\]

¿Cómo calculamos esta probabilidad? ¿Qué sentido tiene?

Usando reglas de probabildad (regla de Bayes en particular), podríamos calcular

\[P(\theta=0.4|X=2) = \frac{P(X=2 | \theta = 0.4) P(\theta =0.4)}{P(X=2)}\]

Nota que en el numerador uno de los factores, \(P(X=2 | \theta = 0.4),\) es la verosimilitud. Así que primero necesitamos la verosimilitud:

\[P(X=2|\theta = 0.4) = (0.4)^2 = 0.16.\]

La novedad es que ahora tenemos que considerar la probabilidad \(P(\theta = 0.4)\). Esta cantidad no la habíamos encontrado antes. Tenemos que pensar entonces que este parámetro es una cantidad aleatoria, y puede tomar dos valores \(\theta=0.4\) ó \(\theta = 0.6\).

Considerar esta cantidad como aleatoria requiere pensar, en este caso, en cómo se escogió la moneda, o qué sabemos acerca de las monedas que se usan para este experimento (conocimiento de dominio). Supongamos que en este caso, nos dicen que la moneda se escoge al azar de una bolsa donde hay una proporción similar de los dos tipos de moneda (0.4 ó 0.6). Es decir el espacio parametral es \(\Theta = \{0.4, 0.6\},\) y las probabilidades asociadas a cada posibilidad son las mismas. Tenemos

\[P(\theta = 0.4) = P(\theta = 0.6) =0.5,\]

que representa la probabilidad de escoger de manera aleatoria la moneda con una carga en particular.

Ahora queremos calcular \(P(X=2)\), pero con el trabajo que hicimos esto es fácil. Pues requiere usar reglas de probabilidad usuales para hacerlo. Podemos utilizar probabilidad total \[\begin{align} P(X) &= \sum_{\theta \in \Theta} P(X, \theta)\\ &= \sum_{\theta \in \Theta} P(X\, |\, \theta) P(\theta), \end{align}\] lo cual en nuestro ejemplo se traduce en escribir

\[ P(X=2) = P(X=2|\theta = 0.4)P(\theta = 0.4) + P(X=2|\theta=0.6)P(\theta =0.6),\]

por lo que obtenemos

\[P(X=2) = 0.16(0.5) + 0.36(0.5) = 0.26.\]

Finalmente la probabilidad de haber escogido la moneda con carga \(2/5\) dado que observamos dos soles en el lanzamiento es

\[P(\theta=0.4|X=2) = \frac{0.16(0.5)}{0.26} \approx 0.31.\]

Es decir, la probabilidad posterior de que estemos tirando la moneda \(2/5\) baja de 0.5 (nuestra información inicial) a 0.31.

Este es un ejemplo completo, aunque muy simple, de inferencia bayesiana. La estrategia de inferencia bayesiana implica tomar decisiones basadas en las probabilidades posteriores.

¿Cuál sería la estimación de máxima verosimilitud para este problema? ¿Cómo cuantificaríamos la incertidumbre en la estimación de máxima verosimilitud?

Finalmente, podríamos hacer predicciones usando la posterior predictiva. Si \({X}_{nv}\) es una nueva tirada adicional de la moneda que estamos usando, nos interesaría saber:

\[P({X}_{nv}=\mathsf{sol}\, | \, X=2)\]

Notemos que un volado adicional es un resultado binario. Por lo que podemos calcular observando que \(P({X}_{nv}|X=2, \theta)\) es una variable Bernoulli con probabilidad \(\theta\), que puede valer 0.4 ó 0.6. Como tenemos las probabilidades posteriores \(P(\theta|X=2)\) podemos usar probabilidad total, condicionado en \(X=2\): \[\begin{align*} P({X}_{nv}=\mathsf{sol}\, | \, X=2) & = \sum_{\theta \in \Theta} P({X}_{nv}=\mathsf{sol}, \theta \, | \, X=2) & \text{(probabilidad total)}\\ &= \sum_{\theta \in \Theta} P({X}_{nv}=\mathsf{sol}\, | \theta , X=2) P(\theta \, | \, X=2) & \text{(probabilidad condicional)}\\ &= \sum_{\theta \in \Theta} P({X}_{nv}=\mathsf{sol}\, | \theta ) P(\theta \, | \, X=2), & \text{(independencia condicional)} \end{align*}\]

lo que nos da el siguiente cálculo

\[P(X_{nv}=\mathsf{sol}\, |\, \theta=0.4) \, P(\theta=0.4|X=2) \, +\, P(X_{nv}=\mathsf{sol}|\theta = 0.6) \, P(\theta =0.6|X=2)\]

Es decir, promediamos ponderando con las probabilidades posteriores. Por lo tanto obtenemos

\[P(X_{nv} = \mathsf{sol}|X=2) = 0.4 ( 0.31) + 0.6 (0.69) = 0.538.\]

Observación 0

Nótese que en contraste con máxima verosimilitud, en este ejemplo cuantificamos con probabilidad condicional la incertidumbre de los parámetros que no conocemos. En máxima verosimilitud esta probabilidad no tiene mucho sentido, pues nunca consideramos el parámetro desconocido como una cantidad aleatoria.

Observación 1

Nótese el factor \(P(X=2)\) en la probabilidad posterior puede entenderse como un factor de normalización. Notemos que los denominadores en la distribución posterior son

\[P(X=2 | \theta = 0.4) P(\theta =0.4) = 0.16(0.5) = 0.08,\]

y

\[P(X=2 | \theta = 0.6) P(\theta =0.6) = 0.36(0.5) = 0.18.\]

Las probabilidades posteriores son proporcionales a estas dos cantidades, y como deben sumar uno, entonces normalizando estos dos números (dividiendo entre su suma) obtenemos las probabilidades.

Observación 2

La nomenclatura que usamos es la siguiente:

  • Como \(X\) son los datos observados, llamamos a \(P(X|\theta)\) la verosimilitud, o modelo de los datos.
  • A \(P(\theta)\) le llamamos la distribución inicial o previa.
  • La distribución que usamos para hacer inferencia \(P(\theta|X)\) es la distribución final o posterior.

Para utilizar inferencia bayesiana, hay que hacer supuestos para definir las primeras dos partes del modelo. La parte de iniciales o previas está ausente de enfoques como máxima verosimlitud usual.

Observación 3

¿Cómo decidimos las probabilidades iniciales, por ejemplo \(P(\theta=0.4)\) ?

Quizá es un supuesto y no tenemos razón para pensar que se hace de otra manera. O quizá conocemos el mecanismo concreto con el que se selecciona la moneda. Discutiremos esto más adelante.

Observación 4

¿Cómo decidimos el modelo de los datos? Aquí típicamente también tenemos que hacer algunos supuestos, aunque algunos de estos pueden estar basados en el diseño del estudio, por ejemplo. Igual que cuando usamos máxima verosimilitud, es necesario checar que nuestro modelo ajusta razonablemente a los datos.

Ejercicio

Cambia distintos parámetros del número de soles observados, las probabilidades de sol de las monedas, y las probabilidades iniciales de selección de las monedas.

Código
n_volados <- 2
# posible valores del parámetro desconocido
theta = c(0.4, 0.6)
# probabilidades iniciales
probs_inicial <- tibble(moneda = c(1, 2),
                        theta = theta,
                        prob_inicial = c(0.5, 0.5))
probs_inicial
# A tibble: 2 × 3
  moneda theta prob_inicial
   <dbl> <dbl>        <dbl>
1      1   0.4          0.5
2      2   0.6          0.5
Código
# verosimilitud
crear_verosim <- function(no_soles){
    verosim <- function(theta){
      # prob de observar no_soles en 2 volados con probabilidad de sol theta
      dbinom(no_soles, 2, theta)
    }
    verosim
}
# evaluar verosimilitud
verosim <- crear_verosim(2)
# ahora usamos regla de bayes para hacer tabla de probabilidades
tabla_inferencia <- probs_inicial |>
  mutate(verosimilitud = map_dbl(theta, verosim)) |>
  mutate(inicial_x_verosim = prob_inicial * verosimilitud) |>
  # normalizar
  mutate(prob_posterior = inicial_x_verosim / sum(inicial_x_verosim))
tabla_inferencia |>
  mutate(moneda_obs = moneda) |>
  select(moneda_obs, theta, prob_inicial, verosimilitud, prob_posterior)
# A tibble: 2 × 5
  moneda_obs theta prob_inicial verosimilitud prob_posterior
       <dbl> <dbl>        <dbl>         <dbl>          <dbl>
1          1   0.4          0.5          0.16          0.308
2          2   0.6          0.5          0.36          0.692
  • ¿Qué pasa cuando el número de soles es 0? ¿Cómo cambian las probabilidades posteriores de cada moneda?
  • Incrementa el número de volados, por ejemplo a 10. ¿Qué pasa si observaste 8 soles, por ejemplo? ¿Y si observaste 0?
  • ¿Qué pasa si cambias las probabilidades iniciales (por ejemplo incrementas la probabilidad inicial de la moneda 1 a 0.9)?

Justifica las siguientes aseveraciones (para este ejemplo):

  • Las probabilidades posteriores o finales son una especie de punto intermedio entre verosimilitud y probablidades iniciales.
  • Si tenemos pocas observaciones, las probabilidades posteriores son similares a las iniciales.
  • Cuando tenemos muchos datos, las probabilidades posteriores están más concentradas, y no es tan importante la inicial.
  • Si la inicial está muy concentrada en algún valor, la posterior requiere de muchas observaciones para que se pueda concentrar en otros valores diferentes a los de la inicial.

Ahora resumimos los elementos básicos de la inferencia bayesiana, que son relativamente simples:

Inferencia bayesiana

Con la notación de arriba:

  • Como \(X\) son los datos observados, llamamos a \(P(X|\theta)\) la verosimilitud, o modelo de los datos.
  • El factor \(P(\theta)\) le llamamos la distribución inicial o previa.
  • La distribución que usamos para hacer inferencia \(P(\theta|X)\) es la distribución final o posterior.

Hacemos inferencia usando la ecuación

\[P(\theta | X) = \frac{P(X | \theta) P(\theta)}{P(X)}\]

que también escribimos:

\[P(\theta | X) \propto P(X | \theta) P(\theta)\]

donde \(\propto\) significa “proporcional a”. No ponemos \(P(X)\) pues como vimos arriba, es una constante de normalización.

En estadística Bayesiana, las probablidades posteriores \(P(\theta|X)\) dan toda la información que necesitamos para hacer inferencia. ¿Cuándo damos probablidad alta a un parámetro particular \(\theta\)? Cuando su verosimilitud es alta y/o cuando su probabilidad inicial es alta. De este modo, la posterior combina la información inicial que tenemos acerca de los parámetros con la información en la muestra acerca de los parámetros (verosimilitud). Podemos ilustrar como sigue:

Ejemplo: estimando una proporción

Regresamos ahora a nuestro problema de estimar una proporción \(\theta\) de una población dada usando una muestra \(X_1,X_2,\ldots, X_n\) de variables \(\mathsf{Bernoulli}(\theta)\) extraídas de modo independiente. Ya sabemos calcular la verosimilitud:

\[P(X_1=x_1,X_2 =x_2,\ldots, X_n=x_n|\theta) = \theta^k(1-\theta)^{n-k},\]

donde \(k = x_1 + x_2 +\cdots + x_k\) es el número de éxitos que observamos.

Ahora necesitamos una distribución inicial o previa \(P(\theta)\). Aunque esta distribución puede tener cualquier forma, supongamos que nuestro conocimiento actual podemos resumirlo con una distribución \(\mathsf{Beta}(3, 3)\):

\[P(\theta) \propto \theta^2(1-\theta)^2.\]

La constante de normalización es 1/30, pero no la requerimos. Podemos simular para examinar su forma:

Código
sim_inicial <- tibble(theta = rbeta(10000, 3, 3))
ggplot(sim_inicial) + geom_histogram(aes(x = theta, y = ..density..), bins = 15)

De modo que nuestra información inicial es que la proporción puede tomar cualquier valor entre 0 y 1, pero es probable que tome un valor no tan lejano de 0.5. Por ejemplo, con probabilidad 0.95 creemos que \(\theta\) está en el intervalo

Código
quantile(sim_inicial$theta, c(0.025, 0.975)) |> round(2)
 2.5% 97.5% 
 0.15  0.85 

Es difícil justificar en abstracto por qué escogeriamos una inicial con esta forma. Aunque esto los detallaremos más adelante, puedes pensar, por el momento, que alguien observó algunos casos de esta población, y quizá vio tres éxitos y tres fracasos. Esto sugeriría que es poco probable que la probablidad \(\theta\) sea muy cercana a 0 o muy cercana a 1.

Ahora podemos construir nuestra posterior. Tenemos que

\(\begin{align}P(\theta| X_1=x_1, \ldots, X_n=x_n) &\propto P(X_1 = x_1,\ldots X_n=x_n | \theta)P(\theta) \\ &= \theta^{k+2}(1-\theta)^{n-k + 2}\end{align}\)

donde la constante de normalización no depende de \(\theta\). Como \(\theta\) es un parámetro continuo, la expresión de la derecha nos debe dar una densidad posterior.

Supongamos entonces que hicimos la prueba con \(n = 30\) (número de prueba) y observamos 19 éxitos. Tendríamos entonces

\[P(\theta | S_n = 19) \propto \theta^{19 + 2} (1-\theta)^{30 - 19 +2} = \theta^{21}(1-\theta)^{13}\]

La cantidad de la derecha, una vez que normalizemos por el número \(P(X=19)\), nos dará una densidad posterior (tal cual, esta expresion no integra a 1). Podemos obtenerla usando cálculo, pero recordamos que una distribución \(\mathsf{\mathsf{Beta}}(a,b)\) tiene como fórmula

\[\frac{1}{B(a,b)} \theta^{a-1}(1-\theta)^{b-1}\]

Concluimos entonces que la posterior tiene una distribución \(\mathsf{Beta}(22, 14)\). Podemos simular de la posterior usando código estándar para ver cómo luce:

Código
sim_inicial <- sim_inicial |> mutate(dist = "inicial")
sim_posterior <- tibble(theta = rbeta(10000, 22, 14)) |> mutate(dist = "posterior")
sims <- bind_rows(sim_inicial, sim_posterior)
ggplot(sims, aes(x = theta, fill = dist)) +
  geom_histogram(aes(x = theta), bins = 30, alpha = 0.5, position = "identity")

La posterior nos dice cuáles son las posibilidades de dónde puede estar el parámetro \(\theta\). Nótese que ahora excluye prácticamente valores más chicos que 0.25 o mayores que 0.9. Esta distribución posterior es el objeto con el que hacemos inferencia: nos dice dónde es creíble que esté el parámetro \(\theta\).

Podemos resumir de varias maneras. Por ejemplo, si queremos un estimador puntual usamos la media posterior:

Código
sims |> group_by(dist) |>
  summarise(theta_hat = mean(theta) |> round(3))
# A tibble: 2 × 2
  dist      theta_hat
  <chr>         <dbl>
1 inicial       0.503
2 posterior     0.611

Nota que el estimador de máxima verosimilitud es \(\hat{p} = 19/30 = 0.63\), que es ligeramente diferente de la media posterior. ¿Por qué?

Y podemos construir intervalos de percentiles, que en esta situación suelen llamarse intervalos de credibilidad, por ejemplo:

Código
f <- c(0.025, 0.975)
sims |> group_by(dist) |>
  summarise(cuantiles = quantile(theta, f) |> round(2), f = f) |>
  pivot_wider(names_from = f, values_from = cuantiles)
# A tibble: 2 × 3
# Groups:   dist [2]
  dist      `0.025` `0.975`
  <chr>       <dbl>   <dbl>
1 inicial      0.15    0.85
2 posterior    0.45    0.76

El segundo renglón nos da un intervalo posterior para \(\theta\) de credibilidad 95%. En inferencia bayesiana esto sustituye a los intervalos de confianza.

  • El intervalo de la inicial expresa nuestras creencias a priori acerca de \(\theta\). Este intervalo es muy amplio (va de 0.15 a 0.85)
  • El intervalo de la posterior actualiza nuestras creencias acerca de \(\theta\) una vez que observamos los datos, y es considerablemente más angosto y por lo tanto informativo.

Observaciones:

  • Nótese que escogimos una forma analítica fácil para la inicial, pues resultó así que la posterior es una distribución beta. No siempre es así, y veremos qué hacer cuando nuestra inicial no es de un tipo “conveniente”.
  • Como tenemos la forma analítica de la posterior, es posible hacer los cálculos de la media posterior, por ejemplo, integrando la densidad posterior a mano. Esto generalmente no es factible, y en este ejemplo preferimos hacer una aproximación numérica. En este caso particular es posible usando cálculo, y sabemos que la media de una \(\mathsf{\mathsf{Beta}}(a,b)\) es \(a/(a+b)\), de modo que nuestra media posterior es

\[\hat{\mu} = (19 + 2)/(30 + 4) = 21/34 = 0.617 \]

que podemos interpretar como sigue: para calcular la media posterior, a nuestras \(n\) pruebas iniciales agregamos 4 pruebas adicionales fijas, con 2 éxitos y 2 fracasos, y calculamos la proporción usual de éxitos.

Repite el análisis considerando en general \(n\) pruebas, con \(k\) éxitos. Utiliza la misma distribución inicial.

  • Lo mismo aplica para el intervalo de 95% (¿cómo se calcularía integrando?). También puedes usar la aproximación de R, por ejemplo:
Código
qbeta(0.025, shape1 = 22, shape2 = 14) |> round(2)
[1] 0.45
Código
qbeta(0.975, shape1 = 22, shape2 = 14) |> round(2)
[1] 0.76
Simulando de la posterior

Para una gran parte de los modelos que se utilizan en la práctica, no es posible hacer cálculos analíticos para obtener la posterior. En estos casos tenemos que recurrir a simular de posterior bajo un método Monte Carlo, que usualmente es del tipo MCMC (Markov Chain Monte Carlo).

Estos algoritmos son relativamente sofisticados y es mejor usar software diseñado para hacerlo. En nuestros siguientes ejemplos, usaremos Stan

16.1 Ejemplo: estudio de Santa Clara

Veamos cómo enfocar el estudio seroprevalencia de Santa Clara que vimos en la sección de máxima verosimilitud (Sección 14.2) desde el punto de vista bayesiano ver este reporte

Recordemos que teníamos 3300 individuos, y 50 de ellos fueron positivos con un kit de prueba que tenía las siguientes características:

  • Sensibilidad de 99.2% a 99.7% (intervalo de 95% de confianza)
  • Especificidad de 76% a 88.4% (intervalo de 95% de confianza)

Recordamos que tenemos que la probabilidad de observar un resultado positivo es

\[ p\theta_{pos} + (1-p)(1-\theta_{neg}),\]

Cuando tratamos este problema usando máxima verosimilitud, vimos cuál era nuestra estimación de \(p\) (seroprevalencia) bajo distintos valores de la especificidad consistentes con el intervalo reportado. Con el enfoque bayesiano podemos resolver este problema integrando la información en un solo modelo.

Primero escribimos nuestro modelo en Stan:

Código
library(cmdstanr)
mod_sc <- cmdstan_model("stan/santa-clara.stan")
print(mod_sc)
Código
cat(readLines("stan/santa-clara.stan"), sep = '\n')
data {
  int<lower=0> N;
  int<lower=0> n;
  int<lower=0> kit_pos;
  int<lower=0> n_kit_pos;
  int<lower=0> kit_neg;
  int<lower=0> n_kit_neg;
}

parameters {
  real<lower=0, upper=1> p; //seroprevalencia
  real<lower=0, upper=1> sens; //sensibilidad
  real<lower=0, upper=1> esp; //especificidad
}

transformed parameters {
  real<lower=0, upper=1> prob_pos;

  prob_pos = p * sens + (1 - p) * (1 - esp);

}
model {
  // verosimilitud
  n ~ binomial(N, prob_pos);
  // info de kit
  kit_pos ~ binomial(n_kit_pos, sens);
  kit_neg ~ binomial(n_kit_neg, esp);
  // iniciales,
  p ~ beta(1.0, 10.0);
  sens ~ beta(2.0, 1.0);
  esp ~ beta(2.0, 1.0);
}
Código
n <- 50
N <- 3300
datos_lista <- list(N = 3300, n = 50,
 kit_pos = 103, n_kit_pos = 122,
 kit_neg = 399, n_kit_neg = 401)
ajuste <- mod_sc$sample(data = datos_lista, refresh = 1000)
sims <- ajuste$draws(c("p", "sens", "esp"), format = "df")
resumen <- ajuste$summary(c("p"))
write_rds(resumen, file = "datos/resumen-santa-clara.rds")
write_rds(sims, file = "datos/sims-santa-clara.rds")
Código
resumen <- read_rds("datos/resumen-santa-clara.rds")
sims <- read_rds("datos/sims-santa-clara.rds")
resumen |> select(variable, mean, q5, q95)
# A tibble: 1 × 4
  variable   mean      q5    q95
  <chr>     <dbl>   <dbl>  <dbl>
1 p        0.0102 0.00231 0.0175

Y podemos graficar la posterior de la seroprevalencia:

Código
ggplot(sims, aes(sample = p)) + 
  geom_qq(distribution = stats::qunif) +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

Y vemos que los datos son consistentes con el dato reportado por los autores (alrededor de 1.2%), pero que no podemos excluir valores de prevalencia muy bajos (por abajo de 0.3% por ejemplo). Por otro lado, también son consistentes valores muy altos de seroprevalencia, de manera que este estudio resultó ser poco informativo de la IFR del COVID.

Podemos hacer diagnósticos adicionales acerca de la razón de esta variabilidad alta, si graficamos la relación entre especificidad de la prueba y estimación de prevalencia:

Código
ggplot(sims, aes(x = esp, y = p)) + geom_point() +
  xlab("Especificidad del kit") + ylab("Prevalencia")

Ejemplo: observaciones uniformes

Ahora regresamos al problema de estimación del máximo de una distribución uniforme. En este caso, consideraremos un problema más concreto. Supongamos que hay una lotería (tipo tradicional) en México y no sabemos cuántos números hay. Obtendremos una muestra iid de \(n\) números, y haremos una aproximación continua, suponiendo que

\[X_i \sim U[0,\theta]\]

La verosimilitud es entonces

\[P(X_1,\ldots, X_n|\theta) = \theta^{-n},\]

cuando \(\theta\) es mayor que todas las \(X_i\), y cero en otro caso. Necesitaremos una inicial \(P(\theta)\).

Por la forma que tiene la verosimilitud, podemos intentar una distribución Pareto, que tiene la forma

\[P(\theta) = \frac{\alpha \theta_0^\alpha}{\theta^{\alpha + 1}}\]

con soporte en \([\theta_0,\infty]\). Tenemos que escoger entonces el mínimo \(\theta_0\) y el parámetro \(\alpha\). En primer lugar, como sabemos que es una lotería nacional, creemos que no puede haber menos de unos 300 mil números, así que \(\theta_0 = 300\). La función acumulada de la pareto es \(1- (300/\theta)^\alpha\), así que el cuantil 99% es

Código
alpha <- 1.1
(300/(0.01)^(1/alpha))
[1] 19738

es decir, alrededor de 20 millones de números. Creemos que es un poco probable que el número de boletos sea mayor a esta cota. Nótese ahora que la posterior cumple (multiplicando verosimilitud por inicial):

\[P(\theta|X_1,\ldots, X_n |\theta) \propto \theta^{-(n + 2.1)}\]

para \(\theta\) mayor que el máximo de las \(X_n\)’s y 300, y cero en otro caso. Esta distribución es pareto con \(\theta_0' = \max\{300, X_1,\ldots, X_n\}\) y \(\alpha = n + 1.1\)

Una vez planteado nuestro modelo, veamos los datos. Obtuvimos la siguiente muestra de números:

Código
loteria_tbl <- read_csv("datos/nums_loteria_avion.csv", col_names = c("id", "numero")) |>
  mutate(numero = as.integer(numero))
set.seed(334)
muestra_loteria <- sample_n(loteria_tbl, 25) |>
  mutate(numero = numero/1000)
muestra_loteria |> as.data.frame() |> head()
  id   numero
1 87  348.341
2  5 5851.982
3 40 1891.786
4 51 1815.455
5 14 5732.907
6 48 3158.414

Podemos simular de una Pareto como sigue:

Código
rpareto <- function(n, theta_0, alpha){
  # usar el método de inverso de distribución acumulada
  u <- runif(n, 0, 1)
  theta_0 / (1 - u)^(1/alpha)
}

Simulamos de la inicial:

Código
sims_pareto_inicial <- tibble(
  theta = rpareto(20000, 300, 1.1 ),
  dist = "inicial")

Y con los datos de la muestra, simulamos de la posterior:

Código
sims_pareto_posterior <- tibble(
  theta = rpareto(20000,
                  max(c(300, muestra_loteria$numero)),
                  nrow(muestra_loteria) + 1.1),
  dist = "posterior")
sims_theta <- bind_rows(sims_pareto_inicial, sims_pareto_posterior)
ggplot(sims_theta) +
  geom_histogram(aes(x = theta, fill = dist),
                 bins = 70, alpha = 0.5, position = "identity",
                 boundary = max(muestra_loteria$numero))  +
  xlim(0, 15000) + scale_y_sqrt() +
  geom_rug(data = muestra_loteria, aes(x = numero))

Nótese que cortamos algunos valores de la inicial en la cola derecha: un defecto de esta distribución inicial, con una cola tan larga a la derecha, es que pone cierto peso en valores que son poco creíbles y la vuelve poco apropiada para este problema. Regresamos más adelante a este problema.

Si obtenemos percentiles, obtenemos el intervalo

Código
f <- c(0.025, 0.5, 0.975)
sims_theta |> group_by(dist) |>
  summarise(cuantiles = quantile(theta, f) |> round(2), f = f) |>
  pivot_wider(names_from = f, values_from = cuantiles)
# A tibble: 2 × 4
# Groups:   dist [2]
  dist      `0.025` `0.5` `0.975`
  <chr>       <dbl> <dbl>   <dbl>
1 inicial      307.  569.   8449.
2 posterior   5858. 6010.   6732.

Estimamos entre 5.8 millones y 6.7 millones de boletos. El máximo en la muestra es de

Código
max(muestra_loteria$numero)
[1] 5851.982

Escoger la distribución pareto como inicial es conveniente y nos permitió resolver el problema sin dificultad, pero por su forma vemos que no necesariamente es apropiada para el problema por lo que señalamos arriba. Nos gustaría, por ejemplo, poner una inicial como la siguiente

Código
qplot(rgamma(2000, 5, 0.001), geom="histogram", bins = 20) +
  scale_x_continuous(breaks = seq(1000, 15000, by = 2000))

Sin embargo, los cálculos no son tan simples en este caso, pero podríamos usar Stan como en los ejemplos anteriores.

Probabilidad a priori

La inferencia bayesiana es conceptualmente simple: siempre hay que calcular la posterior a partir de verosimilitud (modelo de datos) y distribución inicial o a priori. Sin embargo, una crítica usual que se hace de la inferencia bayesiana es precisamente que hay que tener esa información inicial, y que distintos analistas llegan a distintos resultados si tienen información inicial distinta.

Eso realmente no es un defecto, es una ventaja de la inferencia bayesiana. Los datos y los problemas que queremos resolver no viven en un vacío donde podemos creer que la estatura de las personas, por ejemplo, puede variar de 0 a mil kilómetros, el número de boletos de una lotería puede ir de 2 o 3 boletos o también quizá 500 millones de boletos, o la proporción de personas infectadas de una enfermedad puede ser de unos cuantos hasta miles de millones.

  • En todos estos casos tenemos cierta información inicial que podemos usar para informar nuestras estimaciones. Esta información debe usarse.
  • Antes de tener datos, las probabilidades iniciales deben ser examinadas en términos del conocimiento de expertos.
  • Las probabilidades iniciales son supuestos que hacemos acerca del problema de interés, y también están sujetas a críticas y confrontación con datos.
  • Poner iniciales “no informativas” en todos los parámetros no necesariamente es buena idea. En la siguiente gráfica mostramos dos distribuciones iniciales para porcentaje de votos en modelos bayesianos para el conteo rápido. El de la derecha no usa iniciales informativas en los parámetros, lo que resulta en valores informativos para las cantidades que al final queremos estimar:

Ejemplo

Supongamos que queremos estimar la estatura de los cantantes de tesitura tenor con una muestra iid de tenores de Estados Unidos. Usaremos el modelo normal de forma que \(X_i\sim \mathsf{N}(\mu, \sigma^2)\).

Una vez decidido el modelo, tenemos que poner distribución inicial para los parámetros \((\mu, \sigma^2)\).

Comenzamos con \(\sigma^2\). Checando fuentes oficiales, en la población general la desviación estándar es alrededor de 7 centímetros. Puede ser que la variabilidad de los tenores sea algo menor o mayor. Tenemos varias opciones para la distribución inicial. En este ejemplo, usaremos una gamma.

Simulamos para calcular cuantiles probando con distintas iniciales. Esperamos que esta información sea consiste con el conocimiento que tenemos. Por ejemplo, una inicial como esta no tiene sentido:

Código
sigma <- rgamma(10000, 0.65, 1/20)
quantile(sigma, c(0.05, 0.5, 0.95))
        5%        50%        95% 
 0.1508418  7.4707260 46.0530573 

porque estamos diciendo que es posible que los tenores varíen hasta en 2 *50 = 100 centímetros de estatura como población alrededor de su media. Eso es físicamente imposible.

Código
sigma_inicial <- rgamma(10000, 2, 1/4)
quantile(sigma_inicial, c(0.05, 0.5, 0.95))
       5%       50%       95% 
 1.424524  6.668293 18.786815 

Esta distribución inicial es más razonable. Quizá puede haber el doble de variación que en población, y dudamos de que sean tan uniformes como para tener menos de 1cm de desviación estándar. Un histograma de la distribución inicial, que es informativa y consistente con lo que sabemos de los humanos en cuanto a su estatura:

Código
qplot(x = sigma_inicial, geom = "histogram")

Comenzamos con \(\mu\). Sabemos, por ejemplo, que con alta probabilidad la media debe ser algún número entre 1.60 y 1.80. Podemos investigar: la media nacional en estados unidos está alrededor de 1.75, y el percentil 90% es 1.82. Esto es variabilidad en la población: debe ser muy poco probable, por ejemplo, que la media de tenores sea 1.82 Quizá los cantantes tienden a ser un poco más altos o bajos que la población general, así que podríamos agregar algo de dispersión.

Podemos establecer parámetros y simular de la marginal a partir de las fórmulas de arriba para entender cómo se ve la inicial de \(\mu\):

Código
mu_0 <- 175 # valor medio de inicial
s_0 <- 5 # cuánta concentración en la inicial
mu <- rnorm(1000, mu_0, s_0)
quantile(mu, c(0.05, 0.5, 0.95))
      5%      50%      95% 
166.5934 174.9179 183.3338 

Que consideramos un rango en el que con alta probabilidad debe estar la media poblacional de los cantantes tenores.

Podemos checar nuestros supuestos simulando posibles muestras usando sólo nuestra información previa:

Código
simular_modelo_inicial <- function(n, pars){
  mu_0 <- pars[1]
  s_0 <- pars[2]
  a_sigma <- pars[3]
  b_sigma <- pars[4]
  # simular media
  sigma <- rgamma(1, a_sigma, b_sigma)
  mu <- rnorm(1, mu_0, s_0)
  # simular sigma
  rnorm(n, mu, sigma)
}
simular_parametros <- function(n, pars){
  mu_0 <- pars[1]
  s_0 <- pars[2]
  a_sigma <- pars[3]
  b_sigma <- pars[4]
  # simular media
  tibble(
    mu = rnorm(n, mu_0, s_0),
    sigma = rgamma(n, a_sigma, b_sigma)
  )
}
set.seed(34161)
m_0 <- 175
sigma_0 <- 5
a_sigma <- 2
b_sigma <- 1/4
sims_tbl <- tibble(rep = 1:20) |>
  mutate(estatura = map(rep, ~ simular_modelo_inicial(500, 
    c(mu_0, sigma_0, a_sigma, b_sigma)))) |>
  unnest(cols = c(estatura))
ggplot(sims_tbl, aes(x = estatura)) + geom_histogram() +
  facet_wrap(~ rep) +
  geom_vline(xintercept = c(150, 180), colour = "red") + theme_light()

Pusimos líneas de referencia en 150 y 180. Vemos que nuestras iniciales no producen simulaciones totalmente fuera del contexto, y parecen cubrir apropiadamente el espacio de posiblidades para estaturas de los tenores. Quizá hay algunas realizaciones poco creíbles, pero no extremadamente. En este punto, podemos regresar y ajustar la inicial para \(\sigma\), que parece tomar valores demasiado grandes (produciendo por ejemplo una simulación con estatura de 220 y 120, que deberían ser menos probables).

  • Este paso se llama el chequeo predictivo a priori. Estamos probando que el modelo y la inicial produzca valores consistentes con el conocimiento de dominio. Este análisis puede hacerse más detallado mostrando valores de poblaciones relacionadas o datos relevantes.

Una vez que estamos satisfechos con le modelo inicial, podemos considerar los datos para producir las distribuciones posteriores. En este caso, nuestra muestra es:

Código
set.seed(3413)
cantantes <- lattice::singer |>
  mutate(estatura_cm = round(2.54 * height)) |>
  filter(str_detect(voice.part, "Tenor")) |>
  sample_n(20)
cantantes
    height voice.part estatura_cm
139     70    Tenor 1         178
150     68    Tenor 2         173
140     65    Tenor 1         165
132     66    Tenor 1         168
152     69    Tenor 2         175
141     72    Tenor 1         183
161     71    Tenor 2         180
156     71    Tenor 2         180
158     71    Tenor 2         180
164     69    Tenor 2         175
147     68    Tenor 1         173
130     72    Tenor 1         183
162     71    Tenor 2         180
134     74    Tenor 1         188
170     69    Tenor 2         175
167     68    Tenor 2         173
149     64    Tenor 1         163
143     68    Tenor 1         173
157     69    Tenor 2         175
153     71    Tenor 2         180
  • En este caso usaremos métodos numéricos para simular de la posterior (métodos MCMC, o Markov Chain Monte Carlo).

Nuestro modelo en Stan se escribe como sigue, según nuestra discusión de arriba:

Código
library(cmdstanr)
mod_estaturas <- cmdstan_model("stan/cantantes.stan")
print(mod_estaturas)
Código
cat(readLines("stan/cantantes.stan"), sep = '\n')
data {
  int<lower=0> N;
  vector[N] estaturas;
}

parameters {
  real mu;
  real<lower=0> sigma;
}

model {
  // verosimilitud
  estaturas ~ normal(mu, sigma);
  // iniciales
  mu ~ normal(175, 5);
  sigma ~ gamma(2.0, 0.5);
}

generated quantities {
  vector[N] estaturas_sim;
  // generar una muestra bajo el modelo ajustado
  for(i in 1:N){
    estaturas_sim[i] = normal_rng(mu, sigma);
  }
}

¿Cómo se ve nuestra posterior comparada con la inicial? Podemos hacer simulaciones:

Código
y <- cantantes$estatura_cm
N <- length(y)
datos_lista <- list(N = N, estaturas = y)
ajuste <- mod_estaturas$sample(data = datos_lista, refresh = 1000)
resumen <- ajuste$summary(c("mu", "sigma"))
write_rds(resumen, file = "datos/resumen-cantantes.rds")
Código
resumen <- read_rds("datos/resumen-cantantes.rds")
resumen
# A tibble: 2 × 10
  variable   mean median    sd   mad     q5    q95  rhat ess_bulk ess_tail
  <chr>     <dbl>  <dbl> <dbl> <dbl>  <dbl>  <dbl> <dbl>    <dbl>    <dbl>
1 mu       176.   176.   1.38  1.32  174.   178.    1.00    3044.    2421.
2 sigma      6.21   6.10 0.981 0.902   4.86   8.01  1.00    2361.    2184.

Y vemos que nuestra posterior es consistente con la información inicial que usamos, hemos aprendido considerablemente de la muestra. La posterior se ve como sigue. Hemos marcado también las medias posteriores de cada parámetro: media y desviación estándar.

Código
sims_post <- ajuste$draws(c("mu", "sigma"), format = "df")
write_rds(sims_post, file = "datos/cantantes-sim.rds")
Código
sims_post <- read_rds("datos/cantantes-sim.rds")
head(sims_post)
# A tibble: 6 × 5
     mu sigma .chain .iteration .draw
  <dbl> <dbl>  <int>      <int> <int>
1  176.  6.30      1          1     1
2  176.  6.30      1          2     2
3  176.  7.44      1          3     3
4  176.  5.51      1          4     4
5  176.  7.05      1          5     5
6  176.  4.97      1          6     6
Código
sims_inicial <- 
  simular_parametros(4000, c(mu_0, sigma_0, a_sigma, b_sigma))
sims <- bind_rows(sims_inicial |> mutate(tipo = "inicial"),
                  sims_post |> mutate(tipo = "posterior"))
ggplot(sims, aes(x = mu, y = sigma, colour = tipo)) +
  geom_point() + coord_equal()

Podemos construir intervalos creíbles del 90% para estos dos parámetros, por ejemplo haciendo intervalos de percentiles

Código
f <- c(0.05, 0.5, 0.95)
sims |>
  pivot_longer(cols = mu:sigma, names_to = "parametro") |>
  group_by(tipo, parametro) |>
  summarise(cuantil = quantile(value, f) |> round(1), f= f) |>
  pivot_wider(names_from = f, values_from = cuantil)
# A tibble: 4 × 5
# Groups:   tipo, parametro [4]
  tipo      parametro `0.05` `0.5` `0.95`
  <chr>     <chr>      <dbl> <dbl>  <dbl>
1 inicial   mu         167   175.   183. 
2 inicial   sigma        1.4   6.7   19.5
3 posterior mu         174.  176.   178. 
4 posterior sigma        4.9   6.1    8  

Como comparación, los estimadores de máxima verosimlitud son

Código
media_mv <- mean(cantantes$estatura_cm)
sigma_mv <- mean((cantantes$estatura_cm - media_mv)^2) |> sqrt()
c(media_mv, sigma_mv)
[1] 176   6

Ahora solo resta checar que el modelo es razonable. Veremos más adelante cómo hacer esto, usando la distribución predictiva posterior.

Pasos de un análisis de datos bayesiano

Como vimos en los ejemplos, en general un análisis de datos bayesiano sigue los siguientes pasos:

  • Identificar los datos releventes a nuestra pregunta de investigación, el tipo de datos que vamos a describir, que variables queremos estimar.
  • Definir el modelo descriptivo para los datos. La forma matemática y los parámetros deben ser apropiados para los objetivos del análisis.
  • Especificar la distribución inicial de los parámetros. Verificar que el modelo inicial produce datos consistentes con el conocimiento de dominio.
  • Utilizar inferencia bayesiana para reubicar la credibilidad a lo largo de los posibles valores de los parámetros.
  • Verificar que la distribución posterior replique los datos de manera razonable, de no ser el caso considerar otros modelos descriptivos para los datos.

Verificación predictiva posterior

Una vez que ajustamos un modelo bayesiano, podemos simular nuevas observaciones a partir del modelo. Esto tiene dos utilidades:

  • Hacer predicciones acerca de datos no observados.
  • Confirmar que nuevas producidas simuladas con el modelo son similares a las que de hecho observamos. Esto nos permite confirmar la calidad del ajuste del modelo, y se llama verificación predictiva posterior.

Supongamos que tenemos la posterior \(p(\theta | x)\). Podemos generar una nueva replicación de los datos como sigue:

La distribución predictiva posterior genera nuevas observaciones a partir de la información observada. La denotamos como \(p(\tilde{x}|x)\). Para simular de ella:

  • Muestreamos un valor \(\tilde{\theta}\) de la posterior \(p(\theta|x)\).
  • Simulamos del modelo de las observaciones \(\tilde{x} \sim p(\tilde{x}|\tilde{\theta})\).
  • Repetimos el proceso hasta obtener una muestra grande.
  • Usamos este método para producir, por ejemplo, intervalos de predicción para nuevos datos.

Si queremos una replicación de las observaciones de la predictiva posterior:

  • Muestreamos un valor \(\tilde{\theta}\) de la posterior \(p(\theta|x)\).
  • Simulamos del modelo de las observaciones \(\tilde{x}_1, \tilde{x}_2,\ldots, \tilde{x}_n \sim p(\tilde{x}|\tilde{\theta})\), done \(n\) es el tamaño de muestra de la muestra original \(x\).
  • Usamos este método para producir conjuntos de datos simulados que comparamos con los observados para verificar nuestro modelo.

Ejemplo: estaturas de tenores

En este ejemplo, usaremos la posterior predictiva para checar nuestro modelo. Vamos a crear varias muestras, del mismo tamaño que la original, según nuestra predictiva posterior, y compararemos estas muestras con la observada.

Código
set.seed(82223)
muestras_sim <- ajuste$draws("estaturas_sim", format = "df") |> 
  as_tibble() |> 
  pivot_longer(contains("estaturas_sim"), names_to = "variable", 
               values_to = "estatura") |>
  select(.n = .draw, estatura_cm = estatura) |> 
  filter(.n %in% sample(1:4000, 19)) |>
  nest(c(estatura_cm)) |> 
  mutate(.n = min_rank(.n)) |> 
  unnest()
write_rds(muestras_sim, file = "datos/muestras-cantantes.rds")
Código
muestras_sim <- read_rds("datos/muestras-cantantes.rds")

Podemos simular varias muestras y hacer una prueba de lineup:

Código
library(nullabor)
set.seed(44165)
pos <- sample(1:20, 1)
lineup_tbl <- lineup(true = cantantes |> select(estatura_cm),
                     samples = muestras_sim, pos = pos)
ggplot(lineup_tbl, aes(x = estatura_cm)) + geom_histogram(binwidth = 2.5) +
  facet_wrap(~.sample)

Con este tipo de gráficas podemos checar desajustes potenciales de nuestro modelo.

  • ¿Puedes encontrar los datos verdaderos? ¿Cuántos seleccionaron los datos correctos?
  • Prueba hacer pruebas con una gráfica de cuantiles. ¿Qué problema ves y cómo lo resolverías?

Ejemplo: modelo Poisson

Supongamos que pensamos el modelo para las observaciones es Poisson con parámetro \(\lambda\). Pondremos como inicial para \(\lambda\) una exponencial con media 10.

Nótese que la posterior está dada por

\[p(\lambda|x_1,\ldots, x_n) \propto e^{-n\lambda}\lambda^{\sum_i x_i} e^{-0.1\lambda} = \lambda^{n\overline{x}}e^{-\lambda(n + 0.1)}\]

que es una distribución gamma con parámetros \((n\overline{x} + 1, n+0.1)\)

Ahora supongamos que observamos la siguiente muestra, ajustamos nuestro modelo y hacemos replicaciones posteriores de los datos observados:

Código
x <- rnbinom(250, mu = 20, size = 3)
crear_sim_rep <- function(x){
  n <- length(x)
  suma <- sum(x)
  sim_rep <- function(rep){
    lambda <- rgamma(1, sum(x) + 1, n + 0.1)
    x_rep <- rpois(n, lambda)
    tibble(rep = rep, x_rep = x_rep)
  }
}
sim_rep <- crear_sim_rep(x)
lineup_tbl <- map(1:5, ~ sim_rep(.x)) |>
  bind_rows() |>
  bind_rows(tibble(rep = 6, x_rep = x))
ggplot(lineup_tbl, aes(x = x_rep)) +
  geom_histogram(bins = 15) +
  facet_wrap(~rep)

Y vemos claramente que nuestro modelo no explica apropiadamente la variación de los datos observados. Contrasta con:

Código
set.seed(223)
x <- rpois(250, 15)
crear_sim_rep <- function(x){
  n <- length(x)
  suma <- sum(x)
  sim_rep <- function(rep){
    lambda <- rgamma(1, sum(x) + 1, n + 0.1)
    x_rep <- rpois(n, lambda)
    tibble(rep = rep, x_rep = x_rep)
  }
}
sim_rep <- crear_sim_rep(x)
lineup_tbl <- map(1:5, ~ sim_rep(.x)) |>
  bind_rows() |>
  bind_rows(tibble(rep = 6, x_rep = x))
ggplot(lineup_tbl, aes(x = x_rep)) +
  geom_histogram(bins = 15) +
  facet_wrap(~rep)

Y verificamos que en este caso el ajuste del modelo es apropiado.