diff --git a/01-exploratorio.md b/01-exploratorio.md index f08ea99..04562ab 100644 --- a/01-exploratorio.md +++ b/01-exploratorio.md @@ -67,23 +67,23 @@ slice_sample(propinas, n = 10) |> gt() ``` ```{=html} -
- @@ -528,66 +528,66 @@ slice_sample(propinas, n = 10) |> gt() - 9.78 -1.73 -No -Jue -Comida + 15.81 +3.16 +Si +Sab +Cena 2 - 13.42 -1.68 -No + 16.47 +3.23 +Si Jue Comida -2 - 11.02 -1.98 +3 + 38.01 +3.00 Si Sab Cena -2 - 22.49 -3.50 -No -Vie -Cena -2 - 11.59 -1.50 +4 + 3.07 +1.00 Si Sab Cena +1 + 12.46 +1.50 +No +Vie +Cena 2 - 24.71 -5.85 + 8.52 +1.48 No Jue Comida 2 - 9.60 -4.00 -Si -Dom -Cena -2 - 19.65 -3.00 + 11.61 +3.39 No Sab Cena 2 - 18.04 -3.00 + 50.81 +10.00 +Si +Sab +Cena +3 + 38.07 +4.00 No Dom Cena -2 - 30.40 -5.60 +3 + 15.06 +3.00 No -Dom +Sab Cena -4 +2 @@ -636,23 +636,23 @@ bind_rows(head(cuenta), tail(cuenta)) |> ``` ```{=html} -
- diff --git a/01-exploratorio_files/figure-html/unnamed-chunk-11-1.png b/01-exploratorio_files/figure-html/unnamed-chunk-11-1.png index 34032e0..4d98c48 100644 Binary files a/01-exploratorio_files/figure-html/unnamed-chunk-11-1.png and b/01-exploratorio_files/figure-html/unnamed-chunk-11-1.png differ diff --git a/01-exploratorio_files/figure-html/unnamed-chunk-30-1.png b/01-exploratorio_files/figure-html/unnamed-chunk-30-1.png index 55226ab..be3452f 100644 Binary files a/01-exploratorio_files/figure-html/unnamed-chunk-30-1.png and b/01-exploratorio_files/figure-html/unnamed-chunk-30-1.png differ diff --git a/01-exploratorio_files/figure-html/unnamed-chunk-31-1.png b/01-exploratorio_files/figure-html/unnamed-chunk-31-1.png index 233485f..7fe5670 100644 Binary files a/01-exploratorio_files/figure-html/unnamed-chunk-31-1.png and b/01-exploratorio_files/figure-html/unnamed-chunk-31-1.png differ diff --git a/01-exploratorio_files/figure-html/unnamed-chunk-33-1.png b/01-exploratorio_files/figure-html/unnamed-chunk-33-1.png index 10c2b80..68505c3 100644 Binary files a/01-exploratorio_files/figure-html/unnamed-chunk-33-1.png and b/01-exploratorio_files/figure-html/unnamed-chunk-33-1.png differ diff --git a/02-tipos-de-estudio_files/figure-html/grafica-pcr-1.png b/02-tipos-de-estudio_files/figure-html/grafica-pcr-1.png index 7655549..13adf30 100644 Binary files a/02-tipos-de-estudio_files/figure-html/grafica-pcr-1.png and b/02-tipos-de-estudio_files/figure-html/grafica-pcr-1.png differ diff --git a/14-intro-bayesiana.md b/14-intro-bayesiana.md index decf046..9fbfffe 100644 --- a/14-intro-bayesiana.md +++ b/14-intro-bayesiana.md @@ -332,7 +332,7 @@ quantile(sim_inicial$theta, c(0.025, 0.975)) |> round(2) ``` ## 2.5% 97.5% -## 0.14 0.85 +## 0.15 0.85 ``` Es difícil justificar en abstracto por qué escogeriamos una inicial con esta @@ -388,8 +388,8 @@ sims |> group_by(dist) |> ## # A tibble: 2 × 2 ## dist theta_hat ## -## 1 inicial 0.503 -## 2 posterior 0.61 +## 1 inicial 0.5 +## 2 posterior 0.61 ``` 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é? @@ -410,7 +410,7 @@ sims |> group_by(dist) |> ## # Groups: dist [2] ## dist `0.025` `0.975` ## -## 1 inicial 0.14 0.85 +## 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* diff --git a/14-intro-bayesiana_files/figure-html/unnamed-chunk-6-1.png b/14-intro-bayesiana_files/figure-html/unnamed-chunk-6-1.png index 3d01d1b..8412d84 100644 Binary files a/14-intro-bayesiana_files/figure-html/unnamed-chunk-6-1.png and b/14-intro-bayesiana_files/figure-html/unnamed-chunk-6-1.png differ diff --git a/14-intro-bayesiana_files/figure-html/unnamed-chunk-8-1.png b/14-intro-bayesiana_files/figure-html/unnamed-chunk-8-1.png index bf2b9ca..4eba332 100644 Binary files a/14-intro-bayesiana_files/figure-html/unnamed-chunk-8-1.png and b/14-intro-bayesiana_files/figure-html/unnamed-chunk-8-1.png differ diff --git a/15-bayesiana-calibracion.md b/15-bayesiana-calibracion.md index 689b4cf..3f2b6e4 100644 --- a/15-bayesiana-calibracion.md +++ b/15-bayesiana-calibracion.md @@ -713,7 +713,8 @@ se muestra como una horizontal punteada. ## Ejemplo: estimación de proporciones {-} -Ahora repetimos el ejercicio +Ahora repetimos el ejercicio de la estimación de la proporción de hogares con ingresos +superiores a 150 mil. ``` r diff --git a/16-bayes-mcmc.md b/16-bayes-mcmc.md index 0a1d31d..0f567a2 100644 --- a/16-bayes-mcmc.md +++ b/16-bayes-mcmc.md @@ -189,7 +189,7 @@ c(media_post, momento_2_post) ``` ``` -## [1] 0.7155559 0.5372170 +## [1] 0.7147007 0.5364443 ``` Y podemos aproximar de esta manera cualquier cantidad de interés que esté basada @@ -202,7 +202,7 @@ mean(exp(theta) > 2) ``` ``` -## [1] 0.5958 +## [1] 0.5959 ``` y así sucesivamente. @@ -286,10 +286,10 @@ simular_conjunta(1, datos) ## # A tibble: 4 × 2 ## sabor valor_sim ## -## 1 fresa 0.755 -## 2 limón 0.783 -## 3 mango 0.819 -## 4 guanábana 0.569 +## 1 fresa 0.886 +## 2 limón 0.729 +## 3 mango 0.701 +## 4 guanábana 0.493 ``` @@ -306,16 +306,16 @@ sims_posterior ## # A tibble: 20,000 × 3 ## rep sabor valor_sim ## -## 1 1 fresa 0.732 -## 2 1 limón 0.831 -## 3 1 mango 0.850 -## 4 1 guanábana 0.397 -## 5 2 fresa 0.670 -## 6 2 limón 0.839 -## 7 2 mango 0.664 -## 8 2 guanábana 0.558 -## 9 3 fresa 0.671 -## 10 3 limón 0.758 +## 1 1 fresa 0.727 +## 2 1 limón 0.823 +## 3 1 mango 0.849 +## 4 1 guanábana 0.474 +## 5 2 fresa 0.659 +## 6 2 limón 0.785 +## 7 2 mango 0.866 +## 8 2 guanábana 0.631 +## 9 3 fresa 0.553 +## 10 3 limón 0.719 ## # ℹ 19,990 more rows ``` @@ -338,9 +338,9 @@ sims_posterior %>% ## sabor n prop ## ## 1 fresa 1264 0.0632 -## 2 guanábana 8 0.0004 -## 3 limón 5396 0.270 -## 4 mango 13332 0.667 +## 2 guanábana 20 0.001 +## 3 limón 5424 0.271 +## 4 mango 13292 0.665 ``` Y vemos que los mejores sabores son mango y limón. La probabilidad posterior de que mango sea el sabor preferido por la población es de 66%. La integral correspondiente @@ -372,7 +372,7 @@ de una distribución cualquiera $p(\theta) = K f(\theta)$, donde sólo conocemos la función $f(\theta)$. -## Ejemplo de islas +## Ejemplo de islas {-} Comenzamos revisando el ejemplo de las islas en @Kruschke (7.2) para tener más intuición de cómo funciona este algoritmo. @@ -746,8 +746,8 @@ tibble(metodo = c("sim Metrópolis", "sim Independiente", "exacto"), ## # A tibble: 3 × 2 ## metodo media_post ## -## 1 sim Metrópolis 0.605 -## 2 sim Independiente 0.602 +## 1 sim Metrópolis 0.613 +## 2 sim Independiente 0.600 ## 3 exacto 0.6 ``` @@ -894,7 +894,7 @@ estimaciones_media %>% bind_rows(tibble(tipo = "exacta", media = 20/100)) %>% ## # A tibble: 4 × 2 ## tipo media ## -## 1 salto chico 0.128 +## 1 salto chico 0.132 ## 2 salto grande 0.190 ## 3 salto apropiado 0.203 ## 4 exacta 0.2 diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-13-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-13-1.png index 3a154ba..91032a2 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-13-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-13-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-14-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-14-1.png index 9437187..4f13f44 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-14-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-14-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-19-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-19-1.png index 6489ec5..1010361 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-19-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-19-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-20-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-20-1.png index cbedbd8..81115c8 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-20-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-20-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-21-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-21-1.png index 754e507..09396ac 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-21-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-21-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-24-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-24-1.png index bf67e24..8a5ea2d 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-24-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-24-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-25-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-25-1.png index 3ec9700..b0e7277 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-25-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-25-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-26-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-26-1.png index 68dfd8a..0f91547 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-26-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-26-1.png differ diff --git a/16-bayes-mcmc_files/figure-html/unnamed-chunk-27-1.png b/16-bayes-mcmc_files/figure-html/unnamed-chunk-27-1.png index 10c5dfa..f8d69a0 100644 Binary files a/16-bayes-mcmc_files/figure-html/unnamed-chunk-27-1.png and b/16-bayes-mcmc_files/figure-html/unnamed-chunk-27-1.png differ diff --git a/404.html b/404.html index 3ad921c..ca51981 100644 --- a/404.html +++ b/404.html @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git a/89-transformaciones.md b/89-transformaciones.md index 9a3d778..2b7f713 100644 --- a/89-transformaciones.md +++ b/89-transformaciones.md @@ -106,23 +106,23 @@ animals_tbl |> ``` ```{=html} -
    - diff --git a/89-transformaciones_files/figure-html/unnamed-chunk-3-1.png b/89-transformaciones_files/figure-html/unnamed-chunk-3-1.png index 15220ee..66b8715 100644 Binary files a/89-transformaciones_files/figure-html/unnamed-chunk-3-1.png and b/89-transformaciones_files/figure-html/unnamed-chunk-3-1.png differ diff --git a/89-transformaciones_files/figure-html/unnamed-chunk-4-1.png b/89-transformaciones_files/figure-html/unnamed-chunk-4-1.png index 70642ac..da0485d 100644 Binary files a/89-transformaciones_files/figure-html/unnamed-chunk-4-1.png and b/89-transformaciones_files/figure-html/unnamed-chunk-4-1.png differ diff --git "a/an\303\241lisis-exploratorio.html" "b/an\303\241lisis-exploratorio.html" index 5450b5f..dfd1b3b 100644 --- "a/an\303\241lisis-exploratorio.html" +++ "b/an\303\241lisis-exploratorio.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto @@ -527,23 +527,23 @@

    Algunos conceptos básicospropinas <- read_csv("./data/propinas.csv")

    • Y vemos una muestra

    slice_sample(propinas, n = 10) |> gt()
    -
    - @@ -988,66 +988,66 @@

    Algunos conceptos básicos - 9.78 -1.73 -No -Jue -Comida + 15.81 +3.16 +Si +Sab +Cena 2 - 13.42 -1.68 -No + 16.47 +3.23 +Si Jue Comida -2 - 11.02 -1.98 +3 + 38.01 +3.00 Si Sab Cena -2 - 22.49 -3.50 -No -Vie -Cena -2 - 11.59 -1.50 +4 + 3.07 +1.00 Si Sab Cena +1 + 12.46 +1.50 +No +Vie +Cena 2 - 24.71 -5.85 + 8.52 +1.48 No Jue Comida 2 - 9.60 -4.00 -Si -Dom -Cena -2 - 19.65 -3.00 + 11.61 +3.39 No Sab Cena 2 - 18.04 -3.00 + 50.81 +10.00 +Si +Sab +Cena +3 + 38.07 +4.00 No Dom Cena -2 - 30.40 -5.60 +3 + 15.06 +3.00 No -Dom +Sab Cena -4 +2 @@ -1086,23 +1086,23 @@

    Algunos conceptos básicos arrange(f) bind_rows(head(cuenta), tail(cuenta)) |> gt() |> fmt_number(columns = f, decimals = 3)

    -
    - diff --git "a/ap\303\251ndice-principios-de-visualizacion.html" "b/ap\303\251ndice-principios-de-visualizacion.html" index d6ab5c8..a9e02a3 100644 --- "a/ap\303\251ndice-principios-de-visualizacion.html" +++ "b/ap\303\251ndice-principios-de-visualizacion.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git "a/ap\303\251ndice-transformaciones.html" "b/ap\303\251ndice-transformaciones.html" index 75cc578..968d952 100644 --- "a/ap\303\251ndice-transformaciones.html" +++ "b/ap\303\251ndice-transformaciones.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto @@ -553,23 +553,23 @@

    Apéndice: Transformaciones arrange(body) |> gt::gt() |> gt::fmt_number()

    • -
    - diff --git "a/bootstrap-param\303\251trico.html" "b/bootstrap-param\303\251trico.html" index d2a5a6a..c8950f3 100644 --- "a/bootstrap-param\303\251trico.html" +++ "b/bootstrap-param\303\251trico.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git "a/calibraci\303\263n-bayesiana-y-regularizaci\303\263n.html" "b/calibraci\303\263n-bayesiana-y-regularizaci\303\263n.html" index b206869..c2985cc 100644 --- "a/calibraci\303\263n-bayesiana-y-regularizaci\303\263n.html" +++ "b/calibraci\303\263n-bayesiana-y-regularizaci\303\263n.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto @@ -966,7 +966,8 @@

    Ejemplo: modelo normal y estaturas

    Ejemplo: estimación de proporciones

    -

    Ahora repetimos el ejercicio

    +

    Ahora repetimos el ejercicio de la estimación de la proporción de hogares con ingresos +superiores a 150 mil.

    # inicial
 a <- 2
 b <- 100
diff --git "a/estimaci\303\263n-por-m\303\241xima-verosimilitud.html" "b/estimaci\303\263n-por-m\303\241xima-verosimilitud.html"
index 55af588..5a24cff 100644
--- "a/estimaci\303\263n-por-m\303\241xima-verosimilitud.html"
+++ "b/estimaci\303\263n-por-m\303\241xima-verosimilitud.html"
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    •

  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git "a/estimaci\303\263n-y-distribuci\303\263n-de-muestreo-1.html" "b/estimaci\303\263n-y-distribuci\303\263n-de-muestreo-1.html" index b050cba..815d6ff 100644 --- "a/estimaci\303\263n-y-distribuci\303\263n-de-muestreo-1.html" +++ "b/estimaci\303\263n-y-distribuci\303\263n-de-muestreo-1.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git a/index.html b/index.html index 4190bc7..552cf9c 100644 --- a/index.html +++ b/index.html @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git a/intervalos-de-confianza-y-remuestreo.html b/intervalos-de-confianza-y-remuestreo.html index 9a12855..92956e3 100644 --- a/intervalos-de-confianza-y-remuestreo.html +++ b/intervalos-de-confianza-y-remuestreo.html @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git "a/introducci\303\263n-a-inferencia-bayesiana-1.html" "b/introducci\303\263n-a-inferencia-bayesiana-1.html" index d623e98..a200d1d 100644 --- "a/introducci\303\263n-a-inferencia-bayesiana-1.html" +++ "b/introducci\303\263n-a-inferencia-bayesiana-1.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto @@ -780,7 +780,7 @@

    Ejemplo: estimando una proporción\(\theta\) está en el intervalo

    quantile(sim_inicial$theta, c(0.025, 0.975)) |> round(2)
    ##  2.5% 97.5% 
-##  0.14  0.85
    +## 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 @@ -815,8 +815,8 @@

    Ejemplo: estimando una proporción\(\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 @@ -829,7 +829,7 @@

    Ejemplo: estimando una proporción\(\theta\) de credibilidad 95%. En inferencia bayesiana esto sustituye a los intervalos de confianza.

    diff --git "a/m\303\241s-de-pruebas-de-hip\303\263tesis-e-intervalos.html" "b/m\303\241s-de-pruebas-de-hip\303\263tesis-e-intervalos.html" index 8885c71..f295f36 100644 --- "a/m\303\241s-de-pruebas-de-hip\303\263tesis-e-intervalos.html" +++ "b/m\303\241s-de-pruebas-de-hip\303\263tesis-e-intervalos.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes

  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto diff --git "a/m\303\251todos-de-cadenas-de-markov-monte-carlo.html" "b/m\303\251todos-de-cadenas-de-markov-monte-carlo.html" index ed1a165..49423ff 100644 --- "a/m\303\251todos-de-cadenas-de-markov-monte-carlo.html" +++ "b/m\303\251todos-de-cadenas-de-markov-monte-carlo.html" @@ -412,7 +412,7 @@
  • Ejemplo: varias pruebas independientes
  • Simulando de la posterior
    • -
  • 12.1 Ejemplo de islas
    • +
  • Ejemplo de islas
  • ¿Por qué funciona Metrópolis?
  • Método de Metrópolis
  • Ajustando el tamaño de salto @@ -620,12 +620,12 @@

    Ejemplomedia_post <- mean(theta) momento_2_post <- mean(theta^2) c(media_post, momento_2_post)

    • -
    ## [1] 0.7155559 0.5372170
    +
    ## [1] 0.7147007 0.5364443

    Y podemos aproximar de esta manera cualquier cantidad de interés que esté basada en integrales, como probabilidades asociadas a \(\theta\) o cuantiles asociados. Por ejemplo, podemos aproximar fácilmente \(P(e^{\theta}> 2|x)\) haciendo

    mean(exp(theta) > 2)
    -
    ## [1] 0.5958
    +
    ## [1] 0.5959

    y así sucesivamente.

    Este enfoque, sin embargo, es mucho más flexible y poderoso.

    @@ -682,10 +682,10 @@

    Ejemplo: varias pruebas independientes
    # esta no es una manera muy rápida, podríamos calcular todas las
 # simulaciones de cada parámetro de manera vectorizada
 sims_posterior <- tibble(rep = 1:5000) %>% 
@@ -695,16 +695,16 @@ 
    Ejemplo: varias pruebas independientes
    sims_posterior %>% 
@@ -718,9 +718,9 @@ 
    Ejemplo: varias pruebas independientes\(p(\theta) = K f(\theta)\), donde sólo conocemos
 la función \(f(\theta)\).
    
 
-
    
-
    12.1 Ejemplo de islas
    
+
    
+
    Ejemplo de islas
    
 
    Comenzamos revisando el ejemplo de las islas en Kruschke (2015) (7.2) para tener más intuición de cómo funciona este algoritmo.
    
 
    
 
    
diff --git "a/propiedades-te\303\263ricas-de-mle.html" "b/propiedades-te\303\263ricas-de-mle.html"
index f2359d8..9e17e2e 100644
--- "a/propiedades-te\303\263ricas-de-mle.html"
+++ "b/propiedades-te\303\263ricas-de-mle.html"
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    • 
 
 
  • Simulando de la posterior
    • 
-
  • 12.1 Ejemplo de islas
    • 
+
  • Ejemplo de islas
    • 
 
  • ¿Por qué funciona Metrópolis?
    • 
 
  • Método de Metrópolis
    • 
 
  • Ajustando el tamaño de salto
diff --git "a/pruebas-de-hip\303\263tesis.html" "b/pruebas-de-hip\303\263tesis.html"
index 3c26fb3..e49045c 100644
--- "a/pruebas-de-hip\303\263tesis.html"
+++ "b/pruebas-de-hip\303\263tesis.html"
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    • 
 
 
  • Simulando de la posterior
    • 
-
  • 12.1 Ejemplo de islas
    • 
+
  • Ejemplo de islas
    • 
 
  • ¿Por qué funciona Metrópolis?
    • 
 
  • Método de Metrópolis
    • 
 
  • Ajustando el tamaño de salto
diff --git a/reference-keys.txt b/reference-keys.txt
index b19eb9d..e813064 100644
--- a/reference-keys.txt
+++ b/reference-keys.txt
@@ -15,4 +15,3 @@ más-de-pruebas-de-hipótesis-e-intervalos
 introducción-a-inferencia-bayesiana-1
 calibración-bayesiana-y-regularización
 métodos-de-cadenas-de-markov-monte-carlo
-ejemplo-de-islas
diff --git a/referencias.html b/referencias.html
index d97290a..5ab2a48 100644
--- a/referencias.html
+++ b/referencias.html
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    • 
 
 
  • Simulando de la posterior
    • 
-
  • 12.1 Ejemplo de islas
    • 
+
  • Ejemplo de islas
    • 
 
  • ¿Por qué funciona Metrópolis?
    • 
 
  • Método de Metrópolis
    • 
 
  • Ajustando el tamaño de salto
diff --git a/search_index.json b/search_index.json
index d3f2b92..6640986 100644
--- a/search_index.json
+++ b/search_index.json
@@ -1 +1 @@
-[["index.html", "Fundamentos de Estadística con Remuestreo Información del curso", " Fundamentos de Estadística con Remuestreo Teresa Ortiz, Felipe González, Alfredo Garbuno Información del curso Notas del curso Fundamentos de Estadística con Remuestreo, este curso busca explicar los principios básicos de la estadística y su papel en el análisis de datos. Nuestro punto de vista es uno de fundamentos, con menos énfasis en recetas o técnicas particulares. Ligas Notas: https://tereom.github.io/fundamentos-2024/ Repositorio con material: https://github.com/tereom/fundamentos-2024 Correo: teresa.ortiz.mancera@gmail.com Zoom clase (miércoles 4:00-7:00 pm): https://itam.zoom.us/j/92745909276 Zoom sesiones de dudas (lunes de 5:30-6:30 pm): https://itam.zoom.us/j/92518922348 Canvas: https://itam.instructure.com/courses/13328 x Este trabajo está bajo una Licencia Creative Commons Atribución 4.0 Internacional. "],["temario.html", "Temario Plan semanal Evaluación", " Temario Plan semanal Datos y análisis exploratorio Referencias: (W. S. Cleveland 1994), (Chihara and Hesterberg 2018) Visualización1 Análisis exploratorio Tipos de datos o estudios Muestras diseñadas y muestras naturales Experimentos y datos observacionales Introducción a Pruebas de Hipótesis Referencias: (Chihara and Hesterberg 2018) Introducción a pruebas de hipótesis. Pruebas de permutaciones Muestras pareadas y otros ejemplos Estimación y distribución de muestreo Referencias: (Chihara and Hesterberg 2018), (Tim C. Hesterberg 2015b) Estimadores y su distribución de muestreo Repaso de probabilidad y Teorema del límite central Introducción a estimación por intervalos Referencias: (Chihara and Hesterberg 2018), (Efron and Tibshirani 1993), (Tim C. Hesterberg 2015b) El método plugin y el boostrap Bootstrap e Intervalos de confianza. Ejemplos. Estimación Referencias: (Chihara and Hesterberg 2018), (Wasserman 2013) Estimación por máxima verosimilitud Ejemplos de estimación por máxima verosimilitud y Bootstrap paramétrico Propiedades de estimadores de máxima verosimilitud Más de pruebas de hipótesis Referencias: (Chihara and Hesterberg 2018), (Wasserman 2013) Pruebas de hipótesis para medias y proporciones: una y dos poblaciones. Introducción a inferencia bayesiana Referencias: (Kruschke 2015) Introducción a inferencia bayesiana Ejemplos de distribuciones conjugadas Introducción a métodos computacionales básicos: Muestreadores Metrópolis y Gibbs Ejemplos de inferencia bayesiana en Stan Evaluación Se evaluará mediante tareas semanales y dos exámenes: Tareas semanales (20%) Examen parcial en clase y a casa (40%) Examen final a casa (40%) Referencias "],["análisis-exploratorio.html", "Sección 1 Análisis exploratorio El papel de la exploración en el análisis de datos Preguntas y datos Algunos conceptos básicos Ejemplos Suavizamiento loess Caso de estudio: nacimientos en México", " Sección 1 Análisis exploratorio “Exploratory data analysis can never be the whole story, but nothing else can serve as the foundation stone –as the first step.” — John Tukey El papel de la exploración en el análisis de datos El estándar científico para contestar preguntas o tomar decisiones es uno que se basa en el análisis de datos. Es decir, en primer lugar se deben reunir todos los datos que puedan contener o sugerir alguna guía para entender mejor la pregunta o la decisión a la que nos enfrentamos. Esta recopilación de datos —que pueden ser cualitativos, cuantitativos, o una mezcla de los dos— debe entonces ser analizada para extraer información relevante para nuestro problema. En análisis de datos existen dos distintos tipos de trabajo: El trabajo exploratorio o de detective: ¿cuáles son los aspectos importantes de estos datos? ¿qué indicaciones generales muestran los datos? ¿qué tareas de análisis debemos empezar haciendo? ¿cuáles son los caminos generales para formular con precisión y contestar algunas preguntas que nos interesen? El trabajo inferencial, confirmatorio, o de juez: ¿cómo evaluar el peso de la evidencia de los descubrimientos del paso anterior? ¿qué tan bien soportadas están las respuestas y conclusiones por nuestro conjunto de datos? Preguntas y datos Cuando observamos un conjunto de datos, independientemente de su tamaño, el paso inicial más importante es entender bajo qué proceso se generan los datos. A grandes rasgos, cuanto más sepamos de este proceso, mejor podemos contestar preguntas de interés. En muchos casos, tendremos que hacer algunos supuestos de cómo se generan estos datos para dar respuestas (condicionales a esos supuestos). Algunos conceptos básicos Empezamos explicando algunas ideas que no serán útiles más adelante. El primer concepto se refiere a entender cómo se distribuyen los datos a los largo de su escala de medición. Comenzamos con un ejemplo: los siguientes datos fueron registrados en un restaurante durante cuatro días consecutivos. library(tidyverse) library(patchwork) # organizar gráficas library(gt) # formatear tablas source("R/funciones_auxiliares.R") # usamos los datos tips del paquete reshape2 propinas <- read_csv("./data/propinas.csv") Y vemos una muestra slice_sample(propinas, n = 10) |> gt() #xddpgkkgug table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #xddpgkkgug thead, #xddpgkkgug tbody, #xddpgkkgug tfoot, #xddpgkkgug tr, #xddpgkkgug td, #xddpgkkgug th { border-style: none; } #xddpgkkgug p { margin: 0; padding: 0; } #xddpgkkgug .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #xddpgkkgug .gt_caption { padding-top: 4px; padding-bottom: 4px; } #xddpgkkgug .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #xddpgkkgug .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #xddpgkkgug .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #xddpgkkgug .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #xddpgkkgug .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #xddpgkkgug .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #xddpgkkgug .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #xddpgkkgug .gt_column_spanner_outer:first-child { padding-left: 0; } #xddpgkkgug .gt_column_spanner_outer:last-child { padding-right: 0; } #xddpgkkgug .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #xddpgkkgug .gt_spanner_row { border-bottom-style: hidden; } #xddpgkkgug .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #xddpgkkgug .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #xddpgkkgug .gt_from_md > :first-child { margin-top: 0; } #xddpgkkgug .gt_from_md > :last-child { margin-bottom: 0; } #xddpgkkgug .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #xddpgkkgug .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #xddpgkkgug .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #xddpgkkgug .gt_row_group_first td { border-top-width: 2px; } #xddpgkkgug .gt_row_group_first th { border-top-width: 2px; } #xddpgkkgug .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #xddpgkkgug .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #xddpgkkgug .gt_first_summary_row.thick { border-top-width: 2px; } #xddpgkkgug .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #xddpgkkgug .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #xddpgkkgug .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #xddpgkkgug .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #xddpgkkgug .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #xddpgkkgug .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #xddpgkkgug .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #xddpgkkgug .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #xddpgkkgug .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #xddpgkkgug .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #xddpgkkgug .gt_left { text-align: left; } #xddpgkkgug .gt_center { text-align: center; } #xddpgkkgug .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #xddpgkkgug .gt_font_normal { font-weight: normal; } #xddpgkkgug .gt_font_bold { font-weight: bold; } #xddpgkkgug .gt_font_italic { font-style: italic; } #xddpgkkgug .gt_super { font-size: 65%; } #xddpgkkgug .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #xddpgkkgug .gt_asterisk { font-size: 100%; vertical-align: 0; } #xddpgkkgug .gt_indent_1 { text-indent: 5px; } #xddpgkkgug .gt_indent_2 { text-indent: 10px; } #xddpgkkgug .gt_indent_3 { text-indent: 15px; } #xddpgkkgug .gt_indent_4 { text-indent: 20px; } #xddpgkkgug .gt_indent_5 { text-indent: 25px; } #xddpgkkgug .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #xddpgkkgug div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } cuenta_total propina fumador dia momento num_personas 9.78 1.73 No Jue Comida 2 13.42 1.68 No Jue Comida 2 11.02 1.98 Si Sab Cena 2 22.49 3.50 No Vie Cena 2 11.59 1.50 Si Sab Cena 2 24.71 5.85 No Jue Comida 2 9.60 4.00 Si Dom Cena 2 19.65 3.00 No Sab Cena 2 18.04 3.00 No Dom Cena 2 30.40 5.60 No Dom Cena 4 Aquí la unidad de observación es una cuenta particular. Tenemos tres mediciones numéricas de cada cuenta: cúanto fue la cuenta total, la propina, y el número de personas asociadas a la cuenta. Los datos están separados según se fumó o no en la mesa, y temporalmente en dos partes: el día (Jueves, Viernes, Sábado o Domingo), cada uno separado por Cena y Comida. Denotamos por \\(x\\) el valor de medición de una unidad de observación. Usualmente utilizamos sub-índices para identificar entre diferentes puntos de datos (observaciones), por ejemplo, \\(x_n\\) para la \\(n-\\)ésima observación. De tal forma que una colección de \\(N\\) observaciones la escribimos como \\[\\begin{align} \\{x_1, \\ldots, x_N\\}. \\end{align}\\] El primer tipo de comparaciones que nos interesa hacer es para una medición: ¿Varían mucho o poco los datos de un tipo de medición? ¿Cuáles son valores típicos o centrales? ¿Existen valores atípicos? Supongamos entonces que consideramos simplemente la variable de cuenta_total. Podemos comenzar por ordenar los datos, y ver cuáles datos están en los extremos y cuáles están en los lugares centrales: propinas <- propinas |> mutate(orden_cuenta = rank(cuenta_total, ties.method = "first"), f = (orden_cuenta - 0.5) / n()) cuenta <- propinas |> select(orden_cuenta, f, cuenta_total) |> arrange(f) bind_rows(head(cuenta), tail(cuenta)) |> gt() |> fmt_number(columns = f, decimals = 3) #zwocxfeiud table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #zwocxfeiud thead, #zwocxfeiud tbody, #zwocxfeiud tfoot, #zwocxfeiud tr, #zwocxfeiud td, #zwocxfeiud th { border-style: none; } #zwocxfeiud p { margin: 0; padding: 0; } #zwocxfeiud .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #zwocxfeiud .gt_caption { padding-top: 4px; padding-bottom: 4px; } #zwocxfeiud .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #zwocxfeiud .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #zwocxfeiud .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #zwocxfeiud .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #zwocxfeiud .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #zwocxfeiud .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #zwocxfeiud .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #zwocxfeiud .gt_column_spanner_outer:first-child { padding-left: 0; } #zwocxfeiud .gt_column_spanner_outer:last-child { padding-right: 0; } #zwocxfeiud .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #zwocxfeiud .gt_spanner_row { border-bottom-style: hidden; } #zwocxfeiud .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #zwocxfeiud .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #zwocxfeiud .gt_from_md > :first-child { margin-top: 0; } #zwocxfeiud .gt_from_md > :last-child { margin-bottom: 0; } #zwocxfeiud .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #zwocxfeiud .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #zwocxfeiud .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #zwocxfeiud .gt_row_group_first td { border-top-width: 2px; } #zwocxfeiud .gt_row_group_first th { border-top-width: 2px; } #zwocxfeiud .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #zwocxfeiud .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #zwocxfeiud .gt_first_summary_row.thick { border-top-width: 2px; } #zwocxfeiud .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #zwocxfeiud .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #zwocxfeiud .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #zwocxfeiud .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #zwocxfeiud .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #zwocxfeiud .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #zwocxfeiud .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #zwocxfeiud .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #zwocxfeiud .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #zwocxfeiud .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #zwocxfeiud .gt_left { text-align: left; } #zwocxfeiud .gt_center { text-align: center; } #zwocxfeiud .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #zwocxfeiud .gt_font_normal { font-weight: normal; } #zwocxfeiud .gt_font_bold { font-weight: bold; } #zwocxfeiud .gt_font_italic { font-style: italic; } #zwocxfeiud .gt_super { font-size: 65%; } #zwocxfeiud .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #zwocxfeiud .gt_asterisk { font-size: 100%; vertical-align: 0; } #zwocxfeiud .gt_indent_1 { text-indent: 5px; } #zwocxfeiud .gt_indent_2 { text-indent: 10px; } #zwocxfeiud .gt_indent_3 { text-indent: 15px; } #zwocxfeiud .gt_indent_4 { text-indent: 20px; } #zwocxfeiud .gt_indent_5 { text-indent: 25px; } #zwocxfeiud .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #zwocxfeiud div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } orden_cuenta f cuenta_total 1 0.002 3.07 2 0.006 5.75 3 0.010 7.25 4 0.014 7.25 5 0.018 7.51 6 0.023 7.56 239 0.977 44.30 240 0.982 45.35 241 0.986 48.17 242 0.990 48.27 243 0.994 48.33 244 0.998 50.81 También podemos graficar los datos en orden, interpolando valores consecutivos. A esta función le llamamos la función de cuantiles para la variable cuenta_total. Nos sirve para comparar directamente los distintos valores que observamos los datos según el orden que ocupan. En particular, podemos estudiar la dispersión y valores centrales de los datos observados: El rango de datos va de unos 3 dólares hasta 50 dólares Los valores centrales, por ejemplo el 50% de los valores más centrales, están entre unos 13 y 25 dólares. El valor que divide en dos mitades iguales a los datos es de alrededor de 18 dólares. El cuantil \\(f\\), que denotamos por \\(q(f)\\) es valor a lo largo de la escala de medición de los datos tal que aproximadamente una fracción \\(f\\) de los datos son menores o iguales a \\(q(f)\\). Al cuantil \\(f=0.5\\) le llamamos la mediana. A los cuantiles \\(f=0.25\\) y \\(f=0.75\\) les llamamos cuartiles inferior y superior. En nuestro ejemplo: Los valores centrales —del cuantil 0.25 al 0.75, por decir un ejemplo— están entre unos 13 y 25 dólares. Estos dos cuantiles se llaman cuartil inferior y cuartil superior respectivamente El cuantil 0.5 (o también conocido como mediana) está alrededor de 18 dólares. Éste último puede ser utilizado para dar un valor central de la distribución de valores para cuenta_total. Asimismo podemos dar resúmenes más refinados si es necesario. Por ejemplo, podemos reportar que: El cuantil 0.95 es de unos 35 dólares — sólo 5% de las cuentas son de más de 35 dólares El cuantil 0.05 es de unos 8 dólares — sólo 5% de las cuentas son de 8 dólares o menos. Finalmente, la forma de la gráfica se interpreta usando su pendiente (tasa de cambio) haciendo comparaciones en diferentes partes de la gráfica: La distribución de valores tiene asimetría: el 10% de las cuentas más altas tiene considerablemente más dispersión que el 10% de las cuentas más bajas. Entre los cuantiles 0.2 y 0.7 es donde existe mayor densidad de datos: la pendiente (tasa de cambio) es baja, lo que significa que al avanzar en los valores observados, los cuantiles (el porcentaje de casos) aumenta rápidamente. Cuando la pendiente alta, quiere decir que los datos tienen más dispersión local o están más separados. Observación: Hay varias maneras de definir los cuantiles (ver (William S. Cleveland 1993)): Supongamos que queremos definir \\(q(f)\\), y denotamos los datos ordenados como \\(x_{(1)}, x_{(2)}, \\ldots, x_{(N)}\\), de forma que \\(x_{(1)}\\) es el dato más chico y \\(x_{(N)}\\) es el dato más grande. Para cada \\(x_{(i)}\\) definimos \\[f_i = i / N\\] entonces definimos el cuantil \\(q(f_i)=x_{(i)}\\). Para cualquier \\(f\\) entre 0 y 1, podemos definir \\(q(f)\\) como sigue: si \\(f\\) está entre \\(f_i\\) y \\(f_{i+1}\\) interpolamos linealmente los valores correspondientes \\(x_{(i)}\\) y \\(x_{(i+1)}\\). En la práctica, es más conveniente usar \\(f_i= \\frac{i - 0.5}{N}\\). La gráfica de cuantiles no cambia mucho comparado con la difinición anterior, y esto nos permitirá comparar de mejor manera con distribuciones teóricas que no tienen definido su cuantil 0 y el 1, pues tienen soporte en los números reales (como la distribución normal, por ejemplo). Asociada a la función de cuantiles \\(q\\) tenemos la distribución acumulada empírica de los datos, que es aproximadamente inversa de la función de cuantiles, y se define como: \\[\\hat{F}(x) = i/N\\] si \\(x_{(i)} \\leq x < x_{(i+1)}\\). Nótese que \\(\\hat{F}(q(f_i)) = i/N = f_i\\) (demuéstralo). acum_cuenta <- ecdf(cuenta$cuenta_total) cuenta <- cuenta |> mutate(dea_cuenta_total = acum_cuenta(cuenta_total)) g_acum <- ggplot(cuenta, aes(x = cuenta_total, y = dea_cuenta_total)) + geom_point() + labs(subtitle = "Distribución acum empírica de cuenta total", x = "") g_cuantiles + g_acum La función de distribución acumulada empírica es otra forma de graficar la dispersión de los datos. En su gráfica vemos que proporción de los datos que son iguales o están por debajo de cada valor en el eje horizontal. Nota: En análisis de datos, es más frecuente utilizar la función de cuantiles pues existen versiones más generales que son útiles, por ejemplo, para evaluar ajuste de modelos probabilísticos En la teoría, generalmente es más común utilizar la fda empírica, que tiene una única definición que veremos coincide con definiciones teóricas. Histogramas En algunos casos, es más natural hacer un histograma, donde dividimos el rango de la variable en cubetas o intervalos (en este caso de igual longitud), y graficamos por medio de barras cuántos datos caen en cada cubeta: Es una gráfica más popular, pero perdemos cierto nivel de detalle, y distintas particiones resaltan distintos aspectos de los datos. ¿Cómo se ve la gráfica de cuantiles de las propinas? ¿Cómo crees que esta gráfica se compara con distintos histogramas? g_1 <- ggplot(propinas, aes(sample = propina)) + geom_qq(distribution = stats::qunif) + labs(x = "f", y = "propina") g_1 Finalmente, una gráfica más compacta que resume la gráfica de cuantiles o el histograma es el diagrama de caja y brazos. Mostramos dos versiones, la clásica de Tukey (T) y otra versión menos común de Spear/Tufte (ST): library(ggthemes) cuartiles <- quantile(cuenta$cuenta_total) cuartiles |> round(2) ## 0% 25% 50% 75% 100% ## 3.07 13.35 17.80 24.13 50.81 g_1 <- ggplot(cuenta, aes(x = f, y = cuenta_total)) + labs(subtitle = "Gráfica de cuantiles: Cuenta total") + geom_hline(yintercept = cuartiles[2:4], colour = "gray") + geom_point(alpha = 0.5) + geom_line() g_2 <- ggplot(cuenta, aes(x = factor("ST", levels = "ST"), y = cuenta_total)) + geom_tufteboxplot() + labs(subtitle = "", x = "", y = "") g_3 <- ggplot(cuenta, aes(x = factor("T"), y = cuenta_total)) + geom_boxplot() + labs(subtitle = "", x = "", y = "") g_4 <- ggplot(cuenta, aes(x = factor("P"), y = cuenta_total)) + geom_jitter(height = 0, width =0.2, alpha = 0.5) + labs(subtitle = "", x = "", y = "") g_5 <- ggplot(cuenta, aes(x = factor("V"), y = cuenta_total)) + geom_violin() + labs(subtitle = "", x = "", y = "") g_1 + g_2 + g_3 + g_4 + plot_layout(widths = c(8, 2, 2, 2)) El diagrama de abajo explica los elementos de la versión típica del diagrama de caja y brazos (boxplot). RIC se refiere al Rango Intercuantílico, definido por la diferencia entre los cuantiles 25% y 75%. Figura: Jumanbar / CC BY-SA Ventajas en el análisis inicial En un principio del análisis, estos resúmenes (cuantiles) pueden ser más útiles que utilizar medias y varianzas, por ejemplo. La razón es que los cuantiles: Son cantidades más fácilmente interpretables Los cuantiles centrales son más resistentes a valores atípicos que medias o varianzas Permiten identificar valores extremos Es fácil comparar cuantiles de distintos bonches de datos en la misma escala Nota: Existen diferentes definiciones para calcular cuantiles de una muestra de datos, puedes leer más en este artículo. Media y desviación estándar Las medidas más comunes de localización y dispersión para un conjunto de datos son la media muestral y la desviación estándar muestral. En general, no son muy apropiadas para iniciar el análisis exploratorio, pues: Son medidas más difíciles de interpretar y explicar que los cuantiles. En este sentido, son medidas especializadas. Por ejemplo, compara una explicación intuitiva de la mediana contra una explicación intuitiva de la media. No son resistentes a valores atípicos. Su falta de resistencia los vuelve poco útiles en las primeras etapas de limpieza y descripción y en resúmenes deficientes para distribuciones irregulares (con colas largas por ejemplo). La media, o promedio, se denota por \\(\\bar x\\) y se define como \\[\\begin{align} \\bar x = \\frac1N \\sum_{n = 1}^N x_n. \\end{align}\\] La desviación estándar muestral se define como \\[\\begin{align} \\text{std}(x) = \\sqrt{\\frac1{N-1} \\sum_{n = 1}^N (x_n - \\bar x)^2}. \\end{align}\\] Observación: Si \\(N\\) no es muy chica, no importa mucho si dividimos por \\(N\\) o por \\(N-1\\) en la fórmula de la desviación estándar. La razón de que típicamente se usa \\(N-1\\) la veremos más adelante, en la parte de estimación. Por otro lado, ventajas de estas medidas de centralidad y dispersión son: La media y desviación estándar son computacionalmente convenientes. Por lo tanto regresaremos a estas medidas una vez que estudiemos modelos de probabilidad básicos. En muchas ocasiones conviene usar estas medidas pues permite hacer comparaciones históricas o tradicionales —pues análisis anteriores pudieran estar basados en éstas. Considera el caso de tener \\(N\\) observaciones y asume que ya tienes calculado el promedio para dichas observaciones. Este promedio lo denotaremos por \\(\\bar x_N\\). Ahora, considera que has obtenido \\(M\\) observaciones más. Escribe una fórmula recursiva para la media del conjunto total de datos \\(\\bar x_{N+M}\\) en función de lo que ya tenías precalculado \\(\\bar x_N.\\) ¿En qué situaciones esta propiedad puede ser conveniente? Ejemplos Precios de casas En este ejemplo consideremos los datos de precios de ventas de la ciudad de Ames, Iowa. En particular nos interesa entender la variación del precio de las casas. Por este motivo calculamos los cuantiles que corresponden al 25%, 50% y 75% (cuartiles), así como el mínimo y máximo de los precios de las casas: quantile(casas |> pull(precio_miles)) ## 0% 25% 50% 75% 100% ## 37.9 132.0 165.0 215.0 755.0 Comprueba que el mínimo y máximo están asociados a los cuantiles 0% y 100%, respectivamente. Una posible comparación es considerar los precios y sus variación en función de zona de la ciudad en que se encuentra una vivienda. Podemos usar diagramas de caja y brazos para hacer una comparación burda de los precios en distintas zonas de la ciudad: ggplot(casas, aes(x = nombre_zona, y = precio_miles)) + geom_boxplot() + coord_flip() La primera pregunta que nos hacemos es cómo pueden variar las características de las casas dentro de cada zona. Para esto, podemos considerar el área de las casas. En lugar de graficar el precio, graficamos el precio por metro cuadrado, por ejemplo: ggplot(casas, aes(x = nombre_zona, y = precio_m2)) + geom_boxplot() + coord_flip() Podemos cuantificar la variación que observamos de zona a zona y la variación que hay dentro de cada una de las zonas. Una primera aproximación es observar las variación del precio al calcular la mediana dentro de cada zona, y después cuantificar por medio de cuantiles cómo varía la mediana entre zonas: casas |> group_by(nombre_zona) |> summarise(mediana_zona = median(precio_m2), .groups = "drop") |> arrange(mediana_zona) |> pull(mediana_zona) |> quantile() |> round() ## 0% 25% 50% 75% 100% ## 963 1219 1298 1420 1725 Por otro lado, las variaciones con respecto a las medianas dentro de cada zona, por grupo, se resume como: quantile(casas |> group_by(nombre_zona) |> mutate(residual = precio_m2 - median(precio_m2)) |> pull(residual)) |> round() ## 0% 25% 50% 75% 100% ## -765 -166 0 172 1314 Nótese que este último paso tiene sentido pues la variación dentro de las zonas, en términos de precio por metro cuadrado, es similar. Esto no lo podríamos haber hecho de manera efectiva si se hubiera utilizado el precio de las casas sin ajustar por su tamaño. Podemos resumir este primer análisis con un par de gráficas de cuantiles (William S. Cleveland (1993)): mediana <- median(casas$precio_m2) resumen <- casas |> select(nombre_zona, precio_m2) |> group_by(nombre_zona) |> mutate(mediana_zona = median(precio_m2)) |> mutate(residual = precio_m2 - mediana_zona) |> ungroup() |> mutate(mediana_zona = mediana_zona - mediana) |> select(nombre_zona, mediana_zona, residual) |> pivot_longer(mediana_zona:residual, names_to = "tipo", values_to = "valor") ggplot(resumen, aes(sample = valor)) + geom_qq(distribution = stats::qunif) + facet_wrap(~ tipo) + ylab("Precio por m2") + xlab("f") + labs(subtitle = "Precio por m2 por zona", caption = paste0("Mediana total de ", round(mediana))) Vemos que la mayor parte de la variación del precio por metro cuadrado ocurre dentro de cada zona, una vez que controlamos por el tamaño de las casas. La variación dentro de cada zona es aproximadamente simétrica, aunque la cola derecha es ligeramente más larga con algunos valores extremos. Podemos seguir con otro indicador importante: la calificación de calidad de los terminados de las casas. Como primer intento podríamos hacer: Lo que indica que las calificaciones de calidad están distribuidas de manera muy distinta a lo largo de las zonas, y que probablemente no va ser simple desentrañar qué variación del precio se debe a la zona y cuál se debe a la calidad. Prueba Enlace Consideremos la prueba Enlace (2011) de matemáticas para primarias. Una primera pregunta que alguien podría hacerse es: ¿cuáles escuelas son mejores en este rubro, las privadas o las públicas? enlace_tbl <- enlace |> group_by(tipo) |> summarise(n_escuelas = n(), cuantiles = list(cuantil(mate_6, c(0.05, 0.25, 0.5, 0.75, 0.95)))) |> unnest(cols = cuantiles) |> mutate(valor = round(valor)) enlace_tbl |> spread(cuantil, valor) |> gt() #sykxxonvyi table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #sykxxonvyi thead, #sykxxonvyi tbody, #sykxxonvyi tfoot, #sykxxonvyi tr, #sykxxonvyi td, #sykxxonvyi th { border-style: none; } #sykxxonvyi p { margin: 0; padding: 0; } #sykxxonvyi .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #sykxxonvyi .gt_caption { padding-top: 4px; padding-bottom: 4px; } #sykxxonvyi .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #sykxxonvyi .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #sykxxonvyi .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #sykxxonvyi .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #sykxxonvyi .gt_column_spanner_outer:first-child { padding-left: 0; } #sykxxonvyi .gt_column_spanner_outer:last-child { padding-right: 0; } #sykxxonvyi .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #sykxxonvyi .gt_spanner_row { border-bottom-style: hidden; } #sykxxonvyi .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #sykxxonvyi .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #sykxxonvyi .gt_from_md > :first-child { margin-top: 0; } #sykxxonvyi .gt_from_md > :last-child { margin-bottom: 0; } #sykxxonvyi .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #sykxxonvyi .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #sykxxonvyi .gt_row_group_first td { border-top-width: 2px; } #sykxxonvyi .gt_row_group_first th { border-top-width: 2px; } #sykxxonvyi .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #sykxxonvyi .gt_first_summary_row.thick { border-top-width: 2px; } #sykxxonvyi .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #sykxxonvyi .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #sykxxonvyi .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_left { text-align: left; } #sykxxonvyi .gt_center { text-align: center; } #sykxxonvyi .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #sykxxonvyi .gt_font_normal { font-weight: normal; } #sykxxonvyi .gt_font_bold { font-weight: bold; } #sykxxonvyi .gt_font_italic { font-style: italic; } #sykxxonvyi .gt_super { font-size: 65%; } #sykxxonvyi .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #sykxxonvyi .gt_asterisk { font-size: 100%; vertical-align: 0; } #sykxxonvyi .gt_indent_1 { text-indent: 5px; } #sykxxonvyi .gt_indent_2 { text-indent: 10px; } #sykxxonvyi .gt_indent_3 { text-indent: 15px; } #sykxxonvyi .gt_indent_4 { text-indent: 20px; } #sykxxonvyi .gt_indent_5 { text-indent: 25px; } #sykxxonvyi .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #sykxxonvyi div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } tipo n_escuelas 0.05 0.25 0.5 0.75 0.95 Indígena/Conafe 13599 304 358 412 478 588 General 60166 380 454 502 548 631 Particular 6816 479 551 593 634 703 Para un análisis exploratorio podemos utilizar distintas gráficas. Por ejemplo, podemos utilizar nuevamente las gráficas de caja y brazos, así como graficar los percentiles. Nótese que en la gráfica 1 se utilizan los cuantiles 0.05, 0.25, 0.5, 0.75 y 0.95: ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0. ## ℹ Please use `linewidth` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. Se puede discutir qué tan apropiada es cada gráfica con el objetivo de realizar comparaciones. Sin duda, graficar más cuantiles es más útil para hacer comparaciones. Por ejemplo, en la Gráfica 1 podemos ver que la mediana de las escuelas generales está cercana al cuantil 5% de las escuelas particulares. Por otro lado, el diagrama de caja y brazos muestra también valores “atípicos”. Antes de contestar prematuramente la pregunta: ¿cuáles son las mejores escuelas? busquemos mejorar la interpretabilidad de nuestras comparaciones. Podemos comenzar por agregar, por ejemplo, el nivel del marginación del municipio donde se encuentra la escuela. Para este objetivo, podemos usar páneles (pequeños múltiplos útiles para hacer comparaciones) y graficar: Esta gráfica pone en contexto la pregunta inicial, y permite evidenciar la dificultad de contestarla. En particular: Señala que la pregunta no sólo debe concentarse en el tipo de “sistema”: pública, privada, etc. Por ejemplo, las escuelas públicas en zonas de marginación baja no tienen una distribución de calificaciones muy distinta a las privadas en zonas de marginación alta. El contexto de la escuela es importante. Debemos de pensar qué factores –por ejemplo, el entorno familiar de los estudiantes– puede resultar en comparaciones que favorecen a las escuelas privadas. Un ejemplo de esto es considerar si los estudiantes tienen que trabajar o no. A su vez, esto puede o no ser reflejo de la calidad del sistema educativo. Si esto es cierto, entonces la pregunta inicial es demasiado vaga y mal planteada. Quizá deberíamos intentar entender cuánto “aporta” cada escuela a cada estudiante, como medida de qué tan buena es cada escuela. Estados y calificaciones en SAT ¿Cómo se relaciona el gasto por alumno, a nivel estatal, con sus resultados académicos? Hay trabajo considerable en definir estos términos, pero supongamos que tenemos el siguiente conjunto de datos (Guber 1999), que son datos oficiales agregados por estado de Estados Unidos. Consideremos el subconjunto de variables sat, que es la calificación promedio de los alumnos en cada estado (para 1997) y expend, que es el gasto en miles de dólares por estudiante en (1994-1995). sat <- read_csv("data/sat.csv") sat_tbl <- sat |> select(state, expend, sat) |> gather(variable, valor, expend:sat) |> group_by(variable) |> summarise(cuantiles = list(cuantil(valor))) |> unnest(cols = c(cuantiles)) |> mutate(valor = round(valor, 1)) |> spread(cuantil, valor) sat_tbl |> gt() #trvhlcrcph table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #trvhlcrcph thead, #trvhlcrcph tbody, #trvhlcrcph tfoot, #trvhlcrcph tr, #trvhlcrcph td, #trvhlcrcph th { border-style: none; } #trvhlcrcph p { margin: 0; padding: 0; } #trvhlcrcph .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #trvhlcrcph .gt_caption { padding-top: 4px; padding-bottom: 4px; } #trvhlcrcph .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #trvhlcrcph .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #trvhlcrcph .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #trvhlcrcph .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #trvhlcrcph .gt_column_spanner_outer:first-child { padding-left: 0; } #trvhlcrcph .gt_column_spanner_outer:last-child { padding-right: 0; } #trvhlcrcph .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #trvhlcrcph .gt_spanner_row { border-bottom-style: hidden; } #trvhlcrcph .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #trvhlcrcph .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #trvhlcrcph .gt_from_md > :first-child { margin-top: 0; } #trvhlcrcph .gt_from_md > :last-child { margin-bottom: 0; } #trvhlcrcph .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #trvhlcrcph .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #trvhlcrcph .gt_row_group_first td { border-top-width: 2px; } #trvhlcrcph .gt_row_group_first th { border-top-width: 2px; } #trvhlcrcph .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #trvhlcrcph .gt_first_summary_row.thick { border-top-width: 2px; } #trvhlcrcph .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #trvhlcrcph .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #trvhlcrcph .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_left { text-align: left; } #trvhlcrcph .gt_center { text-align: center; } #trvhlcrcph .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #trvhlcrcph .gt_font_normal { font-weight: normal; } #trvhlcrcph .gt_font_bold { font-weight: bold; } #trvhlcrcph .gt_font_italic { font-style: italic; } #trvhlcrcph .gt_super { font-size: 65%; } #trvhlcrcph .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #trvhlcrcph .gt_asterisk { font-size: 100%; vertical-align: 0; } #trvhlcrcph .gt_indent_1 { text-indent: 5px; } #trvhlcrcph .gt_indent_2 { text-indent: 10px; } #trvhlcrcph .gt_indent_3 { text-indent: 15px; } #trvhlcrcph .gt_indent_4 { text-indent: 20px; } #trvhlcrcph .gt_indent_5 { text-indent: 25px; } #trvhlcrcph .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #trvhlcrcph div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } variable 0 0.25 0.5 0.75 1 expend 3.7 4.9 5.8 6.4 9.8 sat 844.0 897.2 945.5 1032.0 1107.0 Esta variación es considerable para promedios del SAT: el percentil 75 es alrededor de 1050 puntos, mientras que el percentil 25 corresponde a alrededor de 800. Igualmente, hay diferencias considerables de gasto por alumno (miles de dólares) a lo largo de los estados. Ahora hacemos nuestro primer ejercico de comparación: ¿Cómo se ven las calificaciones para estados en distintos niveles de gasto? Podemos usar una gráfica de dispersión: library(ggrepel) ggplot(sat, aes(x = expend, y = sat, label = state)) + geom_point(colour = "red", size = 2) + geom_text_repel(colour = "gray50") + xlab("Gasto por alumno (miles de dólares)") + ylab("Calificación promedio en SAT") Estas comparaciones no son de alta calidad, solo estamos usando 2 variables —que son muy pocas— y no hay mucho que podamos decir en cuanto explicación. Sin duda nos hace falta una imagen más completa. Necesitaríamos entender la correlación que existe entre las demás características de nuestras unidades de estudio. Las unidades que estamos comparando pueden diferir fuertemente en otras propiedades importantes (o dimensiones), lo cual no permite interpretar la gráfica de manera sencilla. Una variable que tenemos es el porcentaje de alumnos de cada estado que toma el SAT. Podemos agregar como sigue: ggplot(sat, aes(x = expend, y = math, label=state, colour = frac)) + geom_point() + geom_text_repel() + xlab("Gasto por alumno (miles de dólares)") + ylab("Calificación promedio en SAT") Esto nos permite entender por qué nuestra comparación inicial es relativamente pobre. Los estados con mejores resultados promedio en el SAT son aquellos donde una fracción relativamente baja de los estudiantes toma el examen. La diferencia es considerable. En este punto podemos hacer varias cosas. Una primera idea es intentar comparar estados más similares en cuanto a la población de alumnos que asiste. Podríamos hacer grupos como sigue: set.seed(991) k_medias_sat <- kmeans(sat |> select(frac), centers = 4, nstart = 100, iter.max = 100) sat$clase <- k_medias_sat$cluster sat <- sat |> group_by(clase) |> mutate(clase_media = round(mean(frac))) |> ungroup() |> mutate(clase_media = factor(clase_media)) sat <- sat |> mutate(rank_p = rank(frac, ties= "first") / length(frac)) ggplot(sat, aes(x = rank_p, y = frac, label = state, colour = clase_media)) + geom_point(size = 2) Estos resultados indican que es más probable que buenos alumnos decidan hacer el SAT. Lo interesante es que esto ocurre de manera diferente en cada estado. Por ejemplo, en algunos estados era más común otro examen: el ACT. Si hacemos clusters de estados según el % de alumnos, empezamos a ver otra historia. Para esto, ajustemos rectas de mínimos cuadrados como referencia: Esto da una imagen muy diferente a la que originalmente planteamos. Nota que dependiendo de cómo categorizamos, esta gráfica puede variar (puedes intentar con más o menos grupos, por ejemplo). Tablas de conteos Consideremos los siguientes datos de tomadores de té (del paquete FactoMineR (Lê et al. 2008)): tea <- read_csv("data/tea.csv") # nombres y códigos te <- tea |> select(how, price, sugar) |> rename(presentacion = how, precio = price, azucar = sugar) |> mutate( presentacion = fct_recode(presentacion, suelto = "unpackaged", bolsas = "tea bag", mixto = "tea bag+unpackaged"), precio = fct_recode(precio, marca = "p_branded", variable = "p_variable", barato = "p_cheap", marca_propia = "p_private label", desconocido = "p_unknown", fino = "p_upscale"), azucar = fct_recode(azucar, sin_azúcar = "No.sugar", con_azúcar = "sugar")) sample_n(te, 10) ## # A tibble: 10 × 3 ## presentacion precio azucar ## <fct> <fct> <fct> ## 1 bolsas marca sin_azúcar ## 2 bolsas variable sin_azúcar ## 3 bolsas marca con_azúcar ## 4 bolsas fino con_azúcar ## 5 mixto variable con_azúcar ## 6 mixto fino con_azúcar ## 7 bolsas marca sin_azúcar ## 8 bolsas fino sin_azúcar ## 9 mixto variable con_azúcar ## 10 mixto variable sin_azúcar Nos interesa ver qué personas compran té suelto, y de qué tipo. Empezamos por ver las proporciones que compran té según su empaque (en bolsita o suelto): precio <- te |> count(precio) |> mutate(prop = round(100 * n / sum(n))) |> select(-n) tipo <- te |> count(presentacion) |> mutate(pct = round(100 * n / sum(n))) tipo |> gt() #wiljiluquk table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #wiljiluquk thead, #wiljiluquk tbody, #wiljiluquk tfoot, #wiljiluquk tr, #wiljiluquk td, #wiljiluquk th { border-style: none; } #wiljiluquk p { margin: 0; padding: 0; } #wiljiluquk .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #wiljiluquk .gt_caption { padding-top: 4px; padding-bottom: 4px; } #wiljiluquk .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #wiljiluquk .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #wiljiluquk .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #wiljiluquk .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #wiljiluquk .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #wiljiluquk .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #wiljiluquk .gt_column_spanner_outer:first-child { padding-left: 0; } #wiljiluquk .gt_column_spanner_outer:last-child { padding-right: 0; } #wiljiluquk .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #wiljiluquk .gt_spanner_row { border-bottom-style: hidden; } #wiljiluquk .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #wiljiluquk .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #wiljiluquk .gt_from_md > :first-child { margin-top: 0; } #wiljiluquk .gt_from_md > :last-child { margin-bottom: 0; } #wiljiluquk .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #wiljiluquk .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #wiljiluquk .gt_row_group_first td { border-top-width: 2px; } #wiljiluquk .gt_row_group_first th { border-top-width: 2px; } #wiljiluquk .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #wiljiluquk .gt_first_summary_row.thick { border-top-width: 2px; } #wiljiluquk .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #wiljiluquk .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #wiljiluquk .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #wiljiluquk .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #wiljiluquk .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_left { text-align: left; } #wiljiluquk .gt_center { text-align: center; } #wiljiluquk .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #wiljiluquk .gt_font_normal { font-weight: normal; } #wiljiluquk .gt_font_bold { font-weight: bold; } #wiljiluquk .gt_font_italic { font-style: italic; } #wiljiluquk .gt_super { font-size: 65%; } #wiljiluquk .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #wiljiluquk .gt_asterisk { font-size: 100%; vertical-align: 0; } #wiljiluquk .gt_indent_1 { text-indent: 5px; } #wiljiluquk .gt_indent_2 { text-indent: 10px; } #wiljiluquk .gt_indent_3 { text-indent: 15px; } #wiljiluquk .gt_indent_4 { text-indent: 20px; } #wiljiluquk .gt_indent_5 { text-indent: 25px; } #wiljiluquk .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #wiljiluquk div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } presentacion n pct bolsas 170 57 mixto 94 31 suelto 36 12 La mayor parte de las personas toma té en bolsas. Sin embargo, el tipo de té (en términos de precio o marca) que compran es muy distinto dependiendo de la presentación: tipo <- tipo |> select(presentacion, prop_presentacion = pct) tabla_cruzada <- te |> count(presentacion, precio) |> # porcentajes por presentación group_by(presentacion) |> mutate(prop = round(100 * n / sum(n))) |> select(-n) tabla_cruzada |> pivot_wider(names_from = presentacion, values_from = prop, values_fill = list(prop = 0)) |> gt() #sxkvcchtyg table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #sxkvcchtyg thead, #sxkvcchtyg tbody, #sxkvcchtyg tfoot, #sxkvcchtyg tr, #sxkvcchtyg td, #sxkvcchtyg th { border-style: none; } #sxkvcchtyg p { margin: 0; padding: 0; } #sxkvcchtyg .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #sxkvcchtyg .gt_caption { padding-top: 4px; padding-bottom: 4px; } #sxkvcchtyg .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #sxkvcchtyg .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #sxkvcchtyg .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #sxkvcchtyg .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #sxkvcchtyg .gt_column_spanner_outer:first-child { padding-left: 0; } #sxkvcchtyg .gt_column_spanner_outer:last-child { padding-right: 0; } #sxkvcchtyg .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #sxkvcchtyg .gt_spanner_row { border-bottom-style: hidden; } #sxkvcchtyg .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #sxkvcchtyg .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #sxkvcchtyg .gt_from_md > :first-child { margin-top: 0; } #sxkvcchtyg .gt_from_md > :last-child { margin-bottom: 0; } #sxkvcchtyg .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #sxkvcchtyg .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #sxkvcchtyg .gt_row_group_first td { border-top-width: 2px; } #sxkvcchtyg .gt_row_group_first th { border-top-width: 2px; } #sxkvcchtyg .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #sxkvcchtyg .gt_first_summary_row.thick { border-top-width: 2px; } #sxkvcchtyg .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #sxkvcchtyg .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #sxkvcchtyg .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_left { text-align: left; } #sxkvcchtyg .gt_center { text-align: center; } #sxkvcchtyg .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #sxkvcchtyg .gt_font_normal { font-weight: normal; } #sxkvcchtyg .gt_font_bold { font-weight: bold; } #sxkvcchtyg .gt_font_italic { font-style: italic; } #sxkvcchtyg .gt_super { font-size: 65%; } #sxkvcchtyg .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #sxkvcchtyg .gt_asterisk { font-size: 100%; vertical-align: 0; } #sxkvcchtyg .gt_indent_1 { text-indent: 5px; } #sxkvcchtyg .gt_indent_2 { text-indent: 10px; } #sxkvcchtyg .gt_indent_3 { text-indent: 15px; } #sxkvcchtyg .gt_indent_4 { text-indent: 20px; } #sxkvcchtyg .gt_indent_5 { text-indent: 25px; } #sxkvcchtyg .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #sxkvcchtyg div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } precio bolsas mixto suelto marca 41 21 14 barato 3 1 3 marca_propia 9 4 3 desconocido 6 1 0 fino 8 20 56 variable 32 52 25 Estos datos podemos examinarlos un rato y llegar a conclusiones, pero esta tabla no necesariamente es la mejor manera de mostrar patrones en los datos. Tampoco son muy útiles gráficas como la siguiente: ggplot(tabla_cruzada |> ungroup() |> mutate(price = fct_reorder(precio, prop)), aes(x = precio, y = prop, group = presentacion, colour = presentacion)) + geom_point() + coord_flip() + geom_line() En lugar de eso, calcularemos perfiles columna. Esto es, comparamos cada una de las columnas con la columna marginal (en la tabla de tipo de estilo de té): num_grupos <- n_distinct(te |> select(presentacion)) tabla <- te |> count(presentacion, precio) |> group_by(presentacion) |> mutate(prop_precio = (100 * n / sum(n))) |> group_by(precio) |> mutate(prom_prop = sum(prop_precio)/num_grupos) |> mutate(perfil = 100 * (prop_precio / prom_prop - 1)) tabla ## # A tibble: 17 × 6 ## # Groups: precio [6] ## presentacion precio n prop_precio prom_prop perfil ## <fct> <fct> <int> <dbl> <dbl> <dbl> ## 1 bolsas marca 70 41.2 25.4 61.8 ## 2 bolsas barato 5 2.94 2.26 30.1 ## 3 bolsas marca_propia 16 9.41 5.48 71.7 ## 4 bolsas desconocido 11 6.47 2.51 158. ## 5 bolsas fino 14 8.24 28.0 -70.6 ## 6 bolsas variable 54 31.8 36.3 -12.5 ## 7 mixto marca 20 21.3 25.4 -16.4 ## 8 mixto barato 1 1.06 2.26 -52.9 ## 9 mixto marca_propia 4 4.26 5.48 -22.4 ## 10 mixto desconocido 1 1.06 2.51 -57.6 ## 11 mixto fino 19 20.2 28.0 -27.8 ## 12 mixto variable 49 52.1 36.3 43.6 ## 13 suelto marca 5 13.9 25.4 -45.4 ## 14 suelto barato 1 2.78 2.26 22.9 ## 15 suelto marca_propia 1 2.78 5.48 -49.3 ## 16 suelto fino 20 55.6 28.0 98.4 ## 17 suelto variable 9 25 36.3 -31.1 tabla_perfil <- tabla |> select(presentacion, precio, perfil, pct = prom_prop) |> pivot_wider(names_from = presentacion, values_from = perfil, values_fill = list(perfil = -100.0)) if_profile <- function(x){ any(x < 0) & any(x > 0) } marcar <- marcar_tabla_fun(25, "red", "black") tab_out <- tabla_perfil |> arrange(desc(bolsas)) |> select(-pct, everything()) |> mutate(across(where(is.numeric), \\(x) round(x, 0))) |> mutate(across(where(if_profile), \\(x) marcar(x))) |> knitr::kable(format_table_salida(), escape = FALSE, digits = 0, booktabs = T) |> kableExtra::kable_styling(latex_options = c("striped", "scale_down"), bootstrap_options = c( "hover", "condensed"), full_width = FALSE) tab_out precio bolsas mixto suelto pct desconocido 158 -58 -100 3 marca_propia 72 -22 -49 5 marca 62 -16 -45 25 barato 30 -53 23 2 variable -12 44 -31 36 fino -71 -28 98 28 Leemos esta tabla como sigue: por ejemplo, los compradores de té suelto compran té fino a una tasa casi el doble (98%) que el promedio. También podemos graficar como: tabla_graf <- tabla_perfil |> ungroup() |> mutate(precio = fct_reorder(precio, bolsas)) |> select(-pct) |> pivot_longer(cols = -precio, names_to = "presentacion", values_to = "perfil") g_perfil <- ggplot(tabla_graf, aes(x = precio, xend = precio, y = perfil, yend = 0, group = presentacion)) + geom_point() + geom_segment() + facet_wrap(~presentacion) + geom_hline(yintercept = 0 , colour = "gray")+ coord_flip() g_perfil Observación: hay dos maneras de construir la columna promedio: tomando los porcentajes sobre todos los datos, o promediando los porcentajes de las columnas. Si los grupos de las columnas están desbalanceados, estos promedios son diferentes. Cuando usamos porcentajes sobre la población, perfiles columna y renglón dan el mismo resultado Sin embargo, cuando hay un grupo considerablemente más grande que otros, las comparaciones se vuelven vs este grupo particular. No siempre queremos hacer esto. Interpretación En el último ejemplo de tomadores de té utilizamos una muestra de personas, no toda la población de tomadores de té. Eso quiere decir que tenemos cierta incertidumbre de cómo se generalizan o no los resultados que obtuvimos en nuestro análisis a la población general. Nuestra respuesta depende de cómo se extrajo la muestra que estamos considerando. Si el mecanismo de extracción incluye algún proceso probabilístico, entonces es posible en principio entender qué tan bien generalizan los resultados de nuestro análisis a la población general, y entender esto depende de entender qué tanta variación hay de muestra a muestra, de todas las posibles muestras que pudimos haber extraido. En las siguientes secciones discutiremos estos aspectos, en los cuales pasamos del trabajo de “detective” al trabajo de “juez” en nuestro trabajo analítico. Suavizamiento loess Las gráficas de dispersión son la herramienta básica para describir la relación entre dos variables cuantitativas, y como vimos en ejemplo anteriores, muchas veces podemos apreciar mejor la relación entre ellas si agregamos una curva loess. Veamos un ejemplo, los siguientes datos muestran los premios ofrecidos y las ventas totales de una lotería a lo largo de 53 sorteos (las unidades son cantidades de dinero indexadas). Graficamos en escalas logarítmicas y agregamos una curva loess. # cargamos los datos load(here::here("data", "ventas_sorteo.Rdata")) ggplot(ventas.sorteo, aes(x = premio, y = ventas.tot.1)) + geom_point() + geom_smooth(method = "loess", span = 0.6, method.args = list(degree = 1), se = FALSE) + scale_x_log10(breaks = c(20000, 40000, 80000)) + scale_y_log10(breaks = c(10000, 15000, 22000, 33000)) El patrón no era difícil de ver en los datos originales, sin embargo, la curva lo hace más claro, el logaritmo de las ventas tiene una relación no lineal con el logaritmo del premio: para premios no muy grandes no parece haber gran diferencia, pero cuando los premios empiezan a crecer por encima de 20,000, las ventas crecen más rápidamente que para premios menores. Este efecto se conoce como bola de nieve, y es frecuente en este tipo de loterías. Antes de adentrarnos a los modelos loess comenzamos explicando cómo se ajustan familias paramétricas de curvas a conjuntos de datos dados. El modelo de regresion lineal ajusta una recta a un conjunto de datos. Por ejemplo, consideremos la familia \\[f_{a,b}(x) = a x + b,\\] para un conjunto de datos bivariados \\(\\{ (x_1, y_1), \\ldots, (x_N, y_N)\\}\\). Buscamos encontrar \\(a\\) y \\(b\\) tales que \\(f_{a,b}\\) de un ajuste óptimo a los datos. Para esto, se minimiza la suma de errores cuadráticos \\[\\frac1N \\sum_{n = 1}^N ( y_n - a x_n - b)^2.\\] En este caso, las constantes \\(a\\) y \\(b\\) se pueden encontrar diferenciando la función de mínimos cuadrados. Nótese que podemos repetir el argumento con otras familias de funciones (por ejemplo cuadráticas). ggplot(ventas.sorteo, aes(x = premio, y = ventas.tot.1)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + scale_x_log10(breaks = c(20000, 40000, 80000)) + scale_y_log10(breaks = c(10000, 15000, 22000, 33000)) Si observamos la gráfica notamos que este modelo lineal (en los logaritmos) no resumen adecuadamente estos datos. Podríamos experimentar con otras familias (por ejemplo, una cuadrática o cúbica, potencias, exponenciales, etc.); sin embargo, en la etapa exploratoria es mejor tomar una ruta de ajuste más flexible y robusta. Regresión local nos provee de un método con estas características: Curvas loess (regresión local): Una manera de mejorar la flexibilidad de los modelos lineales es considerar rectas de manera local. Es decir, en cada \\(x\\) posible consideramos cuál es la recta que mejor ajusta a los datos, considerando solamente valores de \\(x_n\\) que están cercanos a \\(x\\). La siguiente gráfica muestra qué recta se ajusta alrededor de cada punto, y cómo queda el suavizador completo, con distintos valores de suavizamiento. El tono de los puntos indican en cada paso que ventana de datos es considerada: Escogiendo de los parámetros. El parámetro de suavizamiento se encuentra por ensayo y error. La idea general es que debemos encontrar una curva que explique patrones importantes en los datos (que ajuste los datos) pero que no muestre variaciones a escalas más chicas difíciles de explicar (que pueden ser el resultado de influencias de otras variables, variación muestral, ruido o errores de redondeo, por ejemplo). En el proceso de prueba y error iteramos el ajuste y en cada paso hacemos análisis de residuales, con el fin de seleccionar un suavizamiento adecuado. En lugar de usar ajustes locales lineales, podemos usar ajustes locales cuadráticos que nos permiten capturar formas locales cuadráticas sin tener que suavizar demasiado poco: Opcional: cálculo del suavizador La idea es producir ajustes locales de rectas o funciones lineales o cuadráticas. Consideremos especificar dos parámetros: Parámetro de suavizamiento \\(\\alpha\\): toma valores en \\((0,1)\\), cuando \\(\\alpha\\) es más grande, la curva ajustada es más suave. Grado de los polinomios locales que ajustamos \\(\\lambda\\): generalmente se toma \\(\\lambda=1,2\\). Entonces, supongamos que los datos están dados por \\((x_1,y_1), \\ldots, (x_N, y_N)\\), y sean \\(\\alpha\\) un parámetro de suavizamiento fijo, y \\(\\lambda=1\\). Denotamos como \\(\\hat{g}(x)\\) la curva loess ajustada, y como \\(w_n(x)\\) a una función de peso (que depende de x) para la observación \\((x_n, y_n)\\). Para poder calcular \\(w_n(x)\\) debemos comenzar calculando \\(q=\\lfloor{N\\alpha}\\rfloor\\) que suponemos mayor que uno, esta \\(q\\) es el número de puntos que se utilizan en cada ajuste local. Ahora definimos la función tricubo: \\[\\begin{align} T(u)=\\begin{cases} (1-|u|^3)^3, & \\text{para $|u| < 1$}.\\\\ 0, & \\text{en otro caso}. \\end{cases} \\end{align}\\] entonces, para el punto \\(x\\) definimos el peso correspondiente al dato \\((x_n,y_n)\\), denotado por \\(w_n(x)\\) como: \\[w_n(x)=T\\bigg(\\frac{|x-x_n|}{d_q(x)}\\bigg)\\] donde \\(d_q(x)\\) es el valor de la \\(q\\)-ésima distancia más chica (la más grande entre las \\(q\\) más chicas) entre los valores \\(|x-x_j|\\), \\(j=1,\\ldots,N\\). De esta forma, las observaciones \\(x_n\\) reciben más peso cuanto más cerca estén de \\(x\\). En palabras, de \\(x_1,...,x_N\\) tomamos los \\(q\\) datos más cercanos a \\(x\\), que denotamos \\(x_{i_1}(x) \\leq x_{i_2}(x) \\leq \\cdots \\leq x_{i_q}(x)\\). Los re-escalamos a \\([0,1]\\) haciendo corresponder \\(x\\) a \\(0\\) y el punto más alejado de \\(x\\) (que es \\(x_{i_q}\\)) a 1. Aplicamos el tricubo (gráfica de abajo), para encontrar los pesos de cada punto. Los puntos que están a una distancia mayor a \\(d_q(x)\\) reciben un peso de cero, y los más cercanos un peso que depende de que tan cercanos están a \\(x\\). Nótese que \\(x\\) es el punto ancla en dónde estamos ajustando la regresión local. tricubo <- function(x) { ifelse(abs(x) < 1, (1 - abs(x) ^ 3) ^ 3, 0) } curve(tricubo, from = -1.5, to = 1.5) Finalmente, para cada valor de \\(x_k\\) que está en el conjunto de datos \\(\\{x_1,...,x_n\\}\\), ajustamos una recta de mínimos cuadrados ponderados por los pesos \\(w_n(x)\\), es decir, minimizamos (en el caso lineal): \\[\\sum_{i=1}^nw_n(x_k)(y_i-ax_n-b)^2.\\] Observaciones: Cualquier función (continua y quizás diferenciable) con la forma de flan del tricubo que se desvanece fuera de \\((-1,1),\\) es creciente en \\((-1,0)\\) y decreciente en \\((0, 1)\\) es un buen candidato para usarse en lugar del tricubo. La razón por la que escogemos precisamente esta forma algebráica no tiene que ver con el análisis exploratorio, sino con las ventajas teóricas adicionales que tiene en la inferencia. El caso \\(\\lambda=2\\) es similar. La única diferencia es en el paso de ajuste, donde usamos funciones cuadráticas, y obtendríamos entonces tres familias de parámetros \\(a(x_k), b_1(x_k), b_2(x_k),\\) para cada \\(k \\in \\{1, \\ldots, N\\}\\). Caso de estudio: nacimientos en México Podemos usar el suavizamiento loess para entender y describir el comportamiento de series de tiempo, en las cuáles intentamos entender la dependencia de una serie de mediciones indexadas por el tiempo. Típicamente es necesario utilizar distintas componentes para describir exitosamente una serie de tiempo, y para esto usamos distintos tipos de suavizamientos. Veremos que distintas componentes varían en distintas escalas de tiempo (unas muy lentas, como la tendencia, otras más rapidamente, como variación quincenal, etc.). Este caso de estudio esta basado en un análisis propuesto por A. Vehtari y A. Gelman, junto con un análisis de serie de tiempo de William S. Cleveland (1993). En nuestro caso, usaremos los datos de nacimientos registrados por día en México desde 1999. Los usaremos para contestar las preguntas: ¿cuáles son los cumpleaños más frecuentes? y ¿en qué mes del año hay más nacimientos? Podríamos utilizar una gráfica popular (ver por ejemplo esta visualización) como: Sin embargo, ¿cómo criticarías este análisis desde el punto de vista de los tres primeros principios del diseño analítico? ¿Las comparaciones son útiles? ¿Hay aspectos multivariados? ¿Qué tan bien explica o sugiere estructura, mecanismos o causalidad? Datos de natalidad para México library(lubridate) library(ggthemes) theme_set(theme_minimal(base_size = 14)) natalidad <- read_rds("./data/nacimientos/natalidad.rds") |> mutate(dia_semana = weekdays(fecha)) |> mutate(dia_año = yday(fecha)) |> mutate(año = year(fecha)) |> mutate(mes = month(fecha)) |> ungroup() |> mutate(dia_semana = recode(dia_semana, Monday = "Lunes", Tuesday = "Martes", Wednesday = "Miércoles", Thursday = "Jueves", Friday = "Viernes", Saturday = "Sábado", Sunday = "Domingo")) |> #necesario pues el LOCALE puede cambiar mutate(dia_semana = recode(dia_semana, lunes = "Lunes", martes = "Martes", miércoles = "Miércoles", jueves = "Jueves", viernes = "Viernes", sábado = "Sábado", domingo = "Domingo")) |> mutate(dia_semana = fct_relevel(dia_semana, c("Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Domingo"))) Consideremos los datos agregados del número de nacimientos (registrados) por día desde 1999 hasta 2016. Un primer intento podría ser hacer una gráfica de la serie de tiempo. Sin embargo, vemos que no es muy útil: Hay varias características que notamos. Primero, parece haber una tendencia ligeramente decreciente del número de nacimientos a lo largo de los años. Segundo, la gráfica sugiere un patrón anual. Y por último, encontramos que hay dispersión producida por los días de la semana. Sólo estas características hacen que la comparación entre días sea difícil de realizar. Supongamos que comparamos el número de nacimientos de dos miércoles dados. Esa comparación será diferente dependiendo: del año donde ocurrieron, el mes donde ocurrieron, si semana santa ocurrió en algunos de los miércoles, y así sucesivamente. Como en nuestros ejemplos anteriores, la idea del siguiente análisis es aislar las componentes que observamos en la serie de tiempo: extraemos componentes ajustadas, y luego examinamos los residuales. En este caso particular, asumiremos una descomposición aditiva de la serie de tiempo (William S. Cleveland 1993). En el estudio de series de tiempo una estructura común es considerar el efecto de diversos factores como tendencia, estacionalidad, ciclicidad e irregularidades de manera aditiva. Esto es, consideramos la descomposición \\[\\begin{align} y(t) = f_{t}(t) + f_{e}(t) + f_{c}(t) + \\varepsilon. \\end{align}\\] Una estrategia de ajuste, como veremos más adelante, es proceder de manera modular. Es decir, se ajustan los componentes de manera secuencial considerando los residuales de los anteriores. Tendencia Comenzamos por extraer la tendencia, haciendo promedios loess (William S. Cleveland 1979) con vecindades relativamente grandes. Quizá preferiríamos suavizar menos para capturar más variación lenta, pero si hacemos esto en este punto empezamos a absorber parte de la componente anual: mod_1 <- loess(n ~ as.numeric(fecha), data = natalidad, span = 0.2, degree = 1) datos_dia <- natalidad |> mutate(ajuste_1 = fitted(mod_1)) |> mutate(res_1 = n - ajuste_1) Notemos que a principios de 2000 el suavizador está en niveles de alrededor de 7000 nacimientos diarios, hacia 2015 ese número es más cercano a unos 6000. Componente anual Al obtener la tendencia podemos aislar el efecto a largo plazo y proceder a realizar mejores comparaciones (por ejemplo, comparar un día de 2000 y de 2015 tendria más sentido). Ahora, ajustamos los residuales del suavizado anterior, pero con menos suavizamiento. Así evitamos capturar tendencia: mod_anual <- loess(res_1 ~ as.numeric(fecha), data = datos_dia, degree = 2, span = 0.005) datos_dia <- datos_dia |> mutate(ajuste_2 = fitted(mod_anual)) |> mutate(res_2 = res_1 - ajuste_2) Día de la semana Hasta ahora, hemos aislado los efectos por plazos largos de tiempo (tendencia) y hemos incorporado las variaciones estacionales (componente anual) de nuestra serie de tiempo. Ahora, veremos cómo capturar el efecto por día de la semana. En este caso, podemos hacer suavizamiento loess para cada serie de manera independiente datos_dia <- datos_dia |> group_by(dia_semana) |> nest() |> mutate(ajuste_mod = map(data, ~ loess(res_2 ~ as.numeric(fecha), data = .x, span = 0.1, degree = 1))) |> mutate(ajuste_3 = map(ajuste_mod, fitted)) |> select(-ajuste_mod) |> unnest(cols = c(data, ajuste_3)) |> mutate(res_3 = res_2 - ajuste_3) |> ungroup() Residuales Por último, examinamos los residuales finales quitando los efectos ajustados: ## `geom_smooth()` using formula = 'y ~ x' Observación: nótese que la distribución de estos residuales presenta irregularidades interesantes. La distribución es de colas largas, y no se debe a unos cuantos datos atípicos. Esto generalmente es indicación que hay factores importantes que hay que examinar mas a detalle en los residuales: Reestimación Cuando hacemos este proceso secuencial de llevar el ajuste a los residual, a veces conviene iterarlo. La razón es que en una segunda o tercera pasada podemos hacer mejores estimaciones de cada componente, y es posible suavizar menos sin capturar componentes de más alta frecuencia. Así que podemos regresar a la serie original para hacer mejores estimaciones, más suavizadas: # Quitamos componente anual y efecto de día de la semana datos_dia <- datos_dia |> mutate(n_1 = n - ajuste_2 - ajuste_3) # Reajustamos mod_1 <- loess(n_1 ~ as.numeric(fecha), data = datos_dia, span = 0.02, degree = 2, family = "symmetric") Y ahora repetimos con la componente de día de la semana: Análisis de componentes Ahora comparamos las componentes estimadas y los residuales en una misma gráfica. Por definición, la suma de todas estas componentes da los datos originales. Este último paso nos permite diversas comparaciones que explican la variación que vimos en los datos. Una gran parte de los residuales está entre \\(\\pm 250\\) nacimientos por día. Sin embargo, vemos que las colas tienen una dispersión mucho mayor: quantile(datos_dia$res_6, c(00, .01,0.05, 0.10, 0.90, 0.95, 0.99, 1)) |> round() ## 0% 1% 5% 10% 90% 95% 99% 100% ## -2238 -1134 -315 -202 188 268 516 2521 ¿A qué se deben estas colas tan largas? Viernes 13? Podemos empezar con una curosidad. Los días Viernes o Martes 13, ¿nacen menos niños? Nótese que fue útil agregar el indicador de Semana santa por el Viernes 13 de Semana Santa que se ve como un atípico en el panel de los viernes 13. Residuales: antes y después de 2006 Veamos primero una agregación sobre los años de los residuales. Lo primero es observar un cambio que sucedió repentinamente en 2006: La razón es un cambio en la ley acerca de cuándo pueden entrar los niños a la primaria. Antes era por edad y había poco margen. Ese exceso de nacimientos son reportes falsos para que los niños no tuvieran que esperar un año completo por haber nacido unos cuantos días después de la fecha límite. Otras características que debemos investigar: Efectos de Año Nuevo, Navidad, Septiembre 16 y otros días feriados como Febrero 14. Semana santa: como la fecha cambia, vemos que los residuales negativos tienden a ocurrir dispersos alrededor del día 100 del año. Otros días especiales: más de residuales Ahora promediamos residuales (es posible agregar barras para indicar dispersión a lo largo de los años) para cada día del año. Podemos identificar ahora los residuales más grandes: se deben, por ejemplo, a días feriados, con consecuencias adicionales que tienen en días ajuntos (excesos de nacimientos): Semana santa Para Semana Santa tenemos que hacer unos cálculos. Si alineamos los datos por días antes de Domingo de Pascua, obtenemos un patrón de caída fuerte de nacimientos el Viernes de Semana Santa, y la característica forma de “valle con hombros” en días anteriores y posteriores estos Viernes. ¿Por qué ocurre este patrón? Nótese un defecto de nuestro modelo: el patrón de “hombros” alrededor del Viernes Santo no es suficientemente fuerte para equilibrar los nacimientos faltantes. ¿Cómo podríamos mejorar nuestra descomposición? Referencias "],["tipos-de-estudio-y-experimentos.html", "Sección 2 Tipos de estudio y experimentos Muestreo aleatorio Pero si no podemos hacer muestreo aleatorio? El estimador estándar Experimentos tradicionales Bloqueo Variables desconocidas Aleatorizando el tratamiento Selección de unidades y tratamiento Asignación natural del tratamiento", " Sección 2 Tipos de estudio y experimentos Motivación Pregunta de entrevista de Google (Chihara and Hesterberg 2018) Imagina que eres consultor y te preguntan lo siguiente (ver siguiente figura): Estoy haciendo una comparación de antes y después donde la hipótesis alternativa es pre.media.error > post.media.error. La distribución de ambas muestras es sesgada a la derecha. ¿Qué prueba me recomiendas para ésta situación? Figure 2.1: Error CPR, gráfica de densidad. Far better an approximate answer to the right question, which is often vague, than an exact answer to the wrong question, which can always be made precise. — John Tukey La siguiente imagen Roger Peng representa una situación común a la que se enfrenta el analista de datos, y se desarrolló en el contexto de preguntas vagas. En el esquema hay tres caminos: uno es uno ideal que pocas veces sucede, otro produce respuestas poco útiles pero es fácil, y otro es tortuoso pero que caracteriza el mejor trabajo de análisis de datos: Figure 2.2: Adaptado de R. Peng: Tukey, design thinking and better questions. Ejemplos: Alguien nos pregunta cuáles son las tiendas que mas venden de una cadena. Podríamos consultar bases de datos, hacer extracciones, definir periodos, etc. y reportar el promedio de ventas en el último mes, esta respuesta probablemente es poco útil. Nos damos cuenta, por ejemplo, porque la peor tienda es una que abrió hace relativamente poco, y la mejor es una de las tiendas más grandes que está en una zona de tráfico de alto costo. Una pregunta más interesante es, ¿qué equipos de ventas tienen mejor desempeño? ¿Cuánto aporta tener una cafetería dentro de la tienda en términos de ventas?, etc. Proceso Generador de Datos Entre las preguntas que se debe hacer el analista de datos una fundamental es entender el proceso generador de datos, pues esto determinará que otras preguntas son relevantes, y que análisis son adecuados, tanto en términos prácticos como estadísticos. La inferencia estadística busca hacer afirmaciones, cuantificadas de manera probabilista, acerca de datos que no tenemos, usando regularidades y conocimiento de datos que sí tenemos disponibles y métodos cuantitativos. Para hacer afirmaciones inferenciales eficientes y bien calibradas (con garantías estadísticas de calibración) a preguntas donde queremos generalizar de muestra a población, se requiere conocer con precisión el proceso que genera los datos muestrales. Esto incluye saber con detalle cómo se seleccionaron los datos a partir de los que se quiere hacer inferencia. En este caso, eficiente quiere decir que aprovechamos toda la información que está en los datos observados de manera que nuestros rangos de incertidumbre son lo más chico posibles (además de estar correctamente calibrados). Por su parte, probabilísticamente bien calibrados se refiere a que, lo que decimos que puede ocurrir con 10% de probabilidad ocurre efectivamente 1 de cada 10 veces, si decimos 20% entonces ocurre 2 de 20, etc. Veremos que para muestras dadas naturalmente, a veces es muy difiícil entender a fondo el proceso que generó la muestra y por tanto no tenemos las garantías de eficiencia y calibración. Ejemplo: Prevalencia de anemia Supongamos que nos interesa conocer el porcentaje de menores en edad escolar, (entre 6 y 15 años), con anemia en México. La fuente de datos disponible corresponde a registros del IMSS de hospitalizaciones de menores, ya sea por anemia o por otra causa (infecciones gastrointestinales, apendicitis, tratamiento de leucemia, …), se registró si el menor tenía anemia. En nuestra muestra el 47% de los niños tiene anemia. head(paciente) #> # A tibble: 6 × 4 #> edad padecimiento sexo anemia #> <int> <chr> <chr> <int> #> 1 8 picadura alacrán mujer 0 #> 2 10 infección intestinal hombre 1 #> 3 7 mordedura de perro hombre 1 #> 4 8 asma hombre 1 #> 5 13 infección intestinal mujer 0 #> 6 7 picadura alacrán hombre 0 ¿Qué nos dice esta cantidad acerca de la anemia en la población? ¿Podemos hacer inferencia estadística? ¿Cómo calculamos intervalos de confianza? # Si calculo el error estándar de la p estimada como sigue, es correcto? p <- mean(paciente$anemia) sqrt(p * (1 - p) / 5000) #> [1] 0.007060751 Muestreo aleatorio En la situación ideal diseñaríamos una muestra aleatoria de menores de edad, por ejemplo, utilizando el registro en educación primaria de la SEP, y mediríamos la prevalencia de anemia en la muestra, usaríamos esta muestra para estimar la prevalencia en la población y tendríamos además las herramientas para medir la incertidumbre de nuestra estimación (reportar intervalos, o errores estándar). El elemento clave, es la aleatorización en la selección de la muestra, la idea es distribuir los efecros desconcidos o no controlables que pueden introducir sesgos o variabilidad no conocida en los resultados. Pero si no podemos hacer muestreo aleatorio? En el caso de prevalencia de anemia, discutiendo con médicos e investigadores nos informan que la anemia se presenta en tasas más altas en niños más chicos. paciente |> count(edad) |> mutate(prop = round(100 * n / sum(n))) #> # A tibble: 10 × 3 #> edad n prop #> <int> <int> <dbl> #> 1 6 1001 20 #> 2 7 931 19 #> 3 8 980 20 #> 4 9 445 9 #> 5 10 484 10 #> 6 11 489 10 #> 7 12 246 5 #> 8 13 239 5 #> 9 14 90 2 #> 10 15 95 2 Y consultando con las proyecciones de población notamos que los niños chicos están sobrerepresentados en la muestra. Lo que nos hace considerar que debemos buscar una manera de ponderar nuestras observaciones para que reflejen a la población. Más aún, investigamos que algunas enfermedades están asociadas a mayor prevalencia de anemia: paciente |> count(padecimiento) |> arrange(-n) #> # A tibble: 7 × 2 #> padecimiento n #> <chr> <int> #> 1 infección respiratoria 745 #> 2 mordedura de perro 723 #> 3 úlcera 723 #> 4 asma 713 #> 5 apendcitis 704 #> 6 picadura alacrán 701 #> 7 infección intestinal 691 Utilizamos esta información para modelar y corregir nuestra estimación original. Por ejemplo con modelos de regresión. Sin embargo, debemos preguntarnos: ¿Hay más variables qué nos falta considerar? Ejemplo: Policías y tráfico Supongamos que nos preguntan en cuánto reduce un policía el tráfico en un crucero grande de la ciudad. La cultura popular ha establecido que los policías en cruceros hacen más tráfico porque no saben mover los semáforos. Nosotros decidimos buscar unos datos para entender esto. Escogemos entonces un grupo de cruceros problemáticos, registramos el tráfico cuando visitamos, y si había un policía o no. Después de este esfuerzo, obtenemos los siguientes datos: #> # A tibble: 10 × 2 #> # Groups: policia [2] #> policia tiempo_espera_min #> <int> <dbl> #> 1 0 2.27 #> 2 0 2.65 #> 3 0 3.4 #> 4 0 0.39 #> 5 0 1.1 #> 6 1 10.8 #> 7 1 4.67 #> 8 1 7.77 #> 9 1 6.3 #> 10 1 6.99 Lo que sabemos ahora es que la presencia de un policía es indicador de tráfico alto. El análisis prosiguiría calculando medias y medidas de error (escogimos una muestra aleatoria): Si somos ingenuos, entonces podríamos concluir que los policías efectivamente empeoran la situación cuando manipulan los semáforos, y confirmaríamos la sabiduría popular. Para juzgar este argumento desde el punto de vista causal, nos preguntamos primero: ¿Cuáles son los contrafactuales (los contrafactuales explican que pasaría si hubiéramos hecho otra cosa que la que efectivamente hicimos) de las observaciones? Efectos causales y el esquema de resultados potenciales Consideramos un tratamiento binario: Se manda policía o no se manda policía. Un resultado potencial es aquél que se observaría bajo un tratamiento particular. En cada semáforo, a una hora dada, hay dos resultados potenciales, uno por cada valor del tratamiento: \\(y_1:\\) tiempo de espera si se envía policía. \\(y_0:\\) tiempo de espera si no se envía policía. Para cada semáforo, en el momento de registro, uno observa únicamente uno de los dos resultados potenciales. El resultado no observado se conoce como resultado contrafactual. El estimador estándar A la comparación anterior - la diferencia de medias de tratados y no tratados - le llamamos usualmente el estimador estándar del efecto causal. Muchas veces este es un estimador malo del efecto causal. En nuestro ejemplo, para llegar a la conclusión errónea que confirma la sabiduría popular, hicimos un supuesto importante: En nuestra muestra, los casos con policía actúan como contrafactuales de los casos sin policía. Asi que asumimos que los casos con policía y sin policía son similares, excepto por la existencia o no de policía. En nuestro ejemplo, quizá un analista más astuto nota que tienen categorías históricas de qué tan complicado es cada crucero. Junta a sus datos, y obtiene: #> # A tibble: 10 × 3 #> # Groups: policia [2] #> policia tiempo_espera_min categoria #> <int> <dbl> <fct> #> 1 0 2.27 Fluido #> 2 0 2.65 Fluido #> 3 0 3.4 Típico #> 4 0 0.39 Fluido #> 5 0 1.1 Fluido #> 6 1 10.8 Complicado #> 7 1 4.67 Típico #> 8 1 7.77 Complicado #> 9 1 6.3 Complicado #> 10 1 6.99 Típico El analista argumenta entonces que los policías se enviaron principalmente a cruceros que se consideran Complicados según datos históricos. Esto resta credibilidad a la comparación que hicimos inicialmente: La comparación del estimador estándar no es de peras con peras: estamos comparando qué efecto tienen los policías en cruceros difíciles, con cruceros no difíciles donde no hay policía. La razón de esto es que el proceso generador de los datos incluye el hecho de que no se envían policías a lugares donde no hay tráfico. ¿Cómo producir contrafactuales para hacer la comparación correcta? Experimentos tradicionales Idealmente, quisiéramos observar un mismo crucero en las dos condiciones: con y sin policías. Esto no es posible. En un experimento “tradicional”, como nos lo explicaron en la escuela, nos aproximamos a esto preparando dos condiciones idénticas, y luego alteramos cada una de ellas con nuestra intervención. Si el experimento está bien hecho, esto nos da observaciones en pares, y cada quien tiene su contrafactual. La idea del experimiento tradicional es controlar todos los factores que intervienen en los resultados, y sólo mover el tratamiento para producir los contrafactuales. Más en general, esta estrategia consiste en hacer bloques de condiciones, donde las condiciones son prácticamente idénticas dentro de cada bloque. Comparamos entonces unidades tratadas y no tratadas dentro de cada bloque. Por ejemplo, si queremos saber si el tiempo de caída libre es diferente para un objeto más pesado que otro, prepararíamos dos pesos con el mismo tamaño pero de peso distinto. Soltaríamos los dos al mismo tiempo y compararíamos el tiempo de caída de cada uno. En nuestro caso, como es usual en problemas de negocio o sociales, hacer esto es considerablemente más difícil. No podemos “preparar” cruceros con condiciones idénticas. Sin embargo, podríamos intentar \\(bloquear\\) los cruceros según información que tenemos acerca de ellos, para hacer más comparaciones de peras con peras. Bloqueo Podemos acercanos en lo posible a este ideal de experimentación usando información existente. En lugar de hacer comparaciones directas entre unidades que recibieron el tratamiento y las que no (que pueden ser diferentes en otros aspectos, como vimos arriba), podemos refinar nuestras comparaciones bloquéandolas con variables conocidas. En el ejemplo de los policías, podemos hacer lo siguiente: dentro de cada categoría de cruceros (fluido, típico o complicado), tomaremos una muestra de cruceros, algunos con policía y otros sin. Haremos comparaciones dentro de cada categoría. Obtenemos una muestra con estas características (6 casos en cada categoría de crucero, 3 con policía y 3 sin policía): categoria policia n Fluido 0 3 Fluido 1 3 Típico 0 3 Típico 1 3 Complicado 0 3 Complicado 1 3 Y ahora hacemos comparaciones dentro de cada bloque creado por categoría: #> # A tibble: 3 × 3 #> # Groups: categoria [3] #> categoria `policia =0` `policia =1` #> <fct> <dbl> <dbl> #> 1 Fluido 2.1 0.8 #> 2 Típico 5.6 4.2 #> 3 Complicado 10.4 8.6 Y empezamos a ver otra imagen en estos datos: comparando tipos e cruceros similares, los que tienen policía tienen tiempos de espera ligeramente más cortos. ¿Hemos termniado? ¿Podemos concluir que el efecto de un policía es beneficiosos pero considerablemente chico? ¿Qué problemas puede haber con este análisis? Variables desconocidas El problema con el análisis anterior es que controlamos por una variable que conocemos, pero muchas otras variables pueden estar ligadas con el proceso de selección de cruceros para enviar policías. Por ejemplo, envían o policías a cruceros Típicos solo cuando reportan mucho tráfico. No envían a un polícia a un crucero Complicado si no presenta demasiado tráfico. Existen otras variables desconocidas que los tomadores de decisiones usan para enviar a los policías. En este caso, por ejemplo, los expertos hipotéticos nos señalan que hay algunos cruceros que aunque problemáticos, a veces su tráfico se resuelve rápidamente, mientras que otros tienen tráfico más persistente, y prefieren enviar policías a los de tráfico persistente. La lista de cruceros persistentes están en una hoja de excel que se comparte de manera informal. En resumen, no tenemos conocimiento detallado del proceso generador de datos en cuanto a cómo se asignan los policías a los cruceros. Igual que en la sección anterior, podemos cortar esta complejidad usando aleatorización. Nótese que los expertos no están haciendo nada malo: en su trabajo están haciendo el mejor uso de los recursos que tienen. El problema es que por esa misma razón no podemos saber el resultado de sus esfuerzos, y si hay maneras de optimizar la asignación que hacen actualmente. Aleatorizando el tratamiento Tomamos la decisión entonces de hacer un experimento que incluya aletorización. En un dia particular, escogeremos algunos cruceros. Dicidimos usar solamente cruceros de la categoría Complicada y Típica, pues esos son los más interesantes para hacer intervenciones. Usaremos un poco de código para entener el detalle: en estos datos, tenemos para cada caso los dos posibles resultados hipotéticos \\(y_0\\) y \\(y_1\\) (con policia y sin policia). En el experimento asignamos el tratamiento al azar: muestra_exp <- trafico_tbl |> filter(categoria != "Fluido") |> sample_n(200) |> # asignar tratamiento al azar, esta es nuestra intervención: mutate(tratamiento_policia = rbernoulli(length(y_0), 0.5)) |> # observar resultado mutate(tiempo_espera_exp = ifelse(tratamiento_policia == 1, y_1, y_0)) Nótese la diferencia si tomamos la asignación natural del tratamiento (policía o no): set.seed(134) muestra_natural <- trafico_tbl |> filter(categoria != "Fluido") |> sample_n(200) |> # usamos el tratamiento que se asignó # policia indica si hubo o no policía en ese crucero # observar resultado mutate(tiempo_espera_obs = ifelse(policia == 1, y_1, y_0)) Resumimos nuestros resultados del experimento son: #> # A tibble: 2 × 3 #> # Groups: categoria [2] #> categoria `policia=0` `policia=1` #> <fct> <dbl> <dbl> #> 1 Típico 6.24 4.97 #> 2 Complicado 15.8 8.47 Sin embargo, la muestra natural da: #> # A tibble: 2 × 3 #> # Groups: categoria [2] #> categoria `policia=0` `policia=1` #> <fct> <dbl> <dbl> #> 1 Típico 5.49 4.35 #> 2 Complicado 10.8 8.93 ¿Cuál de los dos análisis da la respuesta correcta a la pregunta: ayudan o no los policías a reducir el tráfico en los cruceros problemáticos? El experimento establece que un policía en promedio reduce a la mitad el tiempo de espera en un crucero complicado Selección de unidades y tratamiento Vimos dos tipos de inferencia que requieren distintos diseños de estudio: a poblaciones (ejemplo anemia) y causal (ejemplo policías). En el escenario ideal de cada uno de estos ejemplos requerimos un mecanismo de aleatorización, sin embargo, la aleatorización requerida en cada caso es distinta y distinguir esto es fundamental para entender las inferencias que podemos hacer en distintos escenarios. Inferencia estadística de acuerdo al tipo del diseño (Ramsey and Schafer (2012)). El cuadro arriba a la izquierda es donde el análisis es más simple y los resultados son más fáciles de interpretar. En este escenario don de la aleatorización es tanto en unidades como en grupos no hacen falta supuestos adicionales para tener las garantías de métodos de inferencia. Es posible hacer análisis fuera de este cuadro, pero el proceso es más complicado, requieren más supuestos, conocimiento del dominio y habilidades de análisis. En general resultan conclusiones menos sólidas. Muchas veces no nos queda otra más que trabajar fuera del cuadro ideal. El punto crucial para entender las medidas de incertidumbre estadística es visualizar de manera hipotética, replicaciones del estudio y las condiciones que llevaron a la selección de la muestra. Esto es, entender el proceso generador de datos e imaginar replicarlo. Ubica los siguientes tipos de análisis: Pruebas clínicas para medicinas Analizar cómo afecta tener seguro médico a los ingresos, usando datos del ENIGH. Estimación de retorno sobre inversión en modelos de marketing mix. Asignación natural del tratamiento Cuando consideramos un sistema donde se “asignan” tratamientos de manera natural, generalmente los tratamientos se asignan bajo un criterio de optimización o conveniencia (por ejemplo los policías a cruceros problemáticos). La cara buena de este hecho es que de alguna forma los resultados están intentando optimizarse, y la gente está haciendo su trabajo. La cara mala de este hecho es que no podemos evaluar de manera simple la efectividad de los tratamientos. Y esto hace difícil optimizar de forma cuantificable los procesos, o entender qué funciona y qué no. Referencias "],["pruebas-de-hipótesis.html", "Sección 3 Pruebas de hipótesis Comparación con poblaciones de referencia Comparando distribuciones Prueba de permutaciones y el lineup Comparaciones usando lineup (continuación) Prueba de permutaciones para proporciones Pruebas de hipótesis tradicionales Tomadores de té (continuación) Pruebas de permutación: implementación. Ejemplo: tiempos de fusión Ejemplo: tiempos de fusión (continuación) Separación de grupos La “crisis de replicabilidad” El jardín de los senderos que se bifurcan Ejemplo: decisiones de análisis y valores p Alternativas o soluciones", " Sección 3 Pruebas de hipótesis Las primeras técnicas inferenciales que veremos intentan contestar la siguiente pregunta: Si observamos cierto patrón en los datos, ¿cómo podemos cuantificar la evidencia de que es un patrón notable y no sólo debido a fluctuaciones en los datos particulares que tenemos? ¿Cómo sabemos que no estamos sobreinterpretando esas fluctuaciones? Por ejemplo: Un sistema tiene cierto comportamiento “usual” para el cual tenemos datos históricos. El sistema presenta fluctuaciones en el tiempo. Observamos la última salida de nuestro sistema. Naturalmente, tiene fluctuaciones. ¿Esas fluctuaciones son consistentes con la operación usual del sistema? ¿Existe evidencia para pensar que algo en el sistema cambió? Comparación con poblaciones de referencia En las prueba de hipótesis, tratamos de construir distribuciones de referencia para comparar resultados que obtengamos con un “estándar” de variación, y juzgar si nuestros resultados son consistentes con la referencia o no (Box et al. 1978). En algunos casos, ese estándar de variación puede construirse con datos históricos. Ejemplo Supongamos que estamos considerando cambios rápidos en una serie de tiempo de alta frecuencia. Hemos observado la serie en su estado “normal” durante un tiempo considerable, y cuando observamos nuevos datos quisiéramos juzgar si hay indicaciones o evidencia en contra de que el sistema sigue funcionando de manera similar. Digamos que monitoreamos ventanas de tiempo de tamaño 20 y necesitamos tomar una decisión. Abajo mostramos cinco ejemplos donde el sistema opera normalmente, que muestra la variabilidad en el tiempo en ventanas cortas del sistema. Ahora suponemos que obtenemos una nueva ventana de datos. ¿Hay evidencia en contra de que el sistema sigue funcionando de manera similar? Nuestra primera inclinación debe ser comparar: en este caso, compararamos ventanas históricas con nuestra nueva serie: # usamos datos simulados para este ejemplo set.seed(8812) historicos <- simular_serie(2000) ¿Vemos algo diferente en los datos nuevos (el panel de color diferente)? Indpendientemente de la respuesta, vemos que hacer este análisis de manera tan simple no es siempre útil: seguramente podemos encontrar maneras en que la nueva muestra (4) es diferente a muestras históricas. Por ejemplo, ninguna de muestras tiene un “forma de montaña” tan clara. Nos preguntamos si no estamos sobreinterpretando variaciones que son parte normal del proceso. Podemos hacer un mejor análisis si extraemos varias muestras del comportamiento usual del sistema, graficamos junto a la nueva muestra, y revolvemos las gráficas para que no sepamos cuál es cuál. Entonces la pregunta es: ¿Podemos detectar donde están los datos nuevos? Esta se llama una prueba de lineup, o una prueba de ronda de sospechosos (Hadley Wickham et al. 2010). En la siguiente gráfica, en uno de los páneles están los datos recientemente observados. ¿Hay algo en los datos que distinga al patrón nuevo? # nuevos datos obs <- simular_serie(500, x_inicial = last(obs$obs)) # muestrear datos históricos prueba_tbl <- muestrear_ventanas(historicos, obs[1:20, ], n_ventana = 20) # gráfica de pequeños múltiplos ggplot(prueba_tbl$lineup, aes(x = t_0, y = obs)) + geom_line() + facet_wrap(~rep, nrow = 4) + scale_y_log10() ¿Cuáles son los datos nuevos (solo hay un panel con los nuevos datos)? ¿Qué implica que la gráfica que escojamos como “más diferente” no sean los datos nuevos? ¿Qué implica que le “atinemos” a la gráfica de los datos nuevos? Ahora observamos al sistema en otro momento y repetimos la comparación. En el siguiente caso obtenemos: Aunque es imposible estar seguros de que ha ocurrido un cambio, la diferencia de una de las series es muy considerable. Si identificamos los datos correctos, la probabilidad de que hayamos señalado la nueva serie “sobreinterpretando” fluctuaciones en un proceso que sigue comportándose normalente es 0.05 - relativamente baja. Detectar los datos diferentes es evidencia en contra de que el sistema sigue funcionando de la misma manera que antes. En el ejemplo anterior se encontraban en la posición: prueba_tbl$pos ## [1] 18 Observaciones y terminología: Llamamos hipótesis nula a la hipótesis de que los nuevos datos son producidos bajo las mismas condiciones que los datos de control o de referencia. Si no escogemos la gráfica de los nuevos datos, nuestra conclusión es que la prueba no aporta evidencia en contra de la hipótesis nula. Si escogemos la gráfica correcta, nuestra conclusión es que la prueba aporta evidencia en contra de la hipótesis nula. ¿Qué tan fuerte es la evidencia, en caso de que descubrimos los datos no nulos? Cuando el número de paneles es más grande y detectamos los datos, la evidencia es más alta en contra de la nula. Decimos que el nivel de significancia de la prueba es la probabilidad de seleccionar a los datos correctos cuando la hipótesis nula es cierta (el sistema no ha cambiado). En el caso de 20 paneles, la significancia es de 1/20 = 0.05. Cuando detectamos los datos nuevos, niveles de significancia más bajos implican más evidencia en contra de la nula. Si acertamos, y la diferencia es más notoria y fue muy fácil detectar la gráfica diferente (pues sus diferencias son más extremas), esto también sugiere más evidencia en contra de la hipótesis nula. Finalmente, esta prueba rara vez (o nunca) nos da seguridad completa acerca de ninguna conclusión, aún cuando hiciéramos muchos páneles. Comparando distribuciones Ahora intentamos un ejemplo más típico. Supongamos que tenemos muestras para tres grupos a, b y c, esto es que dentro de cada grupo, el proceso de selección de los elementos se hace al azar y de manera simétrica (por ejemplo cada elemento tiene a misma probabiidad de ser seleccionado, y las extracciones se hacen de manera independiente.) Queremos comparar las distribuciones de los datos obtenidos para cada grupo. Quizá la pregunta detrás de esta comparación es: el grupo de clientes b recibió una promoción especial. ¿Están gastando más? La medición que comparamos es el gasto de los clientes. En la muestra observamos diferencias entre los grupos. Pero notamos adicionalmente que hay mucha variación dentro de cada grupo. Nos podríamos preguntar entonces si las diferencias que observamos se deben variación muestral, por ejemplo. Podemos construir ahora una hipótesis nula, que establece que las observaciones provienen de una población similar: Las tres poblaciones (a, b, c) son prácticamente indistiguibles. En este caso, la variación que observamos se debería a que tenemos información incompleta. Como en el ejemplo anterior necesitamos construir u obtener una distribución de referencia para comparar qué tan extremos o diferentes son los datos que observamos. Esa distribución de referencia debería estar basada en el supuesto de que los grupos producen datos de distribuciones similares. Si tuvieramos mediciones similares históricas de estos tres grupos, quizá podríamos extraer datos de referencia y comparar, como hicimos en el ejempo anterior. Pero esto es menos común en este tipo de ejemplos. Prueba de permutaciones y el lineup Para abordar este problema podemos pensar en usar permutaciones de los grupos de la siguiente forma ((Box et al. 1978), (Tim C. Hesterberg 2015a)): Si los grupos producen datos bajo procesos idénticos, entonces los grupos a, b, c solo son etiquetas que no contienen información. Podríamos permutar al azar las etiquetas y observar nuevamente la gráfica de caja y brazos por grupos. Si la hipótesis nula es cierta (grupos idénticos), esta es una muestra tan verosímil como la que obtuvimos. Así que podemos construir datos de referencia permutando las etiquetas de los grupos al azar, y observando la variación que ocurre. Si la hipótesis nula es cercana a ser cierta, no deberíamos de poder distinguir fácilmente los datos observados de los producidos con las permutaciones al azar. Vamos a intentar esto, por ejemplo usando una gráfica de cuantiles simplificada. Hacemos un lineup, o una rueda de sospechosos (usamos el paquete (H. Wickham, Chowdhury, and Cook 2012), ver (Hadley Wickham et al. 2010)), donde 19 de los acusados son generados mediante permutaciones al azar de la variable del grupo, y el culpable (los verdaderos datos) están en una posición escogida al azar. ¿Podemos identificar los datos verdaderos? Para evitar sesgarnos, también ocultamos la etiqueta verdadera. Usamos una gráfica que muestra los cuantiles 0.10, 0.50, 0.90: set.seed(88) reps <- lineup(null_permute("grupo"), muestra_tab, n = 20) ## decrypt("M7xA 2S8S Jj dUyJ8JUj ZW") reps_mezcla <- reps |> mutate(grupo_1 = factor(digest::digest2int(grupo) %% 177)) grafica_cuantiles(reps_mezcla, grupo_1, x) + coord_flip() + facet_wrap(~.sample, ncol = 5) + ylab("x") + labs(caption = "Mediana y percentiles 10% y 90%") + geom_point(aes(colour = grupo_1)) Y la pregunta que hacemos es ¿podemos distinguir nuestra muestra entre todas las replicaciones producidas con permutaciones? ¿Dónde están los datos observados? Según tu elección, ¿qué tan diferentes son los datos observados de los datos nulos? En este ejemplo, es difícil indicar cuáles son los datos. Los grupos tienen distribuciones similares y es factible que las diferencias que observamos se deban a variación muestral. Si la persona escoge los verdaderos datos, encontramos evidencia en contra de la hipótesis nula (los tres grupos son equivalentes). En algunos contextos, se dice que los datos son significativamente diferentes al nivel 0.05. Esto es evidencia en contra de que los datos se producen de manera homogénea, independientemente del grupo. Si la persona escoge uno de los datos permutados, no encontramos evidencia en contra de que los tres grupos producen datos con distribuciones similares. Comparaciones usando lineup (continuación) Repetimos el ejemplo para otra muestra (en este ejemplo el proceso generador de datos es diferente para el grupo b): Hacemos primero la prueba del lineup: set.seed(121) reps <- lineup(null_permute("grupo"), muestra_tab, n = 20) grafica_cuantiles(reps |> mutate(grupo_escondido = factor(digest::digest2int(grupo) %% 177)), grupo_escondido, x) + facet_wrap(~.sample) + ylab("x") + coord_flip() + geom_point(aes(colour = grupo_escondido)) Podemos distinguir más o menos claramente que está localizada en valores más altos y tiene mayor dispersión. En este caso, como en general podemos identificar los datos, obtenemos evidencia en contra de que los tres grupos tienen distribuciones iguales. Estos ejemplos siguen la idea de inferencia visual propuestas en (Hadley Wickham et al. 2010), (Hofmann et al. 2012) son pruebas muy flexibles y estadísticamente rigurosas. Prueba de permutaciones para proporciones Veremos otro ejemplo donde podemos hacer más concreta la idea de distribución nula o de referencia usando pruebas de permutaciones. Supongamos que con nuestra muestra de tomadores de té, queremos probar la siguiente hipótesis nula: Los tomadores de té en bolsas exclusivamente, usan azúcar a tasas simillares que los tomadores de té suelto (que pueden o no también tomar té en bolsita). Los datos que obtuvimos en nuestra encuesta, en conteos, son: sugar bolsa_exclusivo suelto o bolsa No.sugar 81 74 sugar 89 56 Y en proporciones tenemos que: how prop_azucar n bolsa_exclusivo 0.52 170 suelto o bolsa 0.43 130 Pero distintas muestras podrían haber dado distintos resultados. Nos preguntamos qué tan fuerte es la evidencia en contra de que en realidad los dos grupos de personas usan azúcar en proporciones similares, y la diferencia que vemos se puede atribuir a variación muestral. En este ejemplo, podemos usar una estadística de prueba numérica, por ejemplo, la diferencia entre las dos proporciones: \\[\\hat p_1 - \\hat p_2,\\] (tomadores de té en bolsa solamente vs. suelto y bolsa). El proceso sería entonces: La hipótesis nula es que los dos grupos tienen distribuciones iguales. Este caso quiere decir que en la población, tomadores de té solo en bolsa usan azúcar a las mismas tasas que tomadores de suelto o bolsas. Bajo nuestra hipótesis nula (proporciones iguales), producimos una cantidad grande (por ejemplo 10 mil o más) de muestras permutando las etiquetas de los grupos. Evaluamos nuestra estadística de prueba en cada una de las muestras permutadas. El conjunto de valores obtenidos nos da nuestra distribución de referencia (ya no estamos limitados a 20 replicaciones como en las pruebas gráficas). Y la pregunta clave es: ¿el valor de la estadística en nuestra muestra es extrema en comparación a la distribución de referencia? dif_obs <- te_azucar |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(how) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = how, values_from = prop_azucar) |> mutate(diferencia_prop = bolsa_exclusivo - `suelto o bolsa`) |> pull(diferencia_prop) La diferencia observada es: dif_obs |> round(3) ## [1] 0.093 Ahora construimos nuestra distribución nula o de referencia: reps <- lineup(null_permute("how"), te_azucar, n = 50000) glimpse(reps) ## Rows: 15,000,000 ## Columns: 3 ## $ how <chr> "bolsa_exclusivo", "bolsa_exclusivo", "suelto o bolsa", "suelt… ## $ sugar <chr> "sugar", "No.sugar", "No.sugar", "sugar", "No.sugar", "No.suga… ## $ .sample <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,… valores_ref <- reps |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(.sample, how) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = how, values_from = prop_azucar) |> mutate(diferencia = bolsa_exclusivo - `suelto o bolsa`) Y graficamos nuestros resultados (con un histograma y una gráfica de cuantiles, por ejemplo). la estadística evaluada un cada una de nuestras muestras permutadas: g_1 <- ggplot(valores_ref, aes(sample = diferencia)) + geom_qq(distribution = stats::qunif) + xlab("f") + ylab("diferencia") + labs(subtitle = "Distribución nula o de referencia") g_2 <- ggplot(valores_ref, aes(x = diferencia)) + geom_histogram(binwidth = 0.04) + coord_flip() + xlab("") + labs(subtitle = " ") g_1 + g_2 Este es el rango de fluctuación usual para nuestra estadística bajo la hipótesis de que los dos grupos de tomadores de té consumen té a la misma tasa. El valor que obtuvimos en nuestros datos es: 0.09. Mismo que no es un valor extremo en la distribución de referencia que vimos arriba. Ésta muestra no aporta mucha evidencia en contra de que los grupos tienen distribuciones similares. Podemos graficar otra vez marcando el valor observado: # Función de distribución acumulada (inverso de función de cuantiles) dist_perm <- ecdf(valores_ref$diferencia) # Calculamos el percentil del valor observado percentil_obs <- dist_perm(dif_obs) g_1 <- ggplot(valores_ref, aes(sample = diferencia)) + geom_qq(distribution = stats::qunif) + xlab("f") + ylab("diferencia") + labs(subtitle = "Distribución nula o de referencia") + geom_hline(yintercept = dif_obs, colour = "red") + annotate("text", x = 0.35, y = dif_obs - 0.03, label = "diferencia observada", colour = "red") g_2 <- ggplot(valores_ref, aes(x = diferencia)) + geom_histogram(binwidth = 0.04) + coord_flip() + xlab("") + labs(subtitle = " ") + geom_vline(xintercept = dif_obs, colour = "red") + annotate("text", x = dif_obs, y = N_rep * .3, label = percentil_obs,vjust = -0.2, colour = "red") g_1 + g_2 Y vemos que es un valor algo (pero no muy) extremo en la distribución de referencia que vimos arriba: esta muestra no aporta una gran cantidad de evidencia en contra de que los grupos tienen distribuciones similares, que en este caso significa que los dos grupos usan azúcar a tasas similares. Es decir, sobre la hipótesis \\[H_0: p_1 = p_2,\\] o bien, \\[H_0: p_1 - p_2 = 0.\\] Pruebas de hipótesis tradicionales Comencemos recordando la definición de parámetro y estadística. Definición. Un parámetro es una característica (numérica) de una población o de una distribución de probabilidad. Usualmente denotado por \\(\\theta \\in \\mathbb{R},\\) o por \\(\\theta \\in \\mathbb{R}^p.\\) Una estadística es una característica (numérica) de los datos. Usualmente denotado por \\(\\hat \\theta.\\) Cualquier función de un parámetro es también un parámetro \\(\\varphi = h(\\theta),\\) y cualquier función de una estadística es también una estadística \\(\\hat \\varphi = h(\\hat \\theta).\\) Cuando la estadística se calcula de una muestra aleatoria (\\(T(X),\\) para \\(X_i \\sim \\pi_x\\) para \\(i = 1, \\ldots, n\\)), es por consiguiente aleatoria y es por tanto una variable aleatoria (\\(T \\sim \\pi_T\\)). Por ejemplo \\(\\mu\\) y \\(\\sigma\\) son parámetros de la distribución normal con función de densidad \\(\\pi(x) = (1/\\sqrt{2\\pi}\\sigma)e^{(x-\\mu)^2/(2\\sigma^2)}\\). La varianza \\(\\sigma^2\\), y el coeficiente de variación (cociente de señal a ruido) \\(\\mu/\\sigma\\) también son parámetros. Si \\(X_1, \\ldots ,X_n\\) son una muestra aleatoria, entonces la media \\(\\bar{X}=\\frac1n\\sum_i X_i\\) es una estadística. Ahora podemos pasar a las definiciones correspondientes a pruebas de hipótesis (o pruebas de significancia). Definición. Denotamos por \\(H_0\\) a la hipótesis nula la cual usualmente tratamos como la afirmación del status quo. La hipótesis alternativa la denotamos por \\(H_1\\) y representa el supuesto que está a prueba y para el cual buscamos evidencia en los datos. Definición. La hipótesis normalmente se plantea en términos de un parámetro (\\(\\theta\\in\\mathbb{R}\\)) o conjunto de parámetros (\\(\\theta\\in\\mathbb{R}^p\\)) de la distribución de interés (por ejemplo media, moda, varianza). Para una hipótesis nula del estilo \\(H_0: \\theta = \\theta_0,\\) la hipótesis a contrastar se puede denominar como: Hipótesis alternativa de una cola \\(H_1: \\theta \\gt \\theta_0\\) Hipótesis alternativa de dos colas \\(H_1: \\theta \\neq \\theta_0\\) En el ejemplo anterior planteamos hipótesis nula (proporciones iguales) e hipótesis alternativa que la proporción de tomadores de te suelto que usan azúcar en menor proporción, esto corresponde a una hipótesis alternativa a dos colas: \\(H_0: p_1 = p_2\\), y \\(H_1:p_1 > p_2\\). Definición. Una estadística de prueba es una función numérica de los datos cuyo valor determina el resultado de la prueba. La función usualmente es denotada por \\(T(\\bf X)\\) donde \\(\\bf X\\) representa los datos como variable aleatoria. Por ejemplo, \\(T = T(X_1, \\ldots, X_n)\\) si sólo tenemos una muestra, o por \\(T = T(X_1, \\ldots, X_n, Y_1, \\ldots, Y_m)\\) en el caso de tener dos muestras. Al evaluar la prueba para un conjunto de datos dado, \\(x\\), ésta se denomina estadística de prueba observada, \\(t = T(x).\\) La estadística de prueba correspondiente al ejemplo es \\(T = \\hat p_1 - \\hat p_2.\\) Definición. El valor p es la probabilidad de que bajo la hipótesis nula los datos generen un valor tan extremo como la estadística de prueba observada. Por ejemplo, si consideramos la hipótesis nula admite valores grandes, el valor p se calcula como \\(P(T \\geq t).\\) En el ejemplo de tomadores de té: el valor p lo calculamos usando el percentil donde nuestra observación cae en la distribución generada por las permutación (valor p de una cola). 1 - dist_perm(dif_obs) ## [1] 0.04344 Por otro lado, podemos calcular: Valor p de dos colas: Si la hipótesis nula es cierta, ¿cuál es la probabilidad de observar una diferencia tan extrema o más extrema de lo que observamos? Considerando este caso interpretamos extrema como qué tan lejos cae del centro de masa de la distribución. De tal forma que podemos calcular el valor p como sigue. A partir del valor observado, consideramos cuál dato es menor: la probabilidad bajo lo hipótesis nula de observar una diferencia mayor de la que observamos, o la probabilidad de observar una diferencia menor a la que observamos. Tomamos el mínimo y multiplicamos por dos (Tim C. Hesterberg 2015a): 2 * min(dist_perm(dif_obs), (1 - dist_perm(dif_obs))) ## [1] 0.08688 Este valor p se considera como evidencia moderada en contra de la hipótesis nula. Valores p chicos (observaciones más extremas en comparación con la referencia) aportan más evidencia en contra de la hipótesis nula, y valores más grandes aportan menos evidencia en contra. Definición. Un resultado es estadisticamente significativo si tiene muy baja probabilidad de suceder al azar. Entre más pequeño requiramos un valor p oara declarar un resultado estadísticamente significativo, somos más conservadores. Las pruebas de hipótesis con frecuencia inician contestando una pregunta más general que los valores p: ¿Cuál es la distribución de la estadística de prueba cuando no hay un efecto real? Definición. La distribución nula es la distribución de la estadística de prueba si la hipótesis nula es cierta. En ocasiones también nos referimos a ella como la distribución de referencia pues estamos comparando la estadística de prueba observada a su referencia para determinar que tan inusual es. En el ejemplo de tomadores de té aproximamos la distribución nula (y los valores p) con simulación; sin embargo, para algunas estadísticas hay métodos exactos. En particular, usamos el método de pruebas de permutación. Para dicha prueba el algoritmo para en el caso de dos grupos sería como sigue: Prueba de permutación para dos muestras Supongamos que tenemos m observaciones de una población y n de otra. Combina los m+n valores. Repite: Obtén un remuestra de tamaño m sin reemplazo del total. Usa las n observaciones restantes para obtener la otra muestra. Calcula la estadística de prueba (que compara las muestras). Calcula el valor p como la fracción de las veces que la estadística sobrepasó la estadística observada, multiplica por 2 para una prueba de dos lados. La distribución de la estadística a lo largo de las remuestras de permutación es la distribución de permutación. Ésta puede ser exacta, si se calcula exhaustivamente (como cuando tenemos pocas observaciones) o aproximada (cuando enlistar todas las posible combinaciones es prohibitivo). Tomadores de té (continuación) Ahora hacemos una prueba de permutaciones para otro par de proporciones utilizando el mismo método. La hipótesis nula ahora es: Los tomadores de té Earl Gray usan azúcar a una tasa similar a los tomadores de té negro. Los datos que obtuvimos en nuestra encuesta se muestran en la siguiente tabla: sugar Earl Grey black No.sugar 84 51 sugar 109 23 Y en porcentajes tenemos que: prop_azucar <- te_azucar |> count(Tea, sugar) |> group_by(Tea) |> mutate(prop = 100 * n / sum(n), n = sum(n)) |> filter(sugar == "sugar") |> select(Tea, prop_azucar = prop, n) |> mutate('% usa azúcar' = round(prop_azucar)) |> select(-prop_azucar) prop_azucar |> formatear_tabla() Tea n % usa azúcar Earl Grey 193 56 black 74 31 Pero distintas muestras podrían haber dado distintos resultados. Nos preguntamos qué tan fuerte es la evidencia en contra de que en realidad los dos grupos de personas usan azúcar en proporciones similares considerando que la diferencia que vemos se puede atribuir a variación muestral. Escribimos la función que calcula diferencias para cada muestra: calc_diferencia_2 <- function(datos){ datos |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(Tea) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = Tea, values_from = prop_azucar) |> mutate(diferencia_prop = `Earl Grey` - black) |> pull(diferencia_prop) } La diferencia observada es: ## [1] 0.254 Ahora construimos nuestra distribución nula o de referencia: set.seed(2) reps <- lineup(null_permute("Tea"), te_azucar, n = N_rep) valores_ref <- reps |> group_by(.sample) |> nest() |> mutate(diferencia = lapply(data, calc_diferencia_2)) |> unnest(diferencia) Y podemos graficar la distribución de referencia otra vez marcando el valor observado En este caso, la evidencia es muy fuerte en contra de la hipótesis nula, pues el resultado que obtuvimos es muy extremo en relación a la distribución de referencia. El valor p es cercano a 0. Haz una prueba de permutaciones para diferencia de medias para comparar la propina en cena vs en comidas. Grafica la distribución de referencia. Calcula el valor p (dos colas). Pruebas de permutación: implementación. Hasta ahora nos hemos centrado en ejemplos de diferencias en medias. Podemos extender las pruebas de permutación a \\(\\bar{X}\\) (la media de la primera muestra), \\(n\\bar{X}\\) (la suma de las observaciones en la primera muestra), y más. Teorema. En pruebas de permutación, si dos estadísticas de prueba \\(T_1\\) y \\(T_2\\) están relacionadas por una función estríctamente monótona, \\(T_1(X^*)=f(T_2(X^*))\\) donde \\(X^*\\) es una remuestra de permutación de los datos originales, entonces los valores p serán los mismos en las pruebas de permutación. Muestras con reemplazo de la Distribución Nula. En la implementación de muestreo, no nos aseguramos que las remuestras sean únicas. Sería más acertado tomar muestras sin reemplazo, sin embargo, el costo computacional es demasiado alto. Por simplicidad consideramos muestras con reemplazo del total de \\[m+n\\choose n\\] posibles remuestras. Por lo tanto, al remuestrar obtenemos una muestra de la distribución nula. Entre más muestras, más exactitud. Hemos usado \\(B = 10^3\\) remuestras (N_rep en el código), en general entre más remuestras tendremos una mejor estimación del valor p. Si el verdadero valor es \\(p\\) el estimado tendrá una varianza aproximadamente de \\(p(1- p)/B\\) donde \\(B\\) es el número de remuestras generadas. Observación. Así como los \\(n\\) datos originales son una muestra de la población, también las \\(B\\) remuestras de la estadística son una muestra de una población, en este caso de la distribución nula. La pruebas de permutaciones son más útiles cuando nuestra hipótesis nula se refiere que la distribución de los grupos son muy similares, o la independencia entre observaciones y grupo. Esto también aplica cuando queremos probar por ejemplo, que una variable numérica \\(Y\\) es independiente de \\(X.\\) Hay algunas hipótesis que no se pueden probar con este método, como por ejemplo, las que se refieren a una sola muestra: ¿los datos son consistentes con que su media es igual a 5? Adicionalmente, en algunas ocasiones queremos probar aspectos más específicos de las diferencias: como ¿son iguales las medias o medianas de dos grupos de datos? ¿Tienen dispersión similar? Es común aplicar pruebas de permutaciones a este segundo problema, sin embargo, no están tan perfectamente adaptadas a el, pues prueban todos los aspectos de las distribuciones que se comparan, aún cuando escojamos una estadística particular que pretende medir. Por ejemplo, cuando trabajamos con la diferencia de medias. Eso quiere decir que podemos rechazar igualdad de medias, por ejemplo, cuando en realidad otra característica de las distribuciones es la que difiere mucho en las poblaciones. En algunas referencias (ver (Chihara and Hesterberg 2018), (Efron and Tibshirani 1993)) se argumenta que de todas formas las pruebas de permutaciones son relativamente robustas a esta desadaptación. Un caso excepcional, por ejemplo, es cuando las poblaciones que comparamos resultan tener dispersión extremadamente distinta, y adicionalmente los tamaños de muestra de los grupos son muy desiguales (otra vez, ver ejemplos en (Chihara and Hesterberg 2018)). Ejemplo: tiempos de fusión Veamos el siguiente ejemplo, que es un experimento donde se midió el tiempo que tardan distintas personas en fusionar un estereograma para ver una imagen 3D. (William S. Cleveland (1993)). Existen dos condiciones: en una se dio indicaciones de qué figura tenían que buscar (VV) y en otra no se dio esa indicación. ¿Las instrucciones verbales ayudan a fusionar más rápido el estereograma? ## ## ── Column specification ──────────────────────────────────────────────────────── ## cols( ## n = col_double(), ## time = col_double(), ## nv.vv = col_character() ## ) La situación es la siguiente: considerando que hay mucha variación en el tiempo de fusión dentro de cada tratamiento, necesitamos calificar la evidencia de nuestra conclusión (el tiempo de fusión se reduce con información verbal). Podemos usar una prueba de permutaciones, esta vez justificándola por el hecho de que los tratamientos se asignan al azar: si los tratamientos son indistinguibles, entonces las etiquetas de los grupos son sólo etiquetas, y permutarlas daría muestras igualmente verosímiles. En este caso, compararemos gráficas de cuantiles de los datos con los producidos por permutaciones (transformamos los datos pues en este caso es más apropiado una comparación multiplicativa): ¿Podemos identificar los datos? En general, muy frecuentemente las personas identifican los datos correctamente, lo que muestra evidencia considerable de que la instrucción verbal altera los tiempos de respuesta de los partipantes, y en este caso ayuda a reducir el tiempo de fusión de los estereogramas. Ejemplo: tiempos de fusión (continuación) Podemos usar las pruebas de permutaciones para distintos tipos de estadísticas: medianas, medias, comparar dispersión usando rangos intercuartiles o varianzas, etc. Regresamos a los tiempos de fusión. Podemos hacer una prueba de permutaciones para la diferencia de las medias o medianas, por ejemplo. En este ejemplo usaremos una medida de centralidad un poco diferente, como ilustración: el promedio de los cuartiles superior e inferior de las dos distribuciones. Usaremos el cociente de estas dos cantidades para medir su diferencia # esta función hace permutaciones y calcula la diferencia para cada una permutaciones_est <- function(datos, variable, calc_diferencia, n = 1000){ # calcular estadística para cada grupo permutar <- function(variable){ sample(variable, length(variable)) } tbl_perms <- tibble(.sample = seq(1, n-1, 1)) |> mutate(diferencia = map_dbl(.sample, ~ datos |> mutate({{variable}}:= permutar({{variable}})) |> calc_diferencia())) bind_rows(tbl_perms, tibble(.sample = n, diferencia = calc_diferencia(datos))) } stat_fusion <- function(x){ (quantile(x, 0.75) + quantile(x, 0.25))/2 } calc_fusion <- function(stat_fusion){ fun <- function(datos){ datos |> group_by(nv.vv) |> summarise(est = stat_fusion(time), .groups = 'drop') |> pivot_wider(names_from = nv.vv, values_from = est) |> mutate(dif = VV / NV ) |> pull(dif) } fun } calc_cociente <- calc_fusion(stat_fusion) dif_obs <- calc_cociente(fusion) # permutar valores_ref <- permutaciones_est(fusion, nv.vv, calc_cociente, n = N_rep) dist_perm_nv <- ecdf(valores_ref$diferencia) cuantil_obs <- dist_perm_nv(dif_obs) Y el valor p de dos colas es dist_perm_nv <- ecdf(valores_ref$diferencia) 2 * min(dist_perm_nv(dif_obs), 1 - dist_perm_nv(dif_obs)) ## [1] 0.028 Lo que muestra evidencia considerable, aunque no muy fuerte, de que la instrucción verbal ayuda a reducir el tiempo de fusión de los estereogramas: la caja del diagrama de caja y brazos para el grupo VV está encogida por un factor menor a 1. Separación de grupos Este ejemplo tomado de (Chowdhury et al. 2015) (tanto la idea como el código). La pregunta que se aborda en ese estudio es: Existen métodos de clasificación (supervisados o no supervisados) para formar grupos en términos de variables que describen a los individuos Estos métodos (análisis discriminante, o k-means, por ejemplo), pretenden formar grupos compactos, bien separados entre ellos. Cuando aplicamos el método, obtenemos clasificadores basados en las variables de entrada. La pregunta es: ¿los grupos resultantes son producto de patrones que se generalizan a la población, o capitalizaron en variación aleatoria para formarse? Especialmente cuando tenemos muchas mediciones de los individuos, y una muestra relativamente chica, Es relativamente fácil encontrar combinaciones de variables que separan los grupos, aunque estas combinaciones y diferencias están basadas en ruido y no generalizan a la población. Como muestran en (Chowdhury et al. 2015), el lineup es útil para juzgar si tenemos evidencia en contra de que los grupos en realidad son iguales, y usamos variación muestral para separarlos. Avispas (opcional) En el siguiente ejemplo, tenemos 4 grupos de avispas (50 individuos en total), y para cada individuo se miden expresiones de 42 genes distintos. La pregunta es: ¿Podemos separar a los grupos de avispas dependiendo de sus mediciones? En este se usó análisis discriminante (LDA) para buscar proyecciones de los datos en dimensión baja de forma que los grupos sean lo más compactos y separados posibles. Para probar qué tan bien funciona este método, podemos hacer una prueba de permutación, aplicamos LDA y observamos los resultados. Y vemos que incluso permutando los grupos, es generalmente posible separarlos en grupos bien definidos: la búsqueda es suficientemente agresiva para encontrar combinaciones lineales que los separan. Que no podamos distinguir los datos verdaderos de las replicaciones nulas indica que este método difícilmente puede servir para separar los grupos claramente. Otro enfoque sería separar los datos en una muestra de entrenamiento y una de prueba (que discutiremos en la última sesión). Aplicamos el procedimiento a la muestra de entrenamiento y luego vemos qué pasa con los datos de prueba: set.seed(8) wasps_1 <- wasps |> mutate(u = runif(nrow(wasps), 0, 1)) wasps_entrena <- wasps_1 |> filter(u <= 0.8) wasps_prueba <- wasps_1 |> filter(u > 0.8) wasp.lda <- MASS::lda(Group ~ ., data=wasps_entrena[,-1]) wasp_ld_entrena <- predict(wasp.lda, dimen=2)$x |> as_tibble(.name_repair = "universal") |> mutate(tipo = "entrenamiento") |> mutate(grupo = wasps_entrena$Group) wasp_ld_prueba <- predict(wasp.lda, newdata = wasps_prueba, dimen=2)$x |> as_tibble(.name_repair = "universal") |> mutate(tipo = "prueba")|> mutate(grupo = wasps_prueba$Group) wasp_lda <- bind_rows(wasp_ld_entrena, wasp_ld_prueba) ggplot(wasp_lda, aes(x = LD1, y = LD2, colour = grupo)) + geom_point(size = 3) + facet_wrap(~tipo) Aunque esta separación de datos es menos efectiva en este ejemplo por la muestra chica, podemos ver que la separación lograda en los datos de entrenamiento probablemente se debe a variación muestral. La “crisis de replicabilidad” Recientemente (Ioannidis 2005) se ha reconocido en campos como la psicología la crisis de replicabilidad. Varios estudios que recibieron mucha publicidad inicialmente no han podido ser replicados posteriormente por otros investigadores. Por ejemplo: Hacer poses poderosas produce cambios fisiológicos que mejoran nuestro desempeño en ciertas tareas. Mostrar palabras relacionadas con “viejo” hacen que las personas caminen más lento (efectos de priming). En todos estos casos, el argumento de la evidencia de estos efectos fue respaldada por una prueba de hipótesis nula con un valor p menor a 0.05. La razón es que ese es el estándar de publicación seguido por varias áreas y revistas arbitradas. La tasa de no replicabilidad parece ser mucho más alta (al menos la mitad o más, según algunas fuentes como la señalada arriba) que la sugerida por la tasa de falsos positivos (menos de 5%). Este problema de replicabilidad parece ser más frecuente cuando: Se trata de estudios de potencia baja: mediciones ruidosas y tamaños de muestra chicos. El plan de análisis no está claramente definido desde un principio (lo cual es difícil cuando se están investigando “fenómenos no estudiados antes”). ¿A qué se atribuye esta crisis de replicabilidad? El jardín de los senderos que se bifurcan Aunque haya algunos ejemplos de manipulaciones conscientes —e incluso, en menos casos, malintencionadas— para obtener resultados publicables o significativos (p-hacking), como vimos en ejemplos anteriores, hay varias decisiones, todas razonables, que podemos tomar cuando estamos buscando las comparaciones correctas. Algunas pueden ser: Transformar los datos (tomar o no logaritmos, u otra transformación). Editar datos atípicos (razonable si los equipos pueden fallar, o hay errores de captura, por ejemplo). Distintas maneras de interpretar los criterios de inclusión de un estudio (por ejemplo, algunos participantes mostraron tener gripa, o revelaron que durmieron muy poco la noche anterior, etc. ¿los dejamos o los quitamos?). Dado un conjunto de datos, las justificaciones de las decisiones que se toman en cada paso son razonables, pero con datos distintos las decisiones podrían ser diferentes. Este es el jardín de los senderos que se bifurcan (ver referencia en Gelman), que invalida en parte el uso valores p como criterio de evidencia contra la hipótesis nula. Esto es exacerbado por: Tamaños de muestra chicos y efectos “inestables” que se quieren medir (por ejemplo en psicología). El hecho de que el criterio de publicación es obtener un valor \\(p < 0.05\\), y la presión fuerte sobre los investigadores para producir resultados publicables (\\(p < 0.05\\)). El que estudios o resultados similares que no obtuvieron valores \\(p\\) por debajo del umbral no son publicados o reportados. Ver por ejemplo el comunicado de la ASA. Ojo: esas presiones de publicación no sólo ocurre para investigadores en psicología. Cuando trabajamos en problemas de análisis de datos que son de importancia, es común que existan intereses de algunas partes o personas involucradas por algunos resultados u otros (por ejemplo, nuestros clientes de consultoría o clientes internos). Eso puede dañar nuestro trabajo como analistas, y el avance de nuestro equipo. Aunque esas presiones son inevitables, se vuelven manejables cuando hay una relación de confianza entre las partes involucradas. Ejemplo: decisiones de análisis y valores p En el ejemplo de datos de fusión, decidimos probar, por ejemplo, el promedio de los cuartiles inferior y superior, lo cual no es una decisión típica pero usamos como ilustración. Ahora intentamos usar distintas mediciones de la diferencia entre los grupos, usando distintas medidas resumen y transformaciones (por ejemplo, con o sin logaritmo). Aquí hay unas 12 combinaciones distintas para hacer el análisis (multiplicadas por criterios de “aceptación de datos en la muestra”, que simulamos tomando una submuestra al azar): calc_fusion <- function(stat_fusion, trans, comparacion){ fun <- function(datos){ datos |> group_by(nv.vv) |> summarise(est = stat_fusion({{ trans }}(time)), .groups = 'drop') |> pivot_wider(names_from = nv.vv, values_from = est) |> mutate(dif = {{ comparacion }}) |> pull(dif) } fun } valor_p <- function(datos, variable, calc_diferencia, n = 1000){ # calcular estadística para cada grupo permutar <- function(variable){ sample(variable, length(variable)) } tbl_perms <- tibble(.sample = seq(1, n-1, 1)) |> mutate(diferencia = map_dbl(.sample, ~ datos |> mutate({{variable}} := permutar({{variable}})) |> calc_diferencia())) perms <- bind_rows(tbl_perms, tibble(.sample = n, diferencia = calc_diferencia(datos))) perms_ecdf <- ecdf(perms$diferencia) dif <- calc_diferencia(datos) 2 * min(perms_ecdf(dif), 1- perms_ecdf(dif)) } set.seed(7272) media_cuartiles <- function(x){ (quantile(x, 0.75) + quantile(x, 0.25))/2 } # nota: usar n=10000 o más, esto solo es para demostración: ejemplo <- list() calc_dif <- calc_fusion(mean, identity, VV - NV) ejemplo$media_dif <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(mean, log, VV - NV) ejemplo$media_dif_log <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(median, identity, VV / NV) ejemplo$mediana_razon <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(media_cuartiles, identity, VV / NV) ejemplo$cuartiles_razon <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) ejemplo <- read_rds("cache/ejemplo_p_val.rds") ejemplo$media_dif ## [1] 0.0658 ejemplo$media_dif_log ## [1] 0.018 ejemplo$mediana_razon ## [1] 0.049 ejemplo$cuartiles_razon ## [1] 0.0464 Si existen grados de libertad —muchas veces necesarios para hacer un análisis exitoso—, entonces los valores p pueden tener poco significado. Alternativas o soluciones El primer punto importante es reconocer que la mayor parte de nuestro trabajo es exploratorio (recordemos el proceso complicado del análisis de datos de refinamiento de preguntas). En este tipo de trabajo, reportar valores p puede tener poco sentido, y mucho menos tiene sentido aceptar algo verdadero cuando pasa un umbral de significancia dado. Nuestro interés principal al hacer análisis es: expresar correctamente, y de manera útil, la incertidumbre asociada a las conclusiones o patrones que mostramos (asociada a variación muestral, por ejemplo) con el objetivo que el proceso de toma de decisiones sea informado. Un resumen de un número (valor p, o el que sea) no puede ser tomado como criterio para tomar una decisión que generalmente es compleja. En la siguiente sección veremos cómo podemos mostrar parte de esa incertidumbre de manera más útil. Por otra parte, los estudios confirmatorios (donde se reportan valores p) también tienen un lugar. En áreas como la psicología, existen ahora movimientos fuertes en favor de la repetición de estudios prometedores pero donde hay sospecha de grados de libertad del investigador. Este movimiento sugiere dar valor a los estudios exploratorios que no reportan valor p, y posteriormente, si el estudio es de interés, puede intentarse una replicación confirmatoria, con potencia más alta y con planes de análisis predefinidos. Referencias "],["estimación-y-distribución-de-muestreo-1.html", "Sección 4 Estimación y distribución de muestreo Ejemplo: precios de casas Distribución de muestreo Más ejemplos El error estándar Calculando la distribución de muestreo Teorema central del límite Normalidad y gráficas de cuantiles normales Prueba de hipótesis de normalidad Ejemplo Más del Teorema central del límite", " Sección 4 Estimación y distribución de muestreo En esta sección discutiremos cuál el objetivo general del proceso de estimación, y cómo entender y manejar la variabilidad que se produce cuando aleatorizamos la selección de las muestras que utilizamos para hacer análisis. A diferencia de las pruebas de permutación, donde evaluábamos como cambiaría una estadísitica si un tratamiento o grupo se hubiera asignado de forma distinta, en la siguiente sección nos preguntamos como varía una estadística entre muestras. Por ejemplo, pasaremos de preguntar si una vacuna reduce el riesgo de una enfermedad a evaluar en que magnitud se reduce el riesgo de contraer la enfermedad. Ejemplo: precios de casas Supongamos que queremos conocer el valor total de las casas que se vendieron recientemente en una zona particular. Supondremos que tenemos un listado de las casas que se han vendido recientemente, pero en ese listado no se encuentra el precio de venta. Decidimos entonces tomar una muestra aleatoria de 100 de esas casas. Para esas casas hacemos trabajo de campo para averiguar el precio de venta. marco_casas <- read_csv("data/casas.csv") set.seed(841) muestra_casas <- sample_n(marco_casas, 100) |> select(id, nombre_zona, area_habitable_sup_m2, precio_miles) sprintf("Hay %0.0f casas en total, tomamos muestra de %0.0f", nrow(marco_casas), nrow(muestra_casas)) ## [1] "Hay 1144 casas en total, tomamos muestra de 100" head(muestra_casas) ## # A tibble: 6 × 4 ## id nombre_zona area_habitable_sup_m2 precio_miles ## <dbl> <chr> <dbl> <dbl> ## 1 287 NAmes 161. 159 ## 2 755 NAmes 95.3 156 ## 3 1190 Gilbert 168. 189 ## 4 36 NridgHt 228. 309 ## 5 32 Sawyer 114. 149. ## 6 538 NAmes 80.3 111. Como tomamos una muestra aleatoria, intentamos estimar el valor total de las casas que se vendieron expandiendo el total muestral, es decir nuestro estimador \\(\\hat{t} = t(X_1,\\ldots X_{100})\\) del total poblacional \\(t\\) es \\[\\hat{t} = \\frac{N}{n} \\sum_{i=1}^{100} X_i = N\\bar{x}\\] Esta función implementa el estimador: n <- nrow(muestra_casas) # tamaño muestra N <- nrow(marco_casas) # tamaño población estimar_total <- function(muestra_casas, N){ total_muestral <- sum(muestra_casas$precio_miles) n <- nrow(muestra_casas) # cada unidad de la muestra representa a N/n f_exp <- N / n # estimador total es la expansión del total muestral estimador_total <- f_exp * total_muestral res <- tibble(total_muestra = total_muestral, factor_exp = f_exp, est_total_millones = estimador_total / 1000) res } estimar_total(muestra_casas, N) |> mutate(across(where(is.numeric), \\(x) round(x, 2))) ## # A tibble: 1 × 3 ## total_muestra factor_exp est_total_millones ## <dbl> <dbl> <dbl> ## 1 18444. 11.4 211 Sin embargo, si hubiéramos obtenido otra muestra, hubiéramos obtenido otra estimación diferente. Por ejemplo: estimar_total(sample_n(marco_casas, 100), N) |> mutate(across(where(is.numeric), \\(x) round(x, 2))) ## # A tibble: 1 × 3 ## total_muestra factor_exp est_total_millones ## <dbl> <dbl> <dbl> ## 1 17916. 11.4 205. El valor poblacional que buscamos estimar (nótese que en la práctica este no lo conocemos) es: # multiplicar por 1000 para que sea en millones de dólares total_pob <- sum(marco_casas |> pull(precio_miles)) / 1000 total_pob ## [1] 209.7633 Así que: Para algunas muestras esta estadística puede estar muy cercana al valor poblacional, pero para otras puede estar más lejana. Para entender qué tan buena es una estimación particular, entonces, tenemos que entender cuánta variabilidad hay de muestra a muestra debida a la aleatorización. Esto depende del diseño de la muestra y de la población de precios de casas (que no conocemos). Distribución de muestreo La distribución de muestreo de una estadística enumera los posibles resultados que puede tomar esa estadística sobre todas las muestras posibles. Este es el concepto básico para poder entender qué tan bien o mal estima un parámetro poblacional dado. En nuestro ejemplo anterior de precio de casas, no podemos calcular todas las posibles estimaciones bajo todas las posibles muestras, pero podemos aproximar repitiendo una gran cantidad de veces el proceso de muestreo, como hicimos al aproximar la distribución de permutaciones de estadísticas de prueba de las secciones anteriores. Empezamos repitiendo 10 veces y examinamos cómo varía nuestra estadística: replicar_muestreo <- function(marco_casas, m = 500, n){ # n es el tamaño de muestra que se saca de marco_casas # m es el número de veces que repetimos el muestro de tamaño n resultados <- map_df(1:m, function(id) { sample_n(marco_casas, n) |> estimar_total(N) }, .id = "id_muestra") } replicar_muestreo(marco_casas, m = 10, n = 100) |> mutate(across(where(is.numeric), round, 1)) |> formatear_tabla() id_muestra total_muestra factor_exp est_total_millones 1 17594.8 11.4 201.3 2 17423.9 11.4 199.3 3 18444.3 11.4 211.0 4 17696.6 11.4 202.4 5 17275.8 11.4 197.6 6 17867.6 11.4 204.4 7 18450.8 11.4 211.1 8 18187.2 11.4 208.1 9 18604.2 11.4 212.8 10 19144.4 11.4 219.0 Como vemos, hay variación considerable en nuestro estimador del total, pero la estimación que haríamos con cualquiera de estas muestras no es muy mala. Ahora examinamos un número más grande de simulaciones: replicaciones_1 <- replicar_muestreo(marco_casas, m = 1500, n = 100) Y el siguiente histograma nos dice qué podemos esperar de la variación de nuestras estimaciones, y donde es más probable que una estimación particular caiga: graf_1 <- ggplot(replicaciones_1, aes(x = est_total_millones)) + geom_histogram() + geom_vline(xintercept = total_pob, colour = "red") + xlab("Millones de dólares") + scale_x_continuous(breaks = seq(180, 240, 10), limits = c(180, 240)) graf_1 Con muy alta probabilidad el error no será de más de unos 30 millones de dólares (o no más de 20% del valor poblacional). Definición Sea \\(X_1, X_2, \\ldots X_n\\) una muestra, y \\(T = t(X_1, X_2, \\ldots, X_n)\\) una estadística. La distribución de muestreo de \\(T\\) es la función de distribución de \\(T\\). Esta distribución es sobre todas las posibles muestras que se pueden obtener. Cuando usamos \\(T\\) para estimar algún parámetro poblacional \\(\\theta\\), decimos informalmente que el estimador es preciso si su distribución de muestreo está muy concentrada alrededor del valor \\(\\theta\\) que queremos estimar. Si la distribución de muestreo está concentrada en un conjunto muy grande o muy disperso, quiere decir que con alta probabilidad cuando obtengamos nuestra muestra y calculemos nuestra estimación, el resultado estará lejano del valor poblacional que nos interesa estimar. Veamos qué pasa cuando hacemos la muestra más grande en nuestro ejemplo: replicaciones_2 <- replicar_muestreo(marco_casas, m = 1500, n = 250) Graficamos las dos distribuciones de muestreo juntas, y vemos cómo con mayor muestra obtenemos un estimador más preciso, y sin considerar el costo, preferimos el estimador mejor concentrado alrededor del valor que buscamos estimar. library(patchwork) graf_2 <- ggplot(replicaciones_2, aes(x = est_total_millones)) + geom_histogram() + geom_vline(xintercept = total_pob, colour = "red") + xlab("Millones de dólares") + scale_x_continuous(breaks = seq(180, 240, 10), limits = c(180, 240)) graf_1 + graf_2 Observación: a veces este concepto se confunde la distribución poblacional de las \\(X_i\\). Esto es muy diferente. Por ejemplo, en nuestro caso, el histograma de la distribución de valores poblacionales es ggplot(marco_casas, aes(x = precio_miles)) + geom_histogram() que en general no tiene ver mucho en escala o forma con la distribución de muestreo de nuestro estimador del total. Más ejemplos Podemos también considerar muestrear de poblaciones sintéticas o modelos probabilísticos que usamos para modelar poblaciones reales. Por ejemplo, supongamos que tomamos una muestra de tamaño 15 de la distribución uniforme en \\([0,1]\\). Es decir, cada \\(X_i\\) es un valor uniformemente distribuido en \\([0,1]\\), y las \\(X_i\\) se extraen independientemente unas de otras. Consideramos dos estadísticas de interés: La media muestral \\(T_1(X) = \\frac{1}{15}\\sum_{i = 1}^{15} X_i\\) El cuantil 0.75 de la muestra \\(T_2(X) = q_{0.75}(X)\\) ¿Cómo crees que se vean las distribuciones muestrales de estas estadísticas? ¿Alrededor de qué valores crees que concentren? ¿Crees que tendrán mucha o poca dispersión? ¿Qué forma crees que tengan? Para el primer caso hacemos: # simular replicar_muestreo_unif <- function(est = mean, m, n = 15){ valores_est <- map_dbl(1:m, ~ est(runif(n))) tibble(id_muestra = 1:m, estimacion = valores_est) } sim_estimador_1 <- replicar_muestreo_unif(mean, 4000, 15) # graficar aprox de distribución de muestreo ggplot(sim_estimador_1, aes(x = estimacion)) + geom_histogram(bins = 40) + xlim(c(0, 1)) # simular para el máximo cuantil_75 <- function(x) quantile(x, 0.75) sim_estimador_2 <- replicar_muestreo_unif(cuantil_75, 4000, 15) # graficar distribución de muestreo ggplot(sim_estimador_2, aes(x = estimacion)) + geom_histogram(breaks = seq(0, 1, 0.02)) + xlim(c(0, 1)) Supón que tenemos una muestra de 30 observaciones de una distribución uniforme \\([0,b]\\). ¿Qué tan buen estimador de \\(b/2\\) es la media muestral? ¿Cómo lo cuantificarías? ¿Qué tan buen estimador del cuantil 0.8 de la distribución uniforme es el cuantil 0.8 muestral? ¿Qué desventajas notas en este estimador? El error estándar Una primera medida útil de la dispersión de la distribución de muestreo es su desviación estándar: la razón específica tiene qué ver con un resultado importante, el teorema central del límite, que veremos más adelante. En este caso particular, a esta desviación estándar se le llama error estándar: Definición A la desviación estándar de una estadística \\(T\\) le llamamos su error estándar, y la denotamos por \\(\\text{ee}(T)\\). A cualquier estimador de este error estándar lo denotamos como \\(\\hat{\\text{ee}}(T)\\). Este error estándar mide qué tanto varía el estimador \\(T\\) de muestra a muestra. Observación: es importante no confundir el error estándar con la desviación estándar de una muestra (o de la población). En nuestro ejemplo de las uniformes, la desviación estándar de las muestras varía como: map_dbl(1:10000, ~ sd(runif(15))) |> quantile() |> round(2) ## 0% 25% 50% 75% 100% ## 0.11 0.26 0.29 0.31 0.41 Mientras que el error estándar de la media es aproximadamente map_dbl(1:10000, ~ mean(runif(15))) |> sd() ## [1] 0.07439575 y el error estándar del máximo es aproximadamente map_dbl(1:10000, ~ max(runif(15))) |> sd() ## [1] 0.05928675 Como ejercicio para contrastar estos conceptos, puedes considerar: ¿Qué pasa con la desviación estándar de una muestra muy grande de uniformes? ¿Qué pasa con el error estándar de la media muestral de una muestra muy grande de uniformes? Ejemplo: valor de casas Consideramos el error estándar del estimador del total del inventario vendido, usando una muestra de 250 con el estimador del total que describimos arriba. Como aproximamos con simulación la distribución de muestreo, podemos hacer: ee_2 <- replicaciones_2 |> pull(est_total_millones) |> sd() round(ee_2, 1) ## [1] 5.2 que está en millones de pesos y cuantifica la dispersión de la distribución de muestreo del estimador del total. Para tamaño de muestra 100, obtenemos más dispersión: ee_1 <- replicaciones_1 |> pull(est_total_millones) |> sd() round(ee_1, 1) ## [1] 8.9 Nótese que esto es muy diferente, por ejemplo, a la desviación estándar poblacional o de una muestra. Estas dos cantidades miden la variabilidad del estimador del total. Calculando la distribución de muestreo En los ejemplos anteriores usamos simulación para obtener aproximaciones de la distribución de muestreo de algunos estimadores. También es posible: Hacer cálculos exactos a partir de modelos probabilísticos. Hacer aproximaciones asintóticas para muestras grandes (de las cuales la más importante es la que da el teorema central del límite). En los ejemplos de arriba, cuando muestreamos de la poblaciones, extrajimos las muestras de manera aproximadamente independiente. Cada observación \\(X_i\\) tiene la misma distribución y las \\(X_i\\)’s son independientes. Este tipo de diseños aleatorizados es de los más simples, y se llama muestreo aleatorio simple. En general, en esta parte haremos siempre este supuesto: Una muestra es iid (independiente e idénticamente distribuida) si es es un conjunto de observaciones \\(X_1,X_2, \\ldots X_n\\) independientes, y cada una con la misma distribución. En términos de poblaciones, esto lo logramos obteniendo cada observación de manera aleatoria con el mismo procedimiento. En términos de modelos probabilísticos, cada \\(X_i\\) se extrae de la misma distribución fija \\(F\\) (que pensamos como la “población”) de manera independiente. Esto lo denotamos por \\(X_i \\overset{iid}{\\sim} F.\\) Ejemplo Si \\(X_1, X_2, \\ldots X_n\\) es una muestra de uniformes independientes en \\([0,1]\\), ¿cómo calcularíamos la distribución de muestreo del máximo muestra \\(T_2 = \\max\\)? En este caso, es fácil calcular su función de distribución acumulada de manera exacta: \\[F_{\\max}(x) = P(\\max\\{X_1,X_2,\\ldots X_n\\} \\leq x)\\] El máximo es menor o igual a \\(x\\) si y sólo si todas las \\(X_i\\) son menores o iguales a \\(x\\), así que \\[F_{\\max} (x) = P(X_1\\leq x, X_2\\leq x, \\cdots, X_n\\leq x)\\] como las \\(X_i\\)’s son independientes entonces \\[F_{\\max}(x) = P(X_1\\leq x)P(X_2\\leq x)\\cdots P(X_n\\leq x) = x^n\\] para \\(x\\in [0,1]\\), pues para cada \\(X_i\\) tenemos \\(P(X_i\\leq x) = x\\). Así que no es necesario usar simulación para conocer esta distribución de muestreo. Derivando esta distribución acumulada obtenemos su densidad, que es \\[f(x) = nx^{n-1}\\] para \\(x\\in [0,1]\\), y es cero en otro caso. Si comparamos con nuestra simulación: teorica <- tibble(x = seq(0, 1 ,0.001)) |> mutate(f_dens = 15 * x^14) sim_estimador_3 <- replicar_muestreo_unif(max, 4000, 15) ggplot(sim_estimador_3) + geom_histogram(aes(x = estimacion), breaks = seq(0, 1, 0.02)) + xlim(c(0.5, 1)) + # el histograma es de ancho 0.02 y el número de simulaciones 4000 geom_line(data = teorica, aes(x = x, y = (4000 * 0.02) * f_dens), colour = "red", linewidth = 1.3) Y vemos que con la simulación obtuvimos una buena aproximación Nota: ¿cómo se relaciona un histograma con la función de densidad que genera los datos? Supón que \\(f(x)\\) es una función de densidad, y obtenemos un número \\(n\\) de simulaciones independientes. Si escogemos un histograma de ancho \\(\\Delta\\), ¿cuántas observaciones esperamos que caigan en un intervalo \\(I = [a - \\Delta/2, a + \\Delta/2]\\)?. La probabilidad de que una observación caiga en \\(I\\) es igual a \\[P(X\\in I) = \\int_I f(x)\\,dx = \\int_{a - \\Delta/2}^{a + \\Delta/2} f(x)\\,dx \\approx f(a) \\text{long}(I) = f(a) \\Delta\\] para \\(\\Delta\\) chica. Si nuestra muestra es de tamaño \\(n\\), el número esperado de observaciones que caen en \\(I\\) es entonces \\(nf(a)\\Delta\\). Eso explica el ajuste que hicimos en la gráfica de arriba. Otra manera de hacer es ajustando el histograma: si en un intervalo el histograma alcanza el valor \\(y\\), \\[f(a) = \\frac{y}{n\\Delta}\\] teorica <- tibble(x = seq(0, 1 ,0.001)) |> mutate(f_dens = 15*x^{14}) ggplot(sim_estimador_3) + geom_histogram(aes(x = estimacion, y = after_stat(density)), breaks = seq(0, 1, 0.02)) + xlim(c(0.5, 1)) + # el histograma es de ancho 0.02 y el número de simulaciones 4000 geom_line(data = teorica, aes(x = x, y = f_dens), colour = "red", size = 1.3) Ejemplo Supongamos que las \\(X_i\\)’s son independientes y exponenciales con tasa \\(\\lambda > 0\\). ¿Cuál es la distribución de muestreo de la suma \\(S = X_1 + \\cdots + X_n\\)? Sabemos que la suma de exponenciales independientes es una distribución gamma con parámetros \\((n, \\lambda)\\), y esta es la distribución de muestreo de nuestra estadística \\(S\\) bajo las hipótesis que hicimos. Podemos checar este resultado con simulación, por ejemplo para una muestra de tamaño \\(n=15\\) con \\(\\lambda = 1\\): replicar_muestreo_exp <- function(est = mean, m, n = 150, lambda = 1){ valores_est <- map_dbl(1:m, ~ est(rexp(n, lambda))) tibble(id_muestra = 1:m, estimacion = valores_est) } sim_estimador_1 <- replicar_muestreo_exp(sum, 4000, n = 15) teorica <- tibble(x = seq(0, 35, 0.001)) |> mutate(f_dens = dgamma(x, shape = 15, rate = 1)) # graficar aprox de distribución de muestreo ggplot(sim_estimador_1) + geom_histogram(aes(x = estimacion, y = after_stat(density)), bins = 35) + geom_line(data = teorica, aes(x = x, y = f_dens), colour = "red", linewidth = 1.2) Teorema central del límite Si consideramos los ejemplos de arriba donde tratamos con estimadores basados en una suma, total o una media —y en menor medida cuantiles muestrales—, vimos que las distribución de muestreo de las estadísticas que usamos tienden a tener una forma común. Estas son manifestaciones de una regularidad estadística importante que se conoce como el teorema central del límite: las distribuciones de muestreo de sumas y promedios son aproximadamente normales cuando el tamaño de muestra es suficientemente grande. Teorema central del límite Si \\(X_1,X_2, \\ldots, X_n\\) son independientes e idénticamente distribuidas con media \\(\\mu\\) y desviación estándar \\(\\sigma\\) finitas. Si el tamaño de muestra \\(n\\) es grande, entonces la distribución de muestreo de la media \\[\\bar{X} = \\frac{X_1 + X_2 +\\cdots + X_n}{n}\\] es aproximadamente normal con media \\(\\mu\\) y desviación estándar \\(\\sigma/\\sqrt{n}\\), que escribimos como \\[\\bar{X} \\xrightarrow{} \\mathsf{N}\\left( \\mu, \\frac{\\sigma}{\\sqrt{n}} \\right)\\] Adicionalmente, la distribución de la media estandarizada converge a una distribución normal estándar cuando \\(n\\) es grande: \\[\\sqrt{n} \\, \\left( \\frac{\\bar{X}-\\mu}{\\sigma} \\right) \\xrightarrow{} \\mathsf{N}(0, 1)\\] El error estándar de \\(\\bar{X}\\) es \\(\\text{ee}(\\bar{X}) = \\frac{\\sigma}{\\sqrt{n}}\\). Si tenemos una muestra, podemos estimar \\(\\sigma\\) con de la siguiente forma: \\[\\hat{\\sigma} =\\sqrt{\\frac{1}{n}\\sum_{i=1}^n (X_i - \\bar{X})^2}\\] o el más común (que explicaremos más adelante) \\[\\hat{s} = \\sqrt{\\frac{1}{n-1}\\sum_{i=1}^n (X_i - \\bar{X})^2}\\] Este hecho junto con el teorema del límite central nos dice cuál es la dispersión, y cómo se distribuyen las posibles desviaciones de la media muestral alrededor de la verdadera media poblacional. ¿Qué tan grande debe ser \\(n\\). Depende de cómo es la población. Cuando la población tiene una distribución muy sesgada, por ejemplo, \\(n\\) típicamente necesita ser más grande que cuando la población es simétrica si queremos obtener una aproximación “buena”. En algunos textos se afirma que \\(n\\geq 30\\) es suficiente para que la aproximación del Teorema central del límite (TCL) sea buena siempre y cuando la distribución poblacional no sea muy sesgada. Esta regla es más o menos arbitraria y es mejor no confiarse, pues fácilmente puede fallar. En la práctica es importante checar este supuesto, por ejemplo usando remuestreo (que veremos más adelante) Revisa los ejemplos que hemos visto hasta ahora (precios de casas, simulaciones de uniformes y exponenciales según las distintas estadísticas que consideramos). ¿Qué distribuciones de muestreo parecen tener una distribución normal? ¿Cómo juzgamos si estas distribuciones están cerca o lejos de una distribución normal? Normalidad y gráficas de cuantiles normales Para checar si una distribución de datos dada es similar a la normal, la herramienta mas común en estádística es la gráfica de cuantiles teóricos, que es una generalización de la gráfica de cuantiles que vimos anteriormente. En primer lugar, definimos la función de cuantiles de una distribución teórica, que es análoga a la que definimos para conjuntos de datos: Supongamos que tenemos una distribución acumulada teórica \\(\\Phi\\). Podemos definir el cuantil-\\(f\\) \\(q(f)\\) de \\(\\Phi\\) como el valor \\(q(f)\\) tal que \\[q(f) = \\text{argmin}\\{x \\,| \\, \\Phi(x)\\geq f \\}\\] En el caso de que \\(\\Phi\\) tiene densidad \\(\\phi\\), y su soporte es un intervalo (que puede ser de longitud infinita), entonces podemos también escribir \\(q(f)\\) como el valor único donde acumulamos \\(f\\) de la probabilidad \\[\\int_{-\\infty}^{q(f)} \\phi(x)\\,dx= f\\] Por ejemplo, para una densidad normal, abajo mostramos los cuantiles \\(f=0.5\\) (mediana) y \\(f=0.95\\) densidad_tbl <- tibble(x = seq(0, 10, 0.01)) |> mutate(densidad = dnorm(x, 5, 1)) # qnorm es la función de cuantiles de una normal cuantil_50 <- qnorm(0.50, 5, 1) cuantil_90 <- qnorm(0.95, 5, 1) # graficamos densidad_tbl <- densidad_tbl |> mutate(menor_50 = x >= cuantil_50) |> mutate(menor_90 = x >= cuantil_90) g_normal_50 <- ggplot(densidad_tbl, aes(y = densidad)) + ylab('f(x)') + geom_area(aes(x = x, fill = menor_50)) + geom_line(aes(x = x), alpha = 0.1) + geom_vline(xintercept = cuantil_50) + theme(legend.position = "none") + annotate("text", 4.3, 0.2, label = "50%") + labs(subtitle = paste0("q(0.5)=", round(cuantil_50,1))) g_normal_90 <- ggplot(densidad_tbl, aes(y = densidad)) + ylab('f(x)') + geom_area(aes(x = x, fill = menor_90)) + geom_line(aes(x = x), alpha = 0.1) + geom_vline(xintercept = cuantil_90) + theme(legend.position = "none") + annotate("text", 5.0, 0.2, label = "95%") + labs(subtitle = paste0("q(0.95)=", round(cuantil_90,1))) g_normal_50 + g_normal_90 Como todas las distribuciones normales tienen la misma forma, y para obtener una de otra solo basta reescalar y desplazar, para calcular los cuantiles de una variable con distribución normal \\(\\mathsf{N}(\\mu, \\sigma)\\) sólo tenemos que saber los cuantiles de la distribución normal estándar \\(\\mathsf{N}(0,1)\\) y escalarlos apropiadamente por su media y desviación estándar \\[q(f, \\mu, \\sigma) = \\mu + \\sigma q(f, 0, 1)\\] Puedes demostrar esto sin mucha dificultad empezando con \\(P(X\\leq q) = f\\) y estandarizando: \\[P(X\\leq q(f, \\mu, \\sigma)) = f \\implies P\\left (Z\\leq \\frac{q(f,\\mu,\\sigma) - \\mu}{\\sigma}\\right)=f\\] y esto implica que \\[q(f, 0, 1) = \\frac{q(f,\\mu,\\sigma) - \\mu}{\\sigma} \\implies q(f, \\mu, \\sigma) = \\mu + \\sigma q(f, 0, 1)\\] De modo que si graficáramos los cuantiles de una distribución \\(\\mathsf{N}(\\mu, \\sigma)\\) contra los cuantiles de una distribución \\(\\mathsf{N}(0,1)\\), estos cuantiles aparecen en una línea recta: comparacion_tbl <- tibble(f = seq(0.01, 0.99, 0.01)) |> mutate(cuantiles_normal = qnorm(f, 5, 3), cuantiles_norm_estandar = qnorm(f, 0, 1)) ggplot(comparacion_tbl, aes(cuantiles_norm_estandar, cuantiles_normal)) + geom_point() Ahora supongamos que tenemos una muestra \\(X_1, \\ldots, X_n\\). ¿Cómo podemos checar si estos datos tienen una distribución aproximadamente normal? Si la muestra tiene una distribución aproximadamente \\(\\mathsf{N}(\\mu, \\sigma)\\), entonces sus cuantiles muestrales y los cuantiles respectivos de la normal estándar están aproximadamente en una línea recta. Primero veamos un ejemplo donde los datos son generados según una normal. set.seed(21) muestra <- tibble(x_1 = rnorm(60, 10, 3), x_2 = rgamma(60, 2, 5)) graf_1 <- ggplot(muestra, aes(sample = x_1)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") graf_2 <- ggplot(muestra, aes(sample = x_2)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") graf_1 + graf_2 ¿Cuáles son los datos aproximadamente normales? ¿Cómo interpretas las desviaciones de la segunda gráfica en términos de la forma de la distribución normal? Prueba de hipótesis de normalidad Para interpretar las gráficas de cuantiles normales se requiere práctica, pues claramente los datos, aún cuando provengan de una distribución normal, no van a caer justo sobre una línea recta y observaremos variabilidad. Esto no descarta necesariamente que los datos sean aproximadamente normales. Con la práctica, generalmente esta gráfica nos da una buena indicación si el supuesto de normalidad es apropiado. Sin embargo, podemos hacer una prueba de hipótesis formal de normalidad si quisiéramos. La hipótesis nula es la siguiente: Los datos provienen de una distribución normal, y las desviaciones que observamos de una línea recta se deben a variación muestral. Podemos generar datos nulos tomando la media y desviación estándar muestrales, y generando muestras normales \\(\\mathsf{N}(\\bar{x}, s)\\). Usamos el lineup, produciendo datos bajo la hipótesis nula y viendo si podemos distinguir los datos. Por ejemplo: library(nullabor) lineup_normal <- lineup(null_dist("x_2", dist = "normal"), muestra) ggplot(lineup_normal, aes(sample = x_2)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") + facet_wrap(~ .sample) En esta gráfica claramente rechazaríamos la hipótesis de normalidad. Sin embargo, para la primera muestra, obtenemos: lineup_normal <- lineup(null_dist("x_1", dist = "normal"), muestra) ggplot(lineup_normal, aes(sample = x_1)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") + facet_wrap(~ .sample) Los datos verdaderos están en attr(lineup_normal, "pos") ## [1] 4 Ejemplo Consideremos el problema de estimar el total poblacional de los precios de las casas que se vendieron. El estimador que usamos fue la suma muestral expandida por un factor. Vamos a checar qué tan cerca de la normalidad está la distribución de meustreo de esta estadística (\\(n=250\\)): replicaciones_2 ## # A tibble: 1,500 × 4 ## id_muestra total_muestra factor_exp est_total_millones ## <chr> <dbl> <dbl> <dbl> ## 1 1 47089. 4.58 215. ## 2 2 45654. 4.58 209. ## 3 3 43973. 4.58 201. ## 4 4 45665. 4.58 209. ## 5 5 43551. 4.58 199. ## 6 6 46066. 4.58 211. ## 7 7 46626. 4.58 213. ## 8 8 47944. 4.58 219. ## 9 9 45381. 4.58 208. ## 10 10 46519. 4.58 213. ## # ℹ 1,490 more rows ggplot(replicaciones_2, aes(sample = est_total_millones)) + geom_qq(alpha = 0.3) + geom_qq_line(colour = "red") Y vemos que en efecto el TCL aplica en este ejemplo, y la aproximación es buena. Aunque la población original es sesgada, la descripción de la distribución de muestreo es sorprendemente compacta: La distribución de muestreo de nuestro estimador del total \\(\\hat{t}\\) es aproximadamente normal con media \\(\\bar{x}\\) y desviación estándar \\(s\\), donde: mu <- mean(replicaciones_2$est_total_millones) s <- sd(replicaciones_2$est_total_millones) c(mu = mu, s = s) |> round(2) ## mu s ## 209.90 5.24 Estas cantidades están en millones de dólares. Ejemplo Supongamos que queremos calcular la probabilidad que la suma de 30 variables uniformes en \\([0,1]\\) independientes sea mayor que 18. Podríamos aproximar esta cantidad usando simulación. Otra manera de aproximar esta cantidad es con el TCL, de la siguiente forma: Si \\(S=X_1 + X_2 + X_{30}\\), entonces la media de \\(S\\) es 15 (¿cómo se calcula?) y su desviación estándar es \\(\\sqrt{\\frac{30}{12}}\\). La suma es entonces aproximadamente \\(\\mathsf{N}\\left(15, \\sqrt{\\frac{30}{12}}\\right)\\). Entonces \\[P(S > 18) = P \\left (\\frac{S - 15}{\\sqrt{\\frac{30}{12}}} > \\frac{18 - 15}{\\sqrt{\\frac{30}{12}}}\\right) \\approx P(Z > 1.897)\\] donde \\(Z\\) es normal estándar. Esta última cantidad la calculamos usando la función de distribución de la normal estándar, y nuestra aproximación es 1 - pnorm(1.897) ## [1] 0.02891397 Podemos checar nuestro cálculo usando simulación: tibble(n_sim = 1:100000) |> mutate(suma = map_dbl(n_sim, ~ sum(runif(30)))) |> summarise(prob_may_18 = mean(suma > 18), .groups = "drop") ## # A tibble: 1 × 1 ## prob_may_18 ## <dbl> ## 1 0.0280 Y vemos que la aproximación normal es buena para fines prácticos. Usando simulaciones haz un histograma que aproxime la distribución de muestreo de \\(S\\). Haz una gráfica de cuantiles normales para checar la normalidad de esta distribución. Ejemplo Cuando el sesgo de la distribución poblacional es grande, puede ser necesario que \\(n\\) sea muy grande para que la aproximación normal sea aceptable para el promedio o la suma. Por ejemplo, si tomamos una gamma con parámetro de forma chico, \\(n = 30\\) no es suficientemente bueno, especialmente si quisiéramos aproximar probabilidades en las colas de la distribución: sims_gamma <- map_df(1:2000, ~ tibble(suma = sum(rgamma(30, 0.1, 1))), .id = "n_sim") ggplot(sims_gamma, aes(x = suma)) + geom_histogram() Más del Teorema central del límite El teorema central del límite aplica a situaciones más generales que las del enunciado del teorema básico. Por ejemplo, aplica a poblaciones finitas (como vimos en el ejemplo de las casas), en 1960 Jaroslav Hajek demostró una versión del TCL bajo muestreo sin reemplazo. Mas allá de la media muestral, el TCL se puede utilizar para más estadísticas ya que muchas pueden verse como promedios, como totales o errores estándar. El TLC se ha generalizado incluso para cuantiles muestrales. Es importante notar que la calidad de la aproximación del TCL depende de características de la población y también del tamaño de muestra \\(n\\). Para ver si el TCL aplica, podemos hacer ejercicios de simulación bajo diferentes supuestos acerca de la población. También veremos más adelante, con remuestreo, maneras de checar si es factible el TCL dependiendo del análisis de una muestra dada que tengamos. El TCL era particularmente importante en la práctica antes de que pudiéramos hacer simulación por computadora. Era la única manera de aproximar y entender la distribución muestral fuera de cálculos analíticos (como los que hicimos para el máximo de un conjunto de uniformes, por ejemplo). Hoy en día, veremos que podemos hacer simulación para obtener respuestas más exactas, particularmente en la construcción de intervalos de confianza, por ejemplo. Dependemos menos de resultados asintóticos, como el TCL. Cuando aproximamos una distribución discreta mediante la distribución normal, conviene hacer correcciones de continuidad, como se explica en (Chihara and Hesterberg 2018), 4.3.2. Referencias "],["intervalos-de-confianza-y-remuestreo.html", "Sección 5 Intervalos de confianza y remuestreo Ejemplo introductorio La idea del bootstrap El principio de plug-in Discusión: propiedades de la distribución bootstrap Error estándar bootstrap e intervalos normales Ejemplo: inventario de casas vendidas Calibración de intervalos de confianza Interpretación de intervalos de confianza Sesgo Intervalos bootstrap de percentiles Bootstrap para dos muestras Bootstrap y otras estadísticas Bootstrap y estimadores complejos: tablas de perfiles Bootstrap y muestras complejas Bootstrap en R Conclusiones y observaciones", " Sección 5 Intervalos de confianza y remuestreo En la sección anterior, vimos el concepto de distribución de muestreo de una estadística que queremos utilizar para estimar un valor poblacional, y vimos que con esta distribución podíamos evaluar qué tan preciso es nuestro estimador evaluando qué tan concentrada está esta distribución alrededor del valor poblacion que queremos estimar. Sin embargo, en los ejemplos que vimos la población era conocida: ya sea que tuviéramos toda la población finita disponible (como el ejemplo de las casas), o donde la población estaba definida por un modelo teórico de probabilidad (como los ejemplos de las distribuciones uniforme o exponencial). Ahora vemos qué hacer en el caso que realmente nos interesa: solo tenemos una muestra disponible, y la población es desconocida. Todo lo que tenemos es una muestra y una estimación basada en la muestra, y requerimos estimar la distribución de muestreo de la estadística de interés. El enfoque que presentaremos aquí es uno de los más flexibles y poderosos que están disponibles para este problema: el método bootstrap o de remuestreo. En primer lugar explicamos el concepto de intervalo de confianza, que es una manera resumida de evaluar la precisión de nuestras estimaciones. Ejemplo introductorio Regresamos a nuestro ejemplo anterior donde muestreamos 3 grupos, y nos preguntábamos acerca de la diferencia de sus medianas. En lugar de hacer pruebas de permutaciones (ya sea pruebas gráficas o alguna prueba de permutaciones para media o mediana, por ejemplo), podríamos considerar qué tan precisa es cada una de nuestras estimaciones para las medianas de los grupos. Nuestros resultados podríamos presentarlos como sigue. Este código lo explicaremos más adelante, por el momento consideramos la gŕafica resultante: set.seed(8) pob_tab <- tibble(id = 1:2000, x = rgamma(2000, 4, 1), grupo = sample(c("a","b", "c"), 2000, prob = c(4,2,1), replace = T)) muestra_tab <- pob_tab |> slice_sample(n = 125) g_1 <- ggplot(muestra_tab, aes(x = grupo, y = x)) + geom_boxplot(outlier.alpha = 0) + geom_jitter(alpha = 0.3) + labs(subtitle = "Muestra \\n") + ylim(c(0,14)) ## Hacemos bootstrap fun_boot <- function(datos){ datos |> group_by(grupo) |> slice_sample(prop = 1, replace = TRUE) } reps_boot <- map_df(1:2000, function(i){ muestra_tab |> fun_boot() |> group_by(grupo) |> summarise(mediana = median(x), .groups = "drop")}, .id = 'rep') resumen_boot <- reps_boot |> group_by(grupo) |> summarise(ymin = quantile(mediana, 0.025), ymax = quantile(mediana, 0.975), .groups = "drop") |> left_join(muestra_tab |> group_by(grupo) |> summarise(mediana = median(x))) g_2 <- ggplot(resumen_boot, aes(x = grupo, y = mediana, ymin = ymin, ymax = ymax)) + geom_linerange() + geom_point(colour = "red", size = 2) + ylim(c(0,14)) + labs(subtitle = "Intervalos de 95% \\n para la mediana") g_1 + g_2 Donde: En rojo está nuestro = puntual de la mediana de cada grupo (la mediana muestral), y Las segmentos muestran un intervalo de confianza del 95% para nuestra estimación de la mediana: esto quiere decir que los valores poblacionales tienen probabilidad aproximada de 95% de estar dentro del intervalo. Este análisis comunica correctamente que tenemos incertidumbre alta acerca de nuestras estimaciones (especialmente grupos b y c), y que no tenemos mucha evidencia de que el grupo b tenga una mediana poblacional considerablemente más alta que a o c. En muchos casos es más útil presentar la información de esta manera que usando alguna prueba de hipótesis. La idea del bootstrap Como explicamos, el problema que tenemos ahora es que normalmente sólo tenemos una muestra, así que no es posible calcular las distribuciones de muestreo como hicimos en la sección anterior y así evaluar qué tan preciso es nuestro estimador. Sin embargo, podemos hacer lo siguiente: Supongamos que tenemos una muestra \\(X_1,X_2,\\dots, X_n\\) independientes de alguna población desconocida y un estimador \\(T=t(X_1,\\dots, X_n)\\) Mundo poblacional Si tuviéramos la distribución poblacional, simulamos muestras iid para aproximar la distribución de muestreo de nuestro estimador, y así entender su variabilidad. Pero no tenemos la distribución poblacional. Sin embargo, podemos estimar la distribución poblacional con nuestros valores muestrales. Mundo bootstrap Si usamos la estimación del inciso 3, entonces usando el inciso 1 podríamos tomar muestras de nuestros datos muestrales, como si fueran de la población, y usando el mismo tamaño de muestra. El muestreo lo hacemos con reemplazo de manera que produzcamos muestras independientes de la misma “población estimada”, que es la muestra. Evaluamos nuestra estadística en cada una de estas remuestras, a estas les llamamos replicaciones bootstrap. A la distribución de las replicaciones le llamamos distribución bootstrap o distribución de remuestreo del estimador. Usamos la distribución bootstrap para estimar la variabilidad en nuestra estimación con la muestra original. Veamos que sucede para un ejemplo concreto, donde nos interesa estimar la media de los precios de venta de una población de casas. Tenemos nuestra muestra: set.seed(2112) poblacion_casas <- read_csv("data/casas.csv") muestra <- slice_sample(poblacion_casas, n = 200, replace = TRUE) mean(muestra$precio_miles) ## [1] 179.963 Esta muestra nos da nuestro estimador de la distribución poblacional: bind_rows(muestra |> mutate(tipo = "muestra"), poblacion_casas |> mutate(tipo = "población")) |> ggplot(aes(sample = precio_miles, colour = tipo, group = tipo)) + geom_qq(distribution = stats::qunif, alpha = 0.4, size = 1) + facet_wrap(~ tipo) O con histogramas: bind_rows(muestra |> mutate(tipo = "muestra"), poblacion_casas |> mutate(tipo = "población")) |> ggplot(aes(x = precio_miles, group = tipo)) + geom_histogram(aes(y=..density..), binwidth = 50) + facet_wrap(~ tipo) Y vemos que la aproximación es razonable en las partes centrales de la distribución. Ahora supongamos que nos interesa cuantificar la precisión de nuestra estimación de la media poblacional de precios de casas, y usaremos la media muestral para hacer esto. Para nuestra muestra, nuestra estimación puntual es: media <- mean(muestra$precio_miles) media ## [1] 179.963 Y recordamos que para aproximar la distribución de muestreo podíamos muestrear repetidamente la población y calcular el valor del estimador en cada una de estas muestras. Aquí no tenemos la población, pero tenemos una estimación de la población: la muestra obtenida. Así que para evaluar la variabilidad de nuestro estimador, entramos en el mundo bootstrap, y consideramos que la población es nuestra muestra. Podemos entonces extraer un número grande de muestras con reemplazo de tamaño 200 de la muestra: el muestreo debe ser análogo al que se tomó para nuestra muestra original. Evaluamos nuestra estadística (en este caso la media) en cada una de estas remuestras: media_muestras <- map_dbl(1:5000, ~ muestra |> slice_sample(n = 200, replace = TRUE) |> summarise(media_precio = mean(precio_miles), .groups = "drop") |> pull(media_precio)) Y nuestra estimación de la distribución de muestreo para la media es entonces: bootstrap <- tibble(media = media_muestras) g_cuantiles <- ggplot(bootstrap, aes(sample = media)) + geom_qq(distribution = stats::qunif) g_histograma <- ggplot(bootstrap, aes(x = media)) + geom_histogram(binwidth = 2) g_cuantiles + g_histograma A esta le llamamos la distribución bootstrap (o de remuestreo) de la media, que definimos más abajo. Ahora podemos calcular un intervalo de confianza del 90% simplemente calculando los cuantiles de esta distribución (no son los cuantiles de la muestra original!): limites_ic <- quantile(media_muestras, c(0.05, 0.95)) |> round() limites_ic ## 5% 95% ## 171 189 Presentaríamos nuestro resultado como sigue: nuestra estimación puntual de la mediana es 180, con un intervalo de confianza del 90% de (171, 189) Otra cosa que podríamos hacer para describir la dispersión de nuestro estimador es calcular el error estándar de remuestreo, que estima el error estándar de la distribución de muestreo: ee_boot <- sd(media_muestras) round(ee_boot, 2) ## [1] 5.39 Definición. Sea \\(X_1,X_2,\\ldots,X_n\\) una muestra independiente y idénticamente distribuida, y \\(T=t(X_1, X_2, \\ldots, X_n)\\) una estadística. Supongamos que sus valores que obervamos son \\(x_1, x_2,\\ldots, x_n\\). La distribución bootstrap, o distribución de remuestreo, de \\(T\\) es la distribución de \\(T^*=t(X_1^*, X_2^*, \\dots X_n^*)\\), donde cada \\(X_i^*\\) se obtiene tomando al azar uno de los valores de \\(x_1,x_2,\\ldots, x_n\\). Otra manera de decir esto es que la remuestra \\(X_1^*, X_2^*, \\ldots, X_n^*\\) es una muestra con reemplazo de los valores observados \\(x_1, x_2, \\ldots, x_n\\) Ejemplo. Si observamos la muestra muestra <- sample(1:20, 5) muestra ## [1] 6 10 7 3 14 Una remuestra se obtiene: sample(muestra, size = 5, replace = TRUE) ## [1] 7 3 7 10 6 Nótese que algunos valores de la muestra original pueden aparecer varias veces, y otros no aparecen del todo. La idea del bootstrap (no paramétrico). La muestra original es una aproximación de la población de donde fue extraída. Así que remuestrear la muestra aproxima lo que pasaría si tomáramos muestras de la población. La distribución de remuestreo de una estadística, que se construye tomando muchas remuestras, aproxima la distribución de muestreo de la estadística. Y el proceso que hacemos es: Remuestreo para una población. Dada una muestra de tamaño \\(n\\) de una población, Obtenemos una remuestra de tamaño \\(n\\) con reemplazo de la muestra original y calculamos la estadística de interés. Repetimos este remuestreo muchas veces (por ejemplo, 10,000). Construímos la distribución bootstrap, y examinamos sus características (dónde está centrada, dispersión y forma). El principio de plug-in La idea básica detrás del bootstrap es el principio de plug-in para estimar parámetros poblacionales: si queremos estimar una cantidad poblacional, calculamos esa cantidad poblacional con la muestra obtenida. Es un principio común en estadística. Por ejemplo, si queremos estimar la media o desviación estándar poblacional, usamos la media muestral o la desviación estándar muestral. Si queremos estimar un cuantil de la población usamos el cuantil correspondiente de la muestra, y así sucesivamente. En todos estos casos, lo que estamos haciendo es: Tenemos una fórmula para la cantidad poblacional de interés en términos de la distribución poblacional. Tenemos una muestra, la distribución que da esta muestra se llama distribución empírica (\\(\\hat{F}(x) = \\frac{1}{n}\\{\\#valores \\le x\\}\\)). Contruimos nuestro estimador, de la cantidad poblacional de interés, “enchufando” la distribución empírica de la muestra en la fórmula del estimador. En el bootstrap aplicamos este principio simple a la distribución de muestreo: Si tenemos la población, podemos calcular la distribución de muestreo de nuestro estimador tomando muchas muestras de la población. Estimamos la poblacion con la muestra y enchufamos en la frase anterior: estimamos la distribución de muestreo de nuestro estimador tomando muchas muestras de la muestra. Nótese que el proceso de muestreo en el último paso debe ser el mismo que se usó para tomar la muestra original. Estas dos imágenes simuladas con base en un ejemplo de Chihara and Hesterberg (2018) muestran lo que acabamos de describir: Figure 5.1: Mundo Real Figure 5.2: Mundo Bootstrap Observación 1. Veremos ejemplos más complejos, pero nótese que si la muestra original son observaciones independientes obtenidas de la distribución poblacional, entonces logramos esto en las remuestras tomando observaciones con reemplazo de la muestra. Igualmente, las remuestras deben ser del mismo tamaño que la muestra original. ¿Porqué no funcionaría tomar muestras sin reemplazo? Piensa si hay independencia entre las observaciones de la remuestra, y cómo serían las remuestras sin reemplazo. ¿Por qué no se puede hacer bootstrap si no conocemos cómo se obtuvo la muestra original? Observación 2. Estos argumentos se pueden escribir con fórmulas usando por ejemplo la función de distribución acumulada \\(F\\) de la población y su estimador, que es la función empírica \\(\\hat{F}\\). Si \\(\\theta = t(F)\\) es una cantidad poblacional que queremos estimar, su estimador plug-in es \\(\\hat{\\theta} = t(\\hat{F})\\). Observación 3: La distribución empírica \\(\\hat{F}\\) es un estimador “razonable” de la distribución poblacional \\(F,\\) pues por el teorema de Glivenko-Cantelli (ver Wasserman (2013), o aquí), \\(\\hat{F}\\) converge a \\(F\\) cuando el tamaño de muestra \\(n\\to\\infty\\), lo cual es intuitivamente claro. Ejemplo En el ejemplo de tomadores de té, podemos estimar la proporción de tomadores de té que prefiere el té negro usando nuestra muestra: te <- read_csv("data/tea.csv") |> rowid_to_column() |> select(rowid, Tea, sugar) te |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro), .groups = "drop") ## # A tibble: 1 × 2 ## prop_negro n ## <dbl> <int> ## 1 0.247 300 ¿Cómo evaluamos la precisión de este estimador? Supondremos que el estudio se hizo tomando una muestra aleatoria simple de tamaño 300 de la población de tomadores de té que nos interesa. Podemos entonces usar el bootstrap: # paso 1: define el estimador calc_estimador <- function(datos){ prop_negro <- datos |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro), .groups = "drop") |> pull(prop_negro) prop_negro } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador prop_negro_tbl <- tibble(prop_negro = map_dbl(1:10000, ~ calc_estimador(muestra_boot(datos = te)))) # paso 4: examina la distribución bootstrap prop_negro_tbl |> ggplot(aes(x = prop_negro)) + geom_histogram(bins = 15) + geom_vline(xintercept = calc_estimador(te), color = "red") Y podemos evaluar varios aspectos, por ejemplo dónde está centrada y qué tan dispersa es la distribución bootstrap: prop_negro_tbl |> summarise(media = mean(prop_negro), ee = sd(prop_negro), cuantil_75 = quantile(prop_negro, 0.75), cuantil_25 = quantile(prop_negro, 0.25), .groups = "drop") |> mutate(across(where(is.numeric), round, 3)) |> pivot_longer(cols = everything()) ## # A tibble: 4 × 2 ## name value ## <chr> <dbl> ## 1 media 0.247 ## 2 ee 0.025 ## 3 cuantil_75 0.263 ## 4 cuantil_25 0.23 –> –> Discusión: propiedades de la distribución bootstrap Uasremos la distribución bootstrap principalmente para evaluar la variabilidad de nuestros estimadores (y también otros aspectos como sesgo) estimando la dispersión de la distribución de muestreo. Sin embargo, es importante notar que no la usamos, por ejemplo, para saber dónde está centrada la distribución de muestreo, o para “mejorar” la estimación remuestreando. Ejemplo En este ejemplo, vemos 20 muestras de tamaño 200, y evaluamos cómo se ve la aproximación a la distribución de la población (rojo): Podemos calcular las distribuciones de remuestreo (bootstrap) para cada muestra, y compararlas con la distribución de muestreo real. # paso 1: define el estimador calc_estimador <- function(datos){ media_precio <- datos |> summarise(media = mean(precio_miles), .groups = "drop") |> pull(media) media_precio } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos, n = NULL){ #tomar muestra con reemplazo del mismo tamaño if(is.null(n)){ m <- slice_sample(datos, prop = 1, replace = TRUE)} else { m <- slice_sample(datos, n = n, replace = TRUE) } m } dist_boot <- datos_sim |> filter(tipo == "muestras") |> select(precio_miles, rep) |> group_by(rep) |> nest() |> mutate(precio_miles = map(data, function(data){ tibble(precio_miles = map_dbl(1:1000, ~ calc_estimador(muestra_boot(data)))) })) |> select(rep, precio_miles) |> unnest() dist_muestreo <- datos_sim |> filter(tipo == "población") |> group_by(rep) |> nest() |> mutate(precio_miles = map(data, function(data){ tibble(precio_miles = map_dbl(1:1000, ~ calc_estimador(muestra_boot(data, n = 200)))) })) |> select(rep, precio_miles) |> unnest() Obsérvese que: En algunos casos la aproximación es mejor que en otros (a veces la muestra tiene valores ligeramente más altos o más bajos). La dispersión de cada una de estas distribuciones bootstrap es similar a la de la verdadera distribución de muestreo (en rojo), pero puede está desplazada dependiendo de la muestra original que utilizamos. Adicionalmente, los valores centrales de la distribución de bootstrap tiende cubrir el verdadero valor que buscamos estimar, que es: poblacion_casas |> summarise(media = mean(precio_miles), .groups = "drop") ## # A tibble: 1 × 1 ## media ## <dbl> ## 1 183. Variación en distribuciones bootstrap En el proceso de estimación bootstrap hay dos fuentes de variación pues: La muestra original se selecciona con aleatoriedad de una población. Las muestras bootstrap se seleccionan con aleatoriedad de la muestra original. Esto es: La estimación bootstrap ideal es un resultado asintótico \\(B=\\infty\\), en esta caso \\(\\hat{\\textsf{se}}_B\\) iguala la estimación plug-in \\(se_{P_n}\\). En el proceso de bootstrap podemos controlar la variación del segundo aspecto, conocida como implementación de muestreo Monte Carlo, y la variación Monte Carlo decrece conforme incrementamos el número de muestras. Podemos eliminar la variación Monte Carlo si seleccionamos todas las posibles muestras con reemplazo de tamaño \\(n\\), hay \\({2n-1}\\choose{n}\\) posibles muestras y si seleccionamos todas obtenemos \\(\\hat{\\textsf{se}}_\\infty\\) (bootstrap ideal), sin embargo, en la mayor parte de los problemas no es factible proceder así. En la siguiente gráfica mostramos 6 posibles muestras de tamaño 50 simuladas de la población, para cada una de ellas se graficó la distribución empírica y se se realizan histogramas de la distribución bootstrap con \\(B=30\\) y \\(B=1000\\), en cada caso hacemos dos repeticiones, notemos que cuando el número de muestras bootstrap es grande las distribuciones bootstrap son muy similares (para una muestra de la población dada), esto es porque disminuimos el erro Monte Carlo. También vale la pena recalcar que la distribución bootstrap está centrada en el valor observado en la muestra (línea azúl punteada) y no en el valor poblacional sin embargo la forma de la distribución es similar a lo largo de las filas. Entonces, ¿cuántas muestras bootstrap? Incluso un número chico de replicaciones bootstrap, digamos \\(B=25\\) es informativo, y \\(B=50\\) con frecuencia es suficiente para dar una buena estimación de \\(se_P(\\hat{\\theta})\\) (Efron and Tibshirani (1993)). Cuando se busca estimar error estándar Chihara and Hesterberg (2018) recomienda \\(B=1000\\) muestras, o \\(B=10,000\\) muestras dependiendo la presición que se busque. Error estándar bootstrap e intervalos normales Ahora podemos construir nuestra primera versión de intervalos de confianza basados en la distribución bootstrap. Supongamos que queremos estimar una cantidad poblacional \\(\\theta\\) con una estadística \\(\\hat{\\theta} = t(X_1,\\ldots, X_n)\\), donde \\(X_1,\\ldots, X_n\\) es una muestra independiente e idénticamente distribuida de la población. Suponemos además que la distribución muestral de \\(\\hat{\\theta}\\) es aproximadamente normal (el teorema central del límite aplica), y está centrada en el verdadero valor poblacional \\(\\theta\\). Ahora queremos construir un intervalo que tenga probabilidad 95% de cubrir al valor poblacional \\(\\theta\\). Tenemos que \\[P(-2\\mathsf{ee}(\\hat{\\theta}) < \\hat{\\theta} - \\theta < 2\\mathsf{ee}(\\hat{\\theta})) \\approx 0.95\\] por las propiedades de la distribución normal (\\(P(-2\\sigma < X -\\mu < 2\\sigma)\\approx 0.95\\) si \\(X\\) es normal con media \\(\\mu\\) y desviación estándar \\(\\sigma\\)). Entonces \\[P(\\hat{\\theta} - 2\\mathsf{ee}(\\hat{\\theta}) < \\theta < \\hat{\\theta} + 2\\mathsf{ee}(\\hat{\\theta})) \\approx 0.95\\] Es decir, la probabilidad de que el verdadero valor poblacional \\(\\theta\\) esté en el intervalo \\[[\\hat{\\theta} - 2\\mathsf{ee}(\\hat{\\theta}), \\hat{\\theta} + 2\\mathsf{ee}(\\hat{\\theta})]\\] es cercano a 0.95. En este intervalo no conocemos el error estándar (es la desviación estándar de la distribución de muestreo de \\(\\hat{\\theta}\\)), y aquí es donde entre la distribución bootstrap, que aproxima la distribución de muestreo. Lo estimamos con \\[\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})\\] que es la desviación estándar de la distribución bootsrap. Definición. El error estándar bootstrap \\(\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})\\) se define como la desviación estándar de la distribución bootstrap de \\(\\theta\\). El intervalo de confianza normal bootstrap al 95% está dado por \\[[\\hat{\\theta} - 2\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta}), \\hat{\\theta} + 2\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})].\\] Nótese que hay varias cosas qué revisar aquí: que el teorema central del límite aplica y que la distribución de muestreo de nuestro estimador está centrado en el valor verdadero. Esto en algunos casos se puede demostrar usando la teoría, pero más abajo veremos comprobaciones empíricas. Ejemplo: tomadores de té negro Consideremos la estimación que hicimos de el procentaje de tomadores de té que toma té negro: # paso 1: define el estimador calc_estimador <- function(datos){ prop_negro <- datos |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro)) |> pull(prop_negro) prop_negro } prop_hat <- calc_estimador(te) prop_hat |> round(2) ## [1] 0.25 Podemos graficar su distribución bootstrap —la cual simulamos arriba—. g_hist <- ggplot(prop_negro_tbl, aes(x = prop_negro)) + geom_histogram(bins = 15) g_qq_normal <- ggplot(prop_negro_tbl, aes(sample = prop_negro)) + geom_qq() + geom_qq_line(colour = "red") g_hist + g_qq_normal Y notamos que la distribución bootstrap es aproximadamente normal. Adicionalmente, vemos que el sesgo tiene un valor estimado de: media_boot <- prop_negro_tbl |> pull(prop_negro) |> mean() media_boot - prop_hat ## [1] 0.0004393333 De esta forma, hemos verificado que: La distribución bootstrap es aproximadamente normal (ver gráfica de cuantiles normales); La distribución bootstrap es aproximadamente insesgada. Lo cual nos lleva a construir intervalos de confianza basados en la distribución normal. Estimamos el error estándar con la desviación estándar de la distribución bootstrap ee_boot <- prop_negro_tbl |> pull(prop_negro) |> sd() ee_boot ## [1] 0.02485138 y construimos un intervalo de confianza del 95%: intervalo_95 <- c(prop_hat - 2 * ee_boot, prop_hat + 2 * ee_boot) intervalo_95 |> round(2) ## [1] 0.2 0.3 Este intervalo tiene probabilidad del 95% de capturar al verdadero poblacional. Con alta probabilidad, entonces, el porcentaje de tomadores de té en la población está entre 0.2 y 0.3. Ejemplo: inventario de casas vendidas Ahora consideremos el problema de estimar el total del valor de las casas vendidas en un periodo. Tenemos una muestra de tamaño \\(n=150\\): # muestra original set.seed(121) muestra_casas <- slice_sample(poblacion_casas, n = 150) # paso 1: define el estimador calc_estimador_casas <- function(datos){ N <- nrow(poblacion_casas) n <- nrow(datos) total_muestra <- sum(datos$precio_miles) estimador_total <- (N / n) * total_muestra estimador_total } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador totales_boot <- tibble(total_boot = map_dbl(1:5000, ~ calc_estimador_casas(muestra_boot(muestra_casas)))) # paso 4: examina la distribución bootstrap g_hist <- totales_boot |> ggplot(aes(x = total_boot)) + geom_histogram() g_qq <- totales_boot |> ggplot(aes(sample = total_boot)) + geom_qq() + geom_qq_line(colour = "red") + geom_hline(yintercept = quantile(totales_boot$total_boot, 0.975), colour = "gray") + geom_hline(yintercept = quantile(totales_boot$total_boot, 0.025), colour = "gray") g_hist + g_qq En este caso, distribución de muestreo presenta cierta asimetría, pero la desviación no es grande. En la parte central la aproximación normal es razonable. Procedemos a revisar sesgo total_est <- calc_estimador_casas(muestra_casas) sesgo <- mean(totales_boot$total_boot) - total_est sesgo ## [1] 110.0851 Este número puede parecer grande, pero sí calculamos la desviación relativa con respecto al error estándar vemos que es chico en la escala de la distribución bootstrap: ee_boot <- sd(totales_boot$total_boot) sesgo_relativo <- sesgo / ee_boot sesgo_relativo ## [1] 0.01522088 De forma que procedemos a construir intervalos de confianza como sigue : c(total_est - 2*ee_boot, total_est + 2*ee_boot) ## [1] 203366.6 232296.6 Que está en miles de dólares. En millones de dólares, este intervalo es: intervalo_total <- c(total_est - 2*ee_boot, total_est + 2*ee_boot) / 1000 intervalo_total |> round(1) ## [1] 203.4 232.3 Así que con 95% de confianza el verdadero total del valor de las casas vendidas está entre 203 y 232 millones de dólares. Nota: en este ejemplo mostraremos una alternativa de intervalos de confianza que es más apropiado cuando observamos asimetría. Sin embargo, primero tendremos que hablar de dos conceptos clave con respecto a intervalos de confianza: calibración e interpretación. Calibración de intervalos de confianza ¿Cómo sabemos que nuestros intervalos de confianza del 95% nominal tienen cobertura real de 95%? Es decir, tenemos que checar: El procedimiento para construir intervalos debe dar intervalos tales que el valor poblacional está en el intervalo de confianza para 95% de las muestras. Como solo tenemos una muestra, la calibración depende de argumentos teóricos o estudios de simulación previos. Para nuestro ejemplo de casas tenemos la población, así que podemos checar qué cobertura real tienen los intervalos normales: simular_intervalos <- function(rep, size = 150){ muestra_casas <- slice_sample(poblacion_casas, n = size) N <- nrow(poblacion_casas) n <- nrow(muestra_casas) total_est <- (N / n) * sum(muestra_casas$precio_miles) # paso 1: define el estimador calc_estimador_casas <- function(datos){ total_muestra <- sum(datos$precio_miles) estimador_total <- (N / n) * total_muestra estimador_total } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador totales_boot <- map_dbl(1:2000, ~ calc_estimador_casas(muestra_boot(muestra_casas))) |> tibble(total_boot = .) |> summarise(ee_boot = sd(total_boot)) |> mutate(inf = total_est - 2*ee_boot, sup = total_est + 2*ee_boot) |> mutate(rep = rep) totales_boot } # Para recrear, correr: # sims_intervalos <- map(1:100, ~ simular_intervalos(rep = .x)) # write_rds(sims_intervalos, "cache/sims_intervalos.rds") # Para usar resultados en cache: sims_intervalos <- read_rds("cache/sims_intervalos.rds") total <- sum(poblacion_casas$precio_miles) sims_tbl <- sims_intervalos |> bind_rows() |> mutate(cubre = inf < total & total < sup) ggplot(sims_tbl, aes(x = rep)) + geom_hline(yintercept = total, colour = "red") + geom_linerange(aes(ymin = inf, ymax = sup, colour = cubre)) La cobertura para estos 100 intervalos simulados da total <- sum(poblacion_casas$precio_miles) sims_tbl |> summarise(cobertura = mean(cubre)) ## # A tibble: 1 × 1 ## cobertura ## <dbl> ## 1 0.96 que es consistente con una cobertura real del 95% (¿qué significa “consistente”? ¿Cómo puedes checarlo con el bootstrap?) Observación. En este caso teníamos la población real, y pudimos verificar la cobertura de nuestros intervalos. En general no la tenemos. Estos ejercicios de simulación se pueden hacer con poblaciones sintéticas que se generen con las características que creemos va a tener nuestra población (por ejemplo, sesgo, colas largas, etc.). En general, no importa qué tipo de estimadores o intervalos de confianza usemos, requerimos checar la calibración. Esto puede hacerse con ejercicios de simulación con poblaciones sintéticas y tanto los procedimientos de muestreo como los tamaños de muestra que nos interesa usar. Verificar la cobertura de nuestros intervalos de confianza por medio simulación está bien estudiado para algunos casos. Por ejemplo, cuando trabajamos con estimaciones para poblaciones teóricas. En general sabemos que los procedimientos funcionan bien en casos: con distribuciones simétricas que tengan colas no muy largas; estimación de proporciones donde no tratamos con casos raros o casos seguros (probabilidades cercanas a 0 o 1). Interpretación de intervalos de confianza Como hemos visto, “intervalo de confianza” (de 90% de confianza, por ejemplo) es un término frecuentista, que significa: Cada muestra produce un intervalo distinto. Para el 90% de las muestras posibles, el intervalo cubre al valor poblacional. La afirmación es sobre el intervalo y el mecanismo para construirlo. Así que con alta probabilidad, el intervalo contiene el valor poblacional. Intervalos más anchos nos dan más incertidumbre acerca de dónde está el verdadero valor poblacional (y al revés para intervalos más angostos). Existen también “intervalos de credibilidad” (de 90% de probabilidad, por ejemplo), que se interpetan de forma bayesiana: Con 90% de probabilidad (relativamente alta), creemos que el valor poblacional está dentro del intervalo de credibilidad. Esta última interpretación es más natural. Obsérvese que para hablar de intervalos de confianza frecuentista tenemos que decir: Este intervalo particular cubre o no al verdadero valor, pero nuestro procedimiento produce intervalos que contiene el verdadero valor para el 90% de las muestras. Esta es una interpretación relativamente débil, y muchos intervalos poco útiles pueden satisfacerla. La interpretación bayesiana es más natural porque expresa más claramente incertidumbre acerca del valor poblacional. Por otro lado, La interpretación frecuentista nos da maneras empíricas de probar si los intervalos de confianza están bien calibrados o no: es un mínimo que “intervalos del 90%” deberían satisfacer. Así que tomamos el punto de vista bayesiano en la intepretación, pero buscamos que nuestros intervalos cumplan o aproximen bien garantías frecuentistas (discutimos esto más adelante). Los intervalos que producimos en esta sección pueden interpretarse de las dos maneras. Sesgo Notemos que hemos revisado el sesgo en varias ocasiones, esto es porque algunos estimadores comunes (por ejemplo, cociente de dos cantidades aleatorias) pueden sufrir de sesgo grande, especialmente en el caso de muestras chicas. Esto a su vez afecta la cobertura, pues es posible que nuestros intervalos no tengan “cobertura simétrica”, por ejemplo. Para muchos estimadores, y muestras no muy chicas, esté sesgo tiende a ser poco importante y no es necesario hacer correcciones. Si el tamaño del sesgo es grande comparado con la dispersión de la distribución bootstrap generalmente consideramos que bajo el diseño actual el estimador que estamos usando no es apropiado, y podemos proponer otro estimador u otro procedimiento para construir intervalos (ver Efron and Tibshirani (1993) intervalos BC_{a}), Efron and Tibshirani (1993) sugieren más de 20% de la desviación estándar, mientras que en Chihara and Hesterberg (2018) se sugiere 2% de la desviación estándar. Dependiendo que tan crítico es que los intervalos estén bien calibrados podemos evaluar nuestro problema particular. Intervalos bootstrap de percentiles Retomemos nuestro ejemplo del valor total del precio de las casas. A través de remuestras bootstrap hemos verificado gráficamente que la distribución de remuestreo es ligeramente asimétrica (ver la figura de abajo). Anteriormente hemos calculado intervalos de confianza basados en supuestos normales por medio del error éstandar. Este intervalo está dado por ## [1] 203.4 232.3 y por construcción sabemos que es simétrico con respecto al valor estimado, pero como podemos ver la distribución de muestreo no es simétrica, lo cual podemos confirmar por ejemplo calculando el porcentaje de muestras bootstrap que caen por arriba y por debajo del intervalo construido: ## # A tibble: 1 × 2 ## prop_inf prop_sup ## <dbl> <dbl> ## 1 0.0192 0.026 los cuales se han calculado como el porcentaje de medias bootstrap por debajo (arriba) de la cota inferior (superior), y vemos que no coinciden con el nivel de confianza prestablecido (2.5% para cada extremo). Otra opción común que se usa específicamente cuando la distribución bootstrap no es muy cercana a la normal son los intervalos de percentiles bootstrap: Definición. El intervalo de percentiles bootstrap al 95% de confianza está dado por \\[[q_{0.025}, q_{0.975}]\\] donde \\(q_f\\) es el percentil \\(f\\) de la distribución bootstrap. Otros intervalos comunes son el de 80% o 90% de confianza, por ejemplo, que corresponden a \\([q_{0.10}, q_{0.90}]\\) y \\([q_{0.05}, q_{0.95}]\\). Ojo: intervalos de confianza muy alta (por ejemplo 99.5%) pueden tener mala calibración o ser muy variables en su longitud pues dependen del comportamiento en las colas de la distribución. Para el ejemplo de las casas, calcularíamos simplemente intervalo_95 <- totales_boot |> pull(total_boot) |> quantile(probs = c(0.025, 0.975)) / 1000 (intervalo_95) |> round(1) ## 2.5% 97.5% ## 204.3 232.5 que está en millones de dólares. Nótese que es similar al intervalo de error estándar. Otro punto interesante sobre los intervalos bootstrap de percentiles es que lidian naturalmente con la asímetría de la distribución bootstrap. Ilustramos esto con la distancia de las extremos del intervalo con respecto a la media: abs(intervalo_95 - total_est/1000) ## 2.5% 97.5% ## 13.53912 14.64674 Los intervalos de confianza nos permiten presentar un rango de valores posibles para el parámetro de interés. Esto es una notable diferencia con respecto a presentar sólo un candidato como estimador. Nuestra fuente de información son los datos. Es por esto que si vemos valores muy chicos (grandes) en nuestra muestra, el intervalo se tiene que extender a la izquierda (derecha) para compensar dichas observaciones. Explica por qué cuando la aproximación normal es apropiada, el intervalo de percentiles al 95% es muy similar al intervalo normal de 2 errores estándar. Ejemplo Consideramos los datos de propinas. Queremos estimar la media de cuentas totales para la comida y la cena. Podemos hacer bootstrap de cada grupo por separado: # en este ejemplo usamos rsample, pero puedes # escribir tu propio código library(rsample) propinas <- read_csv("data/propinas.csv") estimador <- function(split, ...){ muestra <- analysis(split) |> group_by(momento) muestra |> summarise(estimate = mean(cuenta_total), .groups = 'drop') |> mutate(term = momento) } intervalo_propinas_90 <- bootstraps(propinas, strata = momento, 1000) |> mutate(res_boot = map(splits, estimador)) |> int_pctl(res_boot, alpha = 0.10) |> mutate(across(where(is.numeric), round, 2)) intervalo_propinas_90 ## # A tibble: 2 × 6 ## term .lower .estimate .upper .alpha .method ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> ## 1 Cena 19.8 20.8 22.0 0.1 percentile ## 2 Comida 15.6 17.1 18.8 0.1 percentile Nota: .estimate es la media de los valores de la estadística sobre las remuestras, no es el estimador original. De la tabla anterior inferimos que la media en la cuenta en la cena es más grande que la de la comida. Podemos graficar agregando los estimadores plugin: estimadores <- propinas |> group_by(momento) |> rename(term = momento) |> summarise(media = mean(cuenta_total)) ggplot(intervalo_propinas_90, aes(x = term)) + geom_linerange(aes(ymin = .lower, ymax = .upper)) + geom_point(data = estimadores, aes(y = media), colour = "red", size = 3) + xlab("Momento") + ylab("Media de cuenta total (dólares)") + labs(subtitle = "Intervalos de 90% para la media") Nótese que el bootstrap lo hicimos por separado en cada momento del día (por eso el argumento strata en la llamada a bootstraps): Justifica el procedimiento de hacer el bootstrap separado para cada grupo. ¿Qué supuestos acerca del muestreo se deben satisfacer? ¿Deben ser muestras aleatorias simples de cada momento del día, por ejemplo? ¿Qué harías si no fuera así, por ejemplo, si se escogieron al azar tickets de todos los disponibles en un periodo? Bootstrap para dos muestras En el ejemplo anterior consideramos cómo hacer bootstrap cuando tenemos muestras independientes. También podemos aplicarlo a estimadores que comparen directamente las dos muestras: Bootstrap para comparar poblaciones. Dadas muestras independientes de tamaños \\(m\\) y \\(n\\) de dos poblaciones: Extraer una remuestra de tamaño \\(m\\) con reemplazo de la primera muestra y una remuestra separada de tamaño \\(n\\) de la segunda muestra. Calcula la estadística que compara los dos grupos (por ejemplo, diferencia de medias) Repetir este proceso muchas veces (por ejemplo, 1000 - 10000). Construir la distribución bootstrap de la estadística. Examinar dispersión, sesgo y forma. Ejemplo Supongamos que queremos comparar directamente la media de la cuenta total en comida y cena. Podemos hacer: estimador_dif <- function(split, ...){ muestra <- analysis(split) |> group_by(momento) muestra |> summarise(estimate = mean(cuenta_total), .groups = "drop") |> pivot_wider(names_from = momento, values_from = estimate) |> mutate(estimate = Cena - Comida, term = "diferencia") } dist_boot <- bootstraps(propinas, strata = momento, 2000) |> mutate(res_boot = map(splits, estimador_dif)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) + xlab("Diferencia Comida vs Cena") g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 Y podemos calcular un intervalo de confianza para la diferencia de medias: dist_boot |> int_pctl(res_boot, alpha = 0.01) |> mutate(across(where(is.numeric), round, 2)) |> select(term, .lower, .upper) ## # A tibble: 1 × 3 ## term .lower .upper ## <chr> <dbl> <dbl> ## 1 diferencia 0.73 6.54 Que nos indica que con alta probabilidad las cuentas son más altas que en la cena que en la comida. La diferencia puede ir de un poco menos de un dólar hasta seis dólares con 99% de confianza. Datos pareados En otros casos, las muestras no son independientes y están pareadas. Por ejemplo, este es un estudio dende a 10 personas una noche se les dio una medicina para dormir y otra noche otra medicina. Se registraron cuántas horas de sueño extra comparados con un día donde no tomaron medicina. dormir <- sleep |> pivot_wider(names_from = group, names_prefix = "medicina_", values_from = extra) dormir ## # A tibble: 10 × 3 ## ID medicina_1 medicina_2 ## <fct> <dbl> <dbl> ## 1 1 0.7 1.9 ## 2 2 -1.6 0.8 ## 3 3 -0.2 1.1 ## 4 4 -1.2 0.1 ## 5 5 -0.1 -0.1 ## 6 6 3.4 4.4 ## 7 7 3.7 5.5 ## 8 8 0.8 1.6 ## 9 9 0 4.6 ## 10 10 2 3.4 En este caso, el bootstrap se hace sobre individuos, y quisiéramos comparar la medición de la medicina_1 con la medicina_2. Usaremos la media de al diferencia entre horas de sueño entre las dos medicinas. Nuestro estimador puntual es: estimador_dif <- dormir |> mutate(dif_2_menos_1 = medicina_2 - medicina_1) |> summarise(dif_media = mean(dif_2_menos_1)) estimador_dif ## # A tibble: 1 × 1 ## dif_media ## <dbl> ## 1 1.58 Esto indica que en promedio duermen hora y media más con la medicina 2 que con la medicina 1. Como hay variabilildad considerable en el número de horas extra de cada medicina dependiendo del individuo, es necesario hacer una intervalo de confianza para descartar que esta diferencia haya aparecido por azar debido a la variación muestral. Nótese que aquí no tenemos estratos, pues solo hay una muestra de individuo con dos mediciones. estimador_dif <- function(split, ...){ muestra <- analysis(split) muestra |> mutate(dif_2_menos_1 = medicina_2 - medicina_1) |> summarise(estimate = mean(dif_2_menos_1), .groups = "drop") |> mutate(term = "diferencia 2 vs 1") } dist_boot <- bootstraps(dormir, 2000) |> mutate(res_boot = map(splits, estimador_dif)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 Nuestro intervalo de percentiles al 90% es de dist_boot |> int_pctl(res_boot, 0.10) ## # A tibble: 1 × 6 ## term .lower .estimate .upper .alpha .method ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> ## 1 diferencia 2 vs 1 1.04 1.57 2.22 0.1 percentile Lo que indica con alta probabilidad que la medicina 2 da entre 1 y 2 horas extras de sueño. Nota que en este ejemplo también podríamos hacer una prueba de hipótesis por permutaciones, suponiendo como hipótesis nula que las dos medicinas son equivalentes. Sin embargo, usualmente es más informativo presentar este tipo de intervalos para estimar la diferencia. Bootstrap y otras estadísticas El bootstrap es una técnica versátil. Un ejemplo son estimadores de razón, que tienen la forma \\[ \\hat{r} = \\frac{\\overline y}{\\overline x}\\] Por ejemplo, ¿cómo haríamos estimación para el procentaje de área area habitable de las casas en relación al tamaño del lote? Una manera de estimar esta cantidad es dividiendo la suma del área habitable de nuestra muestra y dividirlo entre la suma del área de los lotes de nuestra muestra, como en la fórmula anterior. Esta fórmula es más difícil pues tanto numerador como denominador tienen variabilidad, y estas dos cantidades no varían independientemente. Con el bootstrap podemos atacar estos problemas Ejemplo: estimadores de razón Nuestra muestra original es: set.seed(250) casas_muestra <- slice_sample(poblacion_casas, n = 200) El estimador de interés es: estimador_razon <- function(split, ...){ muestra <- analysis(split) muestra |> summarise(estimate = sum(area_habitable_sup_m2) / sum(area_lote_m2), .groups = "drop") |> mutate(term = "% area del lote construida") } Y nuestra estimación puntual es estimacion <- muestra_casas |> summarise(estimate = sum(area_habitable_sup_m2) / sum(area_lote_m2)) estimacion ## # A tibble: 1 × 1 ## estimate ## <dbl> ## 1 0.148 Es decir que en promedio, un poco más de 15% del lote total es ocupado por área habitable. Ahora hacemos bootstrap para construir un intervalo: dist_boot <- bootstraps(casas_muestra, 2000) |> mutate(res_boot = map(splits, estimador_razon)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 En este caso la cola derecha parece tener menos dispersión que una distribución normal. Usamos un intervalo de percentiles para obtener: dist_boot |> int_pctl(res_boot) |> mutate(estimador = estimacion$estimate) |> rename(media_boot = .estimate) |> mutate(bias = media_boot - estimador) |> pivot_longer(is_double) |> mutate(value = round(value, 3)) ## # A tibble: 6 × 4 ## term .method name value ## <chr> <chr> <chr> <dbl> ## 1 % area del lote construida percentile .lower 0.121 ## 2 % area del lote construida percentile media_boot 0.142 ## 3 % area del lote construida percentile .upper 0.159 ## 4 % area del lote construida percentile .alpha 0.05 ## 5 % area del lote construida percentile estimador 0.148 ## 6 % area del lote construida percentile bias -0.006 De modo que en esta zona, entre 12% y 16% de toda el área disponible es ocupada por área habitable: estas son casas que tienen jardines o terrenos, garage relativamente grandes. Ejemplo: suavizadores Podemos usar el bootstrap para juzgar la variabilidad de un suavizador, que consideramos como nuestra estadística: graf_casas <- function(data){ ggplot(data |> filter(calidad_gral < 7), aes(x = area_habitable_sup_m2)) + geom_point(aes(y = precio_m2_miles), alpha = 0.75) + geom_smooth(aes(y = precio_m2_miles), method = "loess", span = 0.7, se = FALSE, method.args = list(degree = 1, family = "symmetric")) } graf_casas(casas_muestra) Podemos hacer bootstrap para juzgar la estabilidad del suavizador: suaviza_boot <- function(x, data){ # remuestreo muestra_boot <- slice_sample(data, prop = 1, replace = T) ajuste <- loess(precio_m2_miles ~ area_habitable_sup_m2, data = muestra_boot, degree = 1, span = 0.7, family = "symmetric") datos_grafica <- tibble(area_habitable_sup_m2 = seq(25, 250, 5)) ajustados <- predict(ajuste, newdata = datos_grafica) datos_grafica |> mutate(ajustados = ajustados) |> mutate(rep = x) } reps <- map(1:10, ~ suaviza_boot(.x, casas_muestra |> filter(calidad_gral < 7))) |> bind_rows() # ojo: la rutina loess no tienen soporte para extrapolación graf_casas(casas_muestra) + geom_line(data = reps, aes(y = ajustados, group = rep), alpha = 1, colour = "red") Donde vemos que algunas cambios de pendiente del suavizador original no son muy interpretables (por ejemplo, para áreas chicas) y alta variabilidad en general en los extremos. Podemos hacer más iteraciones para calcular bandas de confianza: reps <- map(1:200, ~ suaviza_boot(.x, casas_muestra |> filter(calidad_gral < 7))) |> bind_rows() # ojo: la rutina loess no tienen soporte para extrapolación graf_casas(casas_muestra) + geom_line(data = reps, aes(y = ajustados, group = rep), alpha = 0.2, colour = "red") Donde observamos cómo tenemos incertidumbre en cuanto al nivel y forma de las curvas en los extremos de los datos (casas grandes y chicas), lo cual es natural. Aunque podemos resumir para hacer bandas de confianza, mostrar remuestras de esta manera es informativo: por ejempo: vemos cómo es probable también que para casas de menos de 70 metros cuadrados el precio por metro cuadrado no cambia tanto (líneas constantes) Bootstrap y estimadores complejos: tablas de perfiles Podemos regresar al ejemplo de la primera sesión donde calculamos perfiles de los tomadores de distintos tés: en bolsa, suelto, o combinados. Caundo hacemos estos tipos de análisis no es raro que los prefiles tengan variabilidad considerable que es necesario cuantificar. price tea bag tea bag+unpackaged unpackaged promedio p_upscale -0.71 -0.28 0.98 28 p_variable -0.12 0.44 -0.31 36 p_cheap 0.3 -0.53 0.23 2 p_branded 0.62 -0.16 -0.45 25 p_private label 0.72 -0.22 -0.49 5 p_unknown 1.58 -0.58 -1 3 Hacemos bootstrap sobre toda la muestra, y repetimos exactamente el mismo proceso de construción de perfiles: boot_perfiles <- map(1:1000, function(x){ te_boot <- te |> slice_sample(prop = 1, replace = TRUE) calcular_perfiles(te_boot) |> mutate(rep = x) }) |> bind_rows() Ahora resumimos y graficamos, esta vez de manera distinta: resumen_perfiles <- boot_perfiles |> group_by(how, price) |> summarise(perfil_media = mean(perfil), ymax = quantile(perfil, 0.9), ymin = quantile(perfil, 0.10)) resumen_bolsa <- resumen_perfiles |> ungroup() |> filter(how == "tea bag") |> select(price, perfil_bolsa = perfil_media) resumen_perfiles <- resumen_perfiles |> left_join(resumen_bolsa) |> ungroup() |> mutate(price = fct_reorder(price, perfil_bolsa)) ggplot(resumen_perfiles, aes(x = price, y = perfil_media, ymax = ymax, ymin = ymin)) + geom_point(colour = "red") + geom_linerange() + facet_wrap(~how) + coord_flip() + geom_hline(yintercept = 0, colour = "gray") + ylab("Perfil") + xlab("Precio") Nótese una deficiencia clara del bootstrap: para los que compran té suelto, en la muestra no existen personas que desconocen de dónde provienen su té (No sabe/No contestó). Esto produce un intervalo colapsado en 0 que no es razonable. Podemos remediar esto de varias maneras: quitando del análisis los que no sabe o no contestaron, agrupando en otra categoría, usando un modelo, o regularizar usando proporciones calculadas con conteos modificados: por ejemplo, agregando un caso de cada combinación (agregaría 18 personas “falsas” a una muestra de 290 personas). Bootstrap y muestras complejas La necesidad de estimaciones confiables junto con el uso eficiente de recursos conllevan a diseños de muestras complejas. Estos diseños típicamente usan las siguientes técnicas: muestreo sin reemplazo de una población finita, muestreo sistemático, estratificación, conglomerados, ajustes a no-respuesta, postestratificación. Como consecuencia, los valores de la muestra suelen no ser independientes y los análisis de los mismos dependerá del diseño de la muestra. Comenzaremos con definiciones para entender el problema. set.seed(3872999) n_escuelas <- 5000 tipo <- sample(c("rural", "urbano", "indigena"), n_escuelas, replace = TRUE, prob = c(0.3, 0.5, 0.2)) escuela <- tibble(ind_escuela = 1:n_escuelas, tipo, media_tipo = case_when(tipo == "urbano" ~ 550, tipo == "rural" ~ 400, TRUE ~ 350), media_escuela = rnorm(n_escuelas, media_tipo, 30), n_estudiantes = round(rnorm(n_escuelas, 30, 4))) estudiantes <- uncount(escuela, n_estudiantes, .id = "id_estudiante") %>% rowwise() %>% mutate(calif = rnorm(1, media_escuela, 70)) %>% ungroup() Imaginemos que tenemos una población de 5000 escuelas, y queremos estimar la media de las calificaciones de los estudiantes en una prueba. head(estudiantes) ## # A tibble: 6 × 6 ## ind_escuela tipo media_tipo media_escuela id_estudiante calif ## <int> <chr> <dbl> <dbl> <int> <dbl> ## 1 1 urbano 550 561. 1 488. ## 2 1 urbano 550 561. 2 574. ## 3 1 urbano 550 561. 3 456. ## 4 1 urbano 550 561. 4 507. ## 5 1 urbano 550 561. 5 598. ## 6 1 urbano 550 561. 6 527. La primera idea sería tomar una muestra aleatoria (MAS, muestreo aleatorio simple), donde todos los estudiantes tienen igual probabilidad de ser seleccionados. Con estas condiciones el presupuesto alcanza para seleccionar a 60 estudiantes, hacemos esto y calculamos la media. muestra <- slice_sample(estudiantes, n = 60) round(mean(muestra$calif), 2) ## [1] 466.73 Este número es muy cercano a la media verdadera de la población: 466.51, pero esta es una de muchas posibles muestras. medias_mas <- rerun(1000, mean(sample(estudiantes$calif, 60))) %>% flatten_dbl() sd(medias_mas) ## [1] 14.75242 hist_mas <- ggplot(tibble(medias_mas), aes(x = medias_mas)) + geom_histogram(binwidth = 10) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_mas <- ggplot(tibble(medias_mas), aes(sample = medias_mas)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_mas + qq_mas Algunas de las muestras generan valores alejados de la verdadera media, para minimizar la probabilidad de seleccionar muestras que lleven a estimaciones alejadas del verdadero valor poblacional podríamos tomar muestras más grandes. Pero usualmente los costos limitan el tamaño de muestra. Una alternativa es estratificar, supongamos que sabemos el tipo de cada escuela (urbana, rural o indígena) y sabemos también que la calificación de los estudiantes de escuelas urbanas tiende a ser distinta a las calificaciones que los estudiantes de escuelas rurales o indígenas. En esta caso un diseño más eficiente consiste en tomar muestras independientes dentro de cada estrato. muestra_estrat <- estudiantes %>% group_by(tipo) %>% sample_frac(0.0004) dim(muestra_estrat) ## [1] 60 6 muestrea_estrat <- function(){ muestra <- estudiantes %>% group_by(tipo) %>% sample_frac(0.0004) mean(muestra$calif) } medias_estrat <- rerun(1000, muestrea_estrat()) %>% flatten_dbl() Notamos que la distribución muestral está más concentrada que el caso de MAS, el error estándar se reduce de 14.75 a 10.2 hist_estrat <- ggplot(tibble(medias_estrat), aes(x = medias_estrat)) + geom_histogram(binwidth = 6) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_estrat <- ggplot(tibble(medias_estrat), aes(sample = medias_estrat)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_estrat + qq_estrat Entonces, la estratificación nos sirve para reducir el error estándar de las estimaciones. Otro procedimiento común en muestreo es introducir conglomerados, a diferencia del muestreo estratificado, el propósito principal de los conglomerados es reducir costos. Veamos cuantas escuelas tendría que visitar en una muestra dada (con diseño estratificado). n_distinct(muestra_estrat$ind_escuela) ## [1] 60 Es fácil ver que visitar una escuela para aplicar solo uno o dos exámenes no es muy eficiente en cuestión de costos. Es por ello que se suelen tomar muestras considerando conglomerados naturales, en este caso la escuela. En nuestro ejemplo es razonable suponer que una parte grande del costo del muestreo sea mandar al examinador a la escuela, y que una vez en la escuela el costo de evaluar a todo sexto, en lugar de a un único alumno, es relativamente bajo. Podemos imaginar que considerando estos costos por visita de escuela nos alcance para visitar 40 escuelas y en cada una examinar a todos los estudiantes. muestra_escuelas <- escuela %>% group_by(tipo) %>% sample_frac(size = 0.008) muestra_cgl <- muestra_escuelas %>% left_join(estudiantes) mean(muestra_cgl$calif) ## [1] 462.5677 muestrea_cgl <- function(){ muestra_escuelas <- escuela %>% group_by(tipo) %>% sample_frac(size = 0.008) muestra_cgl <- muestra_escuelas %>% left_join(estudiantes, by = c("ind_escuela", "tipo")) mean(muestra_cgl$calif) } medias_cgl <- rerun(1000, muestrea_cgl()) %>% flatten_dbl() En este caso, el número de estudiantes examinados es mucho mayor que en MAS y muestreo estratificado, notemos que el número de estudiantes evaluados cambiará de muestra a muestra dependiendo del número de alumnos en las escuelas seleccionadas. sd(medias_cgl) ## [1] 5.337327 hist_cgl <- ggplot(tibble(medias_cgl), aes(x = medias_cgl)) + geom_histogram(binwidth = 6) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_cgl <- ggplot(tibble(medias_cgl), aes(sample = medias_cgl)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_cgl + qq_cgl Ejemplo: ENIGH La complejidad de los diseños de encuestas conlleva a que el cálculo de errores estándar sea muy complicado, para atacar este problema hay dos técnicas básicas: 1) un enfoque analítico usando linearización, 2) métodos de remuestreo como bootstrap. El incremento en el poder de cómputo ha favorecido los métodos de remuestreo pues la linearización requiere del desarrollo de una fórmula para cada estimación y supuestos adicionales para simplificar. En 1988 Rao and Wu (1988) propusieron un método de bootstrap para diseños estratificados multietápicos con reemplazo de UPMs (Unidades Primarias de Muestreo) que describimos a continuación. ENIGH. Usaremos como ejemplo la Encuesta Nacional de Ingresos y Gastos de los Hogares, ENIGH 2018 (INEGI 2018), esta encuesta usa un diseño de conglomerados estratificado. Antes de proceder a bootstrap debemos entender como se seleccionaron los datos, esto es, el diseño de la muestra: Unidad primaria de muestreo (UPM). Las UPMs están constituidas por agrupaciones de viviendas. Se les denomina unidades primarias pues corresponden a la primera etapa de selección, las unidades secundarias (USMs) serían los hogares. Estratificación. Los estratos se construyen en base a estado, ámbito (urbano, complemento urbano, rural), características sociodemográficas de los habitantes de las viviendas, características físicas y equipamiento. El proceso de estratificación resulta en 888 subestratos en todo el ámbito nacional. La selección de la muestra es independiente para cada estrato, y una vez que se obtiene la muestra se calculan los factores de expansión que reflejan las distintas probabilidades de selección. Después se llevan a cabo ajustes por no respuesta y por proyección (calibración), esta última busca que distintos dominios de la muestra coincidan con la proyección de población de INEGI. concentrado_hogar <- read_csv(here::here("data", "conjunto_de_datos_enigh_2018_ns_csv", "conjunto_de_datos_concentradohogar_enigh_2018_ns", "conjunto_de_datos", "conjunto_de_datos_concentradohogar_enigh_2018_ns.csv")) # seleccionar variable de ingreso corriente hogar <- concentrado_hogar %>% mutate( upm = as.integer(upm), edo = str_sub(ubica_geo, 1, 2) ) %>% select(folioviv, foliohog, est_dis, upm, factor, ing_cor, edad_jefe, edo) %>% group_by(est_dis) %>% mutate(n = n_distinct(upm)) %>% # número de upms por estrato ungroup() hogar ## # A tibble: 74,647 × 9 ## folioviv foliohog est_dis upm factor ing_cor edad_jefe edo n ## <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <chr> <int> ## 1 100013601 1 2 1 175 76404. 74 10 106 ## 2 100013602 1 2 1 175 42988. 48 10 106 ## 3 100013603 1 2 1 175 580698. 39 10 106 ## 4 100013604 1 2 1 175 46253. 70 10 106 ## 5 100013606 1 2 1 175 53837. 51 10 106 ## 6 100026701 1 2 2 189 237743. 41 10 106 ## 7 100026703 1 2 2 189 32607. 57 10 106 ## 8 100026704 1 2 2 189 169918. 53 10 106 ## 9 100026706 1 2 2 189 17311. 30 10 106 ## 10 100027201 1 2 3 186 120488. 69 10 106 ## # ℹ 74,637 more rows Para el cálculo de estadísticos debemos usar los factores de expansión, por ejemplo el ingreso trimestral total sería: sum(hogar$factor * hogar$ing_cor / 1000) ## [1] 1723700566 y ingreso trimestral medio (miles pesos) sum(hogar$factor * hogar$ing_cor / 1000) / sum(hogar$factor) ## [1] 49.61029 La estimación del error estándar, por otro lado, no es sencilla y requiere usar aproximaciones, en la metodología de INEGI proponen una aproximación con series de Taylor. Figure 5.3: Extracto de estimación de errores de muestreo, ENIGH 2018. Veamos ahora como calcular el error estándar siguiendo el bootstrap de Rao y Wu: En cada estrato se seleccionan con reemplazo \\(m_h\\) UPMs de las \\(n_h\\) de la muestra original. Denotamos por \\(m_{hi}^*\\) el número de veces que se seleccionó la UPM \\(i\\) en el estrato \\(h\\) (de tal manera que \\(\\sum m_{hi}^*=m_h\\)). Creamos una replicación del ponderador correspondiente a la \\(k\\)-ésima unidad (USM) como: \\[d_k^*=d_k \\bigg[\\bigg(1-\\sqrt{\\frac{m_h}{n_h - 1}}\\bigg) + \\bigg(\\sqrt{\\frac{m_h}{n_h - 1}}\\frac{n_h}{m_h}m_{h}^*\\bigg)\\bigg]\\] donde \\(d_k\\) es el inverso de la probabilidad de selección. Si \\(m_h <(n_h -1)\\) todos los pesos definidos de esta manera serán no negativos. Calculamos el peso final \\(w_k^*\\) aplicando a \\(d_k^*\\) los mismos ajustes que se hicieron a los ponderadores originales. Calculamos el estadístico de interés \\(\\hat{\\theta}\\) usando los ponderadores \\(w_k^*\\) en lugar de los originales \\(w_k\\). Repetimos los pasos 1 y 2 \\(B\\) veces para obtener \\(\\hat{\\theta}^{*1},\\hat{\\theta}^{*2},...,\\hat{\\theta}^{*B}\\). Calculamos el error estándar como: \\[\\hat{\\textsf{se}}_B = \\bigg\\{\\frac{\\sum_{b=1}^B[\\hat{\\theta}^*(b)-\\hat{\\theta}^*(\\cdot)]^2 }{B}\\bigg\\}^{1/2}\\] En principio podemos elegir cualquier valor de \\(m_h \\geq 1\\), el más común es elegir \\(m_h=n_h-1\\), en este caso: \\[d_k^*=d_k \\frac{n_h}{n_h-1}m_{hi}^*\\] en este escenario las unidades que no se incluyen en la muestra tienen un valor de cero como ponderador. Si elegimos \\(n_h \\ne n_h-1\\) las unidades que no están en la muestra tienen ponderador distinto a cero, si \\(m_h=n_h\\) el ponderador podría tomar valores negativos. Implementemos el bootstrap de Rao y Wu a la ENIGH, usaremos \\(m_h=n_h-1\\) # creamos una tabla con los estratos y upms est_upm <- hogar %>% distinct(est_dis, upm, n) %>% arrange(est_dis, upm) hogar_factor <- est_upm %>% group_by(est_dis) %>% # dentro de cada estrato tomamos muestra (n_h-1) sample_n(size = first(n) - 1, replace = TRUE) %>% add_count(est_dis, upm, name = "m_hi") %>% # calculamos m_hi* left_join(hogar, by = c("est_dis", "upm", "n")) |> mutate(factor_b = factor * m_hi * n / (n - 1)) # unimos los pasos anteriores en una función para replicar en cada muestra bootstrap svy_boot <- function(est_upm, hogar){ m_hi <- est_upm %>% group_split(est_dis) %>% map(~sample(.$upm, size = first(.$n) - 1, replace = TRUE)) %>% flatten_int() %>% plyr::count() %>% select(upm = x, m_h = freq) m_hi %>% left_join(hogar, by = c("upm")) %>% mutate(factor_b = factor * m_h * n / (n - 1)) } set.seed(1038984) boot_rep <- rerun(500, svy_boot(est_upm, hogar)) # Aplicación a ingreso medio wtd_mean <- function(w, x, na.rm = FALSE) { sum(w * x, na.rm = na.rm) / sum(w, na.rm = na.rm) } # La media es: hogar %>% summarise(media = wtd_mean(factor, ing_cor)) ## # A tibble: 1 × 1 ## media ## <dbl> ## 1 49610. Y el error estándar: map_dbl(boot_rep, ~wtd_mean(w = .$factor_b, x = .$ing_cor)) %>% quantile(c(0.025, 0.975)) ## 2.5% 97.5% ## 48742.12 50519.02 El método bootstrap está implementado en el paquete survey y más recientemente en srvyr que es una versión tidy que utiliza las funciones en survey. Podemos comparar nuestros resultados con la implementación en survey. # 1. Definimos el diseño de la encuesta library(survey) library(srvyr) enigh_design <- hogar %>% as_survey_design(ids = upm, weights = factor, strata = est_dis) # 2. Elegimos bootstrap como el método para el cálculo de errores estándar set.seed(7398731) enigh_boot <- enigh_design %>% as_survey_rep(type = "bootstrap", replicates = 500) # 3. Así calculamos la media enigh_boot %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor)) ## # A tibble: 1 × 2 ## mean_ingcor mean_ingcor_se ## <dbl> <dbl> ## 1 49610. 468. enigh_boot %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor, vartype = "ci")) ## # A tibble: 1 × 3 ## mean_ingcor mean_ingcor_low mean_ingcor_upp ## <dbl> <dbl> <dbl> ## 1 49610. 48690. 50530. # por estado enigh_boot %>% group_by(edo) %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor)) ## # A tibble: 30 × 3 ## edo mean_ingcor mean_ingcor_se ## <chr> <dbl> <dbl> ## 1 10 50161. 995. ## 2 11 46142. 1241. ## 3 12 29334. 1063. ## 4 13 38783. 1019. ## 5 14 60541. 1924. ## 6 15 48013. 1359. ## 7 16 42653. 1393. ## 8 17 42973. 1601. ## 9 18 48148. 1967. ## 10 19 68959. 4062. ## # ℹ 20 more rows Resumiendo: El bootstrap de Rao y Wu genera un estimador consistente y aproximadamente insesgado de la varianza de estadísticos no lineales y para la varianza de un cuantil. Este método supone que la seleccion de UPMs es con reemplazo; hay variaciones del estimador bootstrap de Rao y Wu que extienden el método que acabamos de estudiar; sin embargo, es común ignorar este aspecto, por ejemplo Mach et al estudian las propiedades del estimador de varianza bootstrap de Rao y Wu cuando la muestra se seleccionó sin reemplazo. Bootstrap en R Es común crear nuestras propias funciones cuando usamos bootstrap, sin embargo, en R también hay alternativas que pueden resultar convenientes, mencionamos 3: El paquete rsample (forma parte de la colección tidymodels) y tiene una función bootstraps() que regresa un arreglo cuadrangular (tibble, data.frame) que incluye una columna con las muestras bootstrap y un identificador del número y tipo de muestra. Veamos un ejemplo donde seleccionamos muestras del conjunto de datos muestra_computos que contiene 10,000 observaciones. library(rsample) load("data/election_2012.rda") muestra_computos <- slice_sample(election_2012, n = 10000) muestra_computos ## # A tibble: 10,000 × 23 ## state_code state_name state_abbr district_loc_17 district_fed_17 polling_id ## <chr> <chr> <chr> <int> <int> <int> ## 1 18 Nayarit NAY 11 2 86709 ## 2 27 Tabasco TAB 17 5 122035 ## 3 15 México MEX 7 35 75477 ## 4 27 Tabasco TAB 19 5 122262 ## 5 17 Morelos MOR 6 2 84733 ## 6 07 Chiapas CHPS 22 5 15376 ## 7 14 Jalisco JAL 2 2 52634 ## 8 08 Chihuahua CHIH 7 4 19097 ## 9 14 Jalisco JAL 20 20 60549 ## 10 13 Hidalgo HGO 11 4 50221 ## # ℹ 9,990 more rows ## # ℹ 17 more variables: section <int>, region <chr>, polling_type <chr>, ## # section_type <chr>, pri_pvem <int>, pan <int>, panal <int>, ## # prd_pt_mc <int>, otros <int>, total <int>, nominal_list <int>, ## # pri_pvem_pct <dbl>, pan_pct <dbl>, panal_pct <dbl>, prd_pt_mc_pct <dbl>, ## # otros_pct <dbl>, winner <chr> Generamos 100 muestras bootstrap, y la función nos regresa un arreglo con 100 renglones, cada uno corresponde a una muestra bootstrap. set.seed(839287482) computos_boot <- bootstraps(muestra_computos, times = 100) computos_boot ## # Bootstrap sampling ## # A tibble: 100 × 2 ## splits id ## <list> <chr> ## 1 <split [10000/3647]> Bootstrap001 ## 2 <split [10000/3623]> Bootstrap002 ## 3 <split [10000/3724]> Bootstrap003 ## 4 <split [10000/3682]> Bootstrap004 ## 5 <split [10000/3696]> Bootstrap005 ## 6 <split [10000/3716]> Bootstrap006 ## 7 <split [10000/3679]> Bootstrap007 ## 8 <split [10000/3734]> Bootstrap008 ## 9 <split [10000/3632]> Bootstrap009 ## 10 <split [10000/3692]> Bootstrap010 ## # ℹ 90 more rows La columna splits tiene información de las muestras seleccionadas, para la primera vemos que de 10,000 observaciones en la muestra original la primera muestra bootstrap contiene 10000-3647=6353. first_computos_boot <- computos_boot$splits[[1]] first_computos_boot ## <Analysis/Assess/Total> ## <10000/3647/10000> Y podemos obtener los datos de la muestra bootstrap con la función as.data.frame() as.data.frame(first_computos_boot) ## # A tibble: 10,000 × 23 ## state_code state_name state_abbr district_loc_17 district_fed_17 polling_id ## <chr> <chr> <chr> <int> <int> <int> ## 1 07 Chiapas CHPS 13 9 13397 ## 2 14 Jalisco JAL 15 15 58404 ## 3 09 Ciudad de M… CDMX 11 13 26471 ## 4 17 Morelos MOR 7 3 84909 ## 5 25 Sinaloa SIN 11 3 114038 ## 6 11 Guanajuato GTO 16 12 41506 ## 7 29 Tlaxcala TLAX 6 3 128006 ## 8 02 Baja Califo… BC 8 5 3901 ## 9 02 Baja Califo… BC 9 5 3779 ## 10 08 Chihuahua CHIH 19 5 19536 ## # ℹ 9,990 more rows ## # ℹ 17 more variables: section <int>, region <chr>, polling_type <chr>, ## # section_type <chr>, pri_pvem <int>, pan <int>, panal <int>, ## # prd_pt_mc <int>, otros <int>, total <int>, nominal_list <int>, ## # pri_pvem_pct <dbl>, pan_pct <dbl>, panal_pct <dbl>, prd_pt_mc_pct <dbl>, ## # otros_pct <dbl>, winner <chr> Una de las principales ventajas de usar este paquete es que es eficiente en el uso de memoria. library(pryr) object_size(muestra_computos) ## 1.41 MB object_size(computos_boot) ## 5.49 MB # tamaño por muestra object_size(computos_boot)/nrow(computos_boot) ## 54.92 kB # el incremento en tamaño es << 1000 as.numeric(object_size(computos_boot)/object_size(muestra_computos)) ## [1] 3.895024 Adicionalmente incluye funciones para el cálculo de intervalos bootstrap: intervalo_propinas_90 <- bootstraps(propinas, strata = momento, 1000) |> mutate(res_boot = map(splits, estimador)) |> int_pctl(res_boot, alpha = 0.10) El paquete boot está asociado al libro Bootstrap Methods and Their Applications (Davison and Hinkley (1997)) y tiene, entre otras, funciones para calcular replicaciones bootstrap y para construir intervalos de confianza usando bootstrap: calculo de replicaciones bootstrap con la función boot(), intervalos normales, de percentiles y \\(BC_a\\) con la función boot.ci(), intevalos ABC con la función `abc.ci(). El paquete bootstrap contiene datos usados en Efron and Tibshirani (1993), y la implementación de funciones para calcular replicaciones y construir intervalos de confianza: calculo de replicaciones bootstrap con la función bootstrap(), intervalos \\(BC_a\\) con la función bcanon(), intevalos ABC con la función abcnon(). Conclusiones y observaciones El principio fundamental del Bootstrap no paramétrico es que podemos estimar la distribución poblacional con la distribución empírica. Por tanto para hacer inferencia tomamos muestras con reemplazo de la muestra y analizamos la variación de la estadística de interés a lo largo de las remuestras. El bootstrap nos da la posibilidad de crear intervalos de confianza cuando no contamos con fórmulas para hacerlo de manera analítica y sin supuestos distribucionales de la población. Hay muchas opciones para construir intervalos bootstrap, los que tienen mejores propiedades son los intervalos \\(BC_a\\), sin embargo, los más comunes son los intervalos normales con error estándar bootstrap y los intervalos de percentiles de la distribución bootstrap. Antes de hacer intervalos normales vale la pena graficar la distribución bootstrap y evaluar si el supuesto de normalidad es razonable. En cuanto al número de muestras bootstrap se recomienda al menos \\(1,000\\) al hacer pruebas, y \\(10,000\\) o \\(15,000\\) para los resultados finales, sobre todo cuando se hacen intervalos de confianza de percentiles. La función de distribución empírica es una mala estimación en las colas de las distribuciones, por lo que es difícil construir intervalos de confianza (usando bootstrap no paramétrico) para estadísticas que dependen mucho de las colas. O en general para estadísticas que dependen de un número chico de observaciones de una muestra grande. Referencias "],["estimación-por-máxima-verosimilitud.html", "Sección 6 Estimación por máxima verosimilitud Introducción a estimación por máxima verosimilitud Máxima verosimilitud para observaciones continuas Aspectos numéricos Máxima verosimilitud para más de un parámetro", " Sección 6 Estimación por máxima verosimilitud Los ejemplos que hemos visto han sido todos de estimadores plug-in (o por sustitución): si queremos saber una cantidad poblacional, y tenemos una muestra dada, entonces calculamos la estadística de interés como si la muestra fuera la población. Por ejemplo, para estimar la mediana poblacional usamos la mediana muestral, si queremos estimar la media poblacional usamos la media muestral, y así sucesivamente. Estos estimadores usualmente dan resultados razonables (pero hay que checar usando muestra bootstraps, por ejemplo, y pensar lo que estamos haciendo). Cuando sabemos más acerca de la población y usamos un modelo teórico es posible hacer más: dependiendo de qué cantidades se quieren estimar, podemos construir estimadores que sean óptimos en algún sentido siempre y cuando se cumplan los supuestos teóricos, como veremos ahora. Por ejemplo: ¿deberíamos estimar el centro de una distribución simétrica con la media o con la mediana, o quizá con una media recortada? En esta parte construiremos la teoría básica de estimación cuando trabajamos con modelos teóricos conocidos. El objetivo es entender las ideas básicas de estos procedimientos, y cómo evaluar sus resultados. Recordatorio: las ventajas de usar modelos teóricos para describir distribuciones de datos está en que es posible comprimir más eficientemente la información, es posible construir modelos más complejos juntando varios de estos modelos y de sus dependencias, y de que es posible hacer más teoría útil que nos guíe. La desventaja es que es necesario que esos supuestos teóricos sean razonables. Introducción a estimación por máxima verosimilitud Uno de los procedimientos más estándar en esta situación es el método de máxima verosimilitud. Los estimadores de máxima verosimilitud tienen propiedades convenientes, y dan en general resultados razonables siempre y cuando los supuestos sean razonables. Máxima verosimilitud es un proceso intuitivo, y consiste en aprender o estimar valores de parámetros desconocidos suponiendo para los datos su explicación más probable. Para esto, usando supuestos y modelos, requeriremos calcular la probabilidad de un conjunto de observaciones. Ejemplo. Adaptado de (Chihara and Hesterberg 2018). Supongamos que una máquina produce dos tipos de bolsas de 25 galletas: la mitad de las veces produce una bolsa con 5 galletas de avena y 20 de chispas de chocolate, y la otra mitad produce bolsas con 23 galletas de avena y 2 de chispas de chocolate. Tomamos una bolsa, y no sabemos qué tipo de bolsa es (parámetro desconocido). Extraemos al azar una de las galletas, y es de chispas de chocolate (observación). Por máxima verosimilitud, inferimos que la bolsa que estamos considerando tiene 5 galletas de avena. Esto es porque es más probable observar una galleta de chispas en las bolsas que contienen 5 galletas de avena que en las bolsas que contienen 23 galletas de avena. Podemos cuantificar la probabilidad que “acertemos” en nuestra inferencia. Cómo se aprecia en el ejemplo anterior, el esquema general es: Existe un proceso del que podemos obtener observaciones de algún sistema o población real. Tenemos un modelo probabilístico que dice cómo se producen esas observaciones a partir del sistema o población real. Usualmente este modelo tiene algunas cantidades que no conocemos, que rigen el proceso y cómo se relaciona el proceso con las observaciones. Nuestro propósito es: Extraemos observaciones del proceso \\[x_1, x_2, \\ldots, x_n.\\] Queremos aprender de los parámetros desconocidos del proceso para calcular cantidades de interés acerca del sistema o población real En principio, los modelos que consideramos pueden ser complicados y tener varias partes o parámetros. Veamos primero un ejemplo clásico con un solo parámetro, y cómo lo resolveríamos usando máxima verosimilitud. Nota: Cuando decimos muestra en general nos referimos a observaciones independientes obtenidas del mismo proceso (ver la sección de distribución de muestreo) para ver qué significa que sea independientes. Este esquema es un supuesto que simplifica mucho los cálculos, como discutimos antes. Muchas veces este supuesto sale del diseño de la muestra o del estudio, pero en todo caso es importante considerar si es razonable o no para nuestro problema particular. Denotemos por \\(f(x; \\theta)\\) la función de densidad para una variable aleatoria continua con párametro asociado \\(\\theta.\\) Denotamos por \\(X_1, \\ldots, X_n,\\) una muestra aleatoria de \\(n\\) observaciones de esta distribución y por \\(x_1, \\ldots, x_n\\) los valores observados de esta muestra aleatoria. Ejemplo. Supongamos que queremos saber qué proporción de registros de una base de datos tiene algún error menor de captura. No podemos revisar todos los registros, así que tomamos una muestra de 8 registros, escogiendo uno por uno al azar de manera independiente. Revisamos los 8 registros, y obtenemos los siguientes datos: \\[x_1 = 0, x_2 = 1, x_3 = 0, x_4 = 0, x_5 =1, x_6 =0, x_7 =0, x_8 =0\\] donde 1 indica un error menor. Encontramos dos errores menores. ¿Cómo estimamos el número de registros con errores leves en la base de datos? Ya sabemos una respuesta razonable para nuestro estimador puntual, que sería \\(\\hat{p}=2/8=0.25\\). Veamos cómo se obtendría por máxima verosimilitud. Según el proceso con el que se construyó la muestra, debemos dar una probabilidad de observar los 2 errores en 8 registros. Supongamos que en realidad existe una proporción \\(p\\) de que un registro tenga un error. Entonces calculamos Probabilidad de observar la muestra: \\[P(X_1 = 0, X_2 = 1, X_3 = 0, X_4 = 0, X_5 =1, X_6 =0, X_7 =0, X_8 =0)\\] es igual a \\[P(X_1 = 0)P(X_2 = 1)P(X_3 = 0)P( X_4 = 0)P(X_5 =1)P(X_6 =0)P(X_7 =0)P(X_8 =0)\\] pues la probabilidad de que cada observación sea 0 o 1 no depende de las observaciones restantes (la muestra se extrajo de manera independiente). Esta última cantidad tiene un parámetro que no conocemos: la proporcion \\(p\\) de registros con errores. Así que lo denotamos como una cantidad desconocida \\(p\\). Nótese entonces que \\(P(X_2=1) = p\\), \\(P(X_3=0) = 1-p\\) y así sucesivamente, así que la cantidad de arriba es igual a \\[(1-p)p(1-p)(1-p)p(1-p)(1-p)(1-p) \\] que se simplifica a \\[ \\mathcal{L}(p) = p^2(1-p)^6\\] Ahora la idea es encontrar la p que maximiza la probabilidad de lo que observamos. En este caso se puede hacer con cálculo, pero vamos a ver una gráfica de esta función y cómo resolverla de manera numérica. verosimilitud <- function(p){ p^2 * (1-p)^6 } dat_verosim <- tibble(x = seq(0,1, 0.001)) %>% mutate(prob = map_dbl(x, verosimilitud)) ggplot(dat_verosim, aes(x = x, y = prob)) + geom_line() + geom_vline(xintercept = 0.25, color = "red") + xlab("p") Nótese que esta gráfica: Depende de los datos, que pensamos fijos. Cuando cambiamos la \\(p\\), la probabilidad de observar la muestra cambia. Nos interesa ver las regiones donde la probabilidad es relativamente alta. El máximo está en 0.25. Así que el estimador de máxima verosimilitud es \\(\\hat{p} = 0.25\\), que es también el estimador usual de plugin en este caso. Para uniformizar la notación con el caso continuo que veremos más adelante, usaremos la notación \\[P(X=x) = f(x)\\] donde \\(f\\) es la función de densidad (en este caso, función de masa de probabilidad) de \\(X\\). Si esta función depende de un parámetro, escribimos \\[f(x ;\\theta)\\] Definición. Sean \\(X_1, \\ldots, X_n\\) una muestra de una densidad \\(f(x; \\theta)\\) y sean \\(x_1,x_2,\\ldots, x_n\\) los valores observados. La función de verosimilitud del párametro de interés \\(\\theta\\) está definida por \\[\\begin{align} \\mathcal{L}(\\theta; x_1, \\ldots, x_n) = \\prod_{i = 1}^n f(x_i; \\theta). \\end{align}\\] Esta función nos dice qué tan creible es el valor del parámetro \\(\\theta\\) dada la muestra observada. A veces también la denotamos por \\(\\mathcal{L}_n(\\theta)\\). Ahora definimos qué es un estimador de máxima verosimilitud. Definición. Un estimador de máxima verosimilitud lo denotamos por \\(\\hat \\theta_{\\textsf{MLE}}\\) y es un valor que satisface \\[\\begin{align} \\hat \\theta_{\\textsf{MLE}} = \\underset{\\theta \\, \\in \\, \\Theta}{\\arg\\max}\\, \\mathcal{L}(\\theta; x_1, \\ldots, x_n), \\end{align}\\] donde \\(\\Theta\\) denota el espacio parametral. Es decir, el espacio válido de búsqueda congruente con la definición del modelo. Considera el caso de una normal con media y varianza desconocidas. ¿Cuáles son los espacios parametrales para efectuar \\(\\mathsf{MLE}\\)? Considera el caso de una Binomial con parámetro \\(p\\) desconocidos. ¿Cuál es el espacio parametral para la búsqueda del \\(\\mathsf{MLE}\\)? Obsérvese que para construir la verosimilitud y en consecuencia buscar por estimadores de máxima verosimlitud necesitamos: Un modelo teórico de cómo es la población con parámetros e Información de cómo se extrajo la muestra, y entonces podemos resolver nuestro problema de estimación convirtiéndolo en uno de optimización. Probamos esta idea con un proceso más complejo. Ejemplo. Supongamos que una máquina puede estar funcionando correctamente o no en cada corrida. Cada corrida se producen 500 productos, y se muestrean 10 para detectar defectos. Cuando la máquina funciona correctamente, la tasa de defectos es de 3%. Cuando la máquina no está funcionando correctamente la tasa de defectos es de 20% Supongamos que escogemos al azar 11 corridas, y obervamos los siguientes número de defectuosos: \\[1, 0, 0, 3 ,0, 0, 0, 2, 1, 0, 0\\] La pregunta es: ¿qué porcentaje del tiempo la máquina está funcionando correctamente? Primero pensemos en una corrida. La probabilidad de observar una sucesión particular de \\(r\\) defectos es \\[0.03^r(0.97)^{(10-r)}\\] cuando la máquina está funcionando correctamente. Si la máquina está fallando, la misma probabilidad es \\[0.2^r(0.8)^{(10-r)}.\\] Ahora supongamos que la máquina trabaja correctamente en una proporción \\(p\\) de las corridas. Entonces la probabilidad de observar \\(r\\) fallas se calcula promediando (probabilidad total) sobre las probabilidades de que la máquina esté funcionando bien o no: \\[0.03^r(0.97)^{(10-r)}p + 0.2^r(0.8)^{(10-r)}(1-p)\\] Y esta es nuestra función de verosimilitud para una observación. Suponemos que las \\(r_1,r_2, \\ldots, r_{11}\\) observaciones son independientes (por ejemplo, después de cada corrida la máquina se prepara de una manera estándar, y es como si el proceso comenzara otra vez). Entonces tenemos que multiplicar estas probabilidades para cada observación \\(r_1\\): # creamos la función de verosimilitud con los datos observados como dados verosim <- function(p) { r <- c(1, 2, 0, 3, 0, 0, 0, 2, 1, 0, 3) q_func <- 0.03^r*(0.97)^(10-r) q_falla <- 0.2^r*(0.8)^(10-r) prod(p * q_func + (1 - p) * q_falla) } verosim(0.1) # Una alternativa que nos da más flexibilidad para generar la función de # verosimilitud, es crear una función que recibe los datos observados y nos # regresa la función de verosimilitud correspondiente # Entonces, cal_verosim es una función que regresa una función calc_verosim <- function(r){ q_func <- 0.03 ^ r * (0.97) ^ (10 - r) q_falla <- 0.2 ^ r * (0.8) ^ (10 - r) function(p){ #nota: esta no es la mejor manera de calcularlo, hay # que usar logaritmos. prod(p * q_func + (1 - p) * q_falla) } } verosim <- calc_verosim(r = c(1, 0, 0, 3, 0, 0, 0, 2, 1, 0, 0)) verosim(0.1) ## [1] 2.692087e-14 dat_verosim <- tibble(x = seq(0, 1, 0.001)) %>% mutate(prob = map_dbl(x, verosim)) ggplot(dat_verosim, aes(x = x, y = prob)) + geom_line() + geom_vline(xintercept = 0.773, color = "red") + xlab("prop funcionado") Y nuestra estimación puntual sería de alrededor de 80%. Máxima verosimilitud para observaciones continuas Cuando las observaciones \\(x_1,\\ldots, x_n\\) provienen de una distribución continua, no tiene sentido considerar \\(P(X = x_i)\\), pues siempre es igual a cero. Sin embargo, podemos escribir para pequeños valores \\(\\epsilon \\ll 1\\) \\[\\begin{align} P(x - \\epsilon < X < x + \\epsilon | \\theta) = \\int_{x - \\epsilon}^{x + \\epsilon} f(t; \\theta) \\, \\text{d} t \\approx 2 \\epsilon f(x; \\theta), \\end{align}\\] donde \\(f(x; \\theta)\\) es la función de densidad de \\(X.\\) Por lo tanto, \\[\\begin{align} \\begin{split} P&(x_1 - \\epsilon < X_1 < x_1 + \\epsilon, \\ldots, x_n - \\epsilon < X_n < x_n + \\epsilon | \\theta) \\\\ &= \\prod_{i = 1}^n P(x_i - \\epsilon < X_i < x_i + \\epsilon | \\theta) \\\\ &= \\prod_{i = 1}^n 2 \\epsilon f(x_i; \\theta) = (2\\epsilon)^n \\prod_{i = 1}^n f(x_i; \\theta). \\end{split} \\end{align}\\] Notemos que si \\(\\epsilon \\rightarrow 0\\) la ecuación rápidamente converge a cero. Pero para pequeños valores de \\(\\epsilon\\) la ecuación que nos interesa es proporcional a \\(\\prod_{i = 1}^n f(x_i; \\theta).\\) De esta forma, nuestra definición de máxima verosimilitud y estimadores de máxima verosimilitud es la misma para el caso continuo (verifica las definiciones de la sección anterior). Ejemplo. Supongamos que tenemos una muestra \\(x_1\\ldots, x_n\\) extraidas de una distribución exponencial con tasa \\(\\lambda>0\\) donde no conocemos \\(\\lambda\\). ¿Cuál es el estimador de máxima verosimilitud de \\(\\lambda\\)? Para \\(\\lambda>0\\), tenemos que \\[{\\mathcal L}(\\lambda) = \\prod_{i=1}^n \\lambda e^{-\\lambda x_i}\\] de modo que \\[{\\mathcal L}(\\lambda) = \\lambda^n e^{-\\lambda \\sum_{i=1}^nx_i} = \\lambda^n e^{-n\\lambda\\bar{x}} = e^{n(\\log\\lambda - \\lambda\\bar{x})}\\] Que podemos maximizar usando cálculo para obtener \\(\\hat{\\lambda}_{\\mathsf{ML}} = \\frac{1}{\\bar{x}}\\) (demuéstralo). Discute por qué esto es intuitivamente razonable: ¿cuál es el valor esperado de una exponencial con parámetro \\(\\lambda\\)? Aspectos numéricos Encontrar el estimador de máxima verosimilitud (\\(\\textsf{MLE}\\)) es automático en la mayoría de los casos. En teoría, podemos reutilizar la misma rutina numérica para encontrar el estimador sin ninguna ayuda de la analista. Esto contrasta con otras técnicas de estimación en donde se requieren cálculos y manipulación de ecuaciones. Sin embargo, hay situaciones que se pueden evitar de manera general. Por ejemplo, cuando calculamos la verosimilitud arriba, nótese que estamos multiplicando números que pueden ser muy chicos (por ejemplo \\(p^6\\), etc). Esto puede producir desbordes numéricos fácilmente. Por ejemplo para un tamaño de muestra de 1000, podríamos tener que calcular p <- 0.1 proba <- (p ^ 800)*(1-p)^200 proba ## [1] 0 En estos casos, es mejor hacer los cálculos en escala logarítmica. El logaritmo convierte productos en sumas, y baja exponentes multiplicando. Si calculamos en escala logaritmica la cantidad de arriba, no tenemos problema: log_proba <- 800 * log(p) + 200 * log(1-p) log_proba ## [1] -1863.14 Ahora notemos que Maximizar la verosimilitud es lo mismo que maximizar la log-verosimilitud, pues el logaritmo es una función creciente. Si \\(x_{\\max}\\) es el máximo de \\(f\\), tenemos que \\(f(x_{\\max})>f(x)\\) para cualquier \\(x\\), entonces tomando logaritmo, \\[\\log(f(x_{max}))>\\log(f(x)),\\] para cualquier \\(x.\\) Pues el logaritmo respeta la desigualdad por ser creciente. Usualmente usamos la log-verosimilitud para encontrar el estimador de máxima verosimilitud. Hay razónes teóricas y de interpretación por las que también es conveniente hacer esto. Definición. La log-verosimilitud la denotamos usualmente por \\[\\ell_n(\\theta) = \\log \\left(\\mathcal{L}_n(\\theta)\\right),\\] donde hemos suprimido la dependencia en la muestra por conveniencia. Ejemplo. En nuestro primer ejemplo, log_verosimilitud <- function(p){ 2*log(p) + 6*log(1-p) } dat_verosim <- tibble(x = seq(0,1, 0.01)) %>% mutate(log_prob = map_dbl(x, log_verosimilitud)) ggplot(dat_verosim, aes(x = x, y = log_prob)) + geom_line() + geom_vline(xintercept = 0.25, color = "red") + xlab("p") Obtenemos el mismo máximo. Podemos incluso resolver numéricamente: solucion <- optim(p = 0.5, log_verosimilitud, control = list(fnscale = -1), method = "Brent", lower = 0, upper = 1) solucion$par ## [1] 0.25 Y en nuestro segundo ejemplo: calc_log_verosim <- function(r){ q_func <- 0.03^r*(0.97)^(10-r) q_falla <- 0.2^r*(0.8)^(10-r) function(p){ #nota: esta no es la mejor manera de calcularlo, hay # que usar logaritmos. sum(log(p * q_func + (1 - p) * q_falla)) } } log_verosim <- calc_log_verosim(c(1, 0, 0, 3, 0, 0, 0, 2, 1, 0, 0)) log_verosim(0.1) ## [1] -31.24587 solucion <- optim(p = 0.2, log_verosim, control = list(fnscale = -1), method = "Brent", lower = 0, upper = 1) solucion$par ## [1] 0.7733766 solucion$convergence ## [1] 0 dat_verosim <- tibble(x = seq(0,1, 0.001)) %>% mutate(log_verosimilitud = map_dbl(x, log_verosim)) ggplot(dat_verosim, aes(x = x, y = log_verosimilitud)) + geom_line() + geom_vline(xintercept = 0.775, color = "red") + xlab("prop funcionado") Nótese que la verosimilitud la consideramos función de los parámetros, donde los datos están fijos. Podemos construir una función que genera la función de verosimilitud dependiendo de los datos. En nuestro primer ejemplo de muestras de registros erróneos, podríamos construir una función que genera la log verosimilitud dependiendo del tamaño de muestra y del número de errores encontrado: construir_log_verosim <- function(n, n_err){ # n es tamaño de muestra # n_err el número de errores detectados (datos) n_corr <- n - n_err log_verosim <- function(p){ n_err * log(p) + n_corr * log(1-p) } } Cuando fijamos \\(n\\) y \\(n_{\\textsf{err}}\\), esta función genera otra función, la log verosimilitud, que es la que queremos optimizar. Supongamos entonces que sacamos 20 registros al azar y observamos 10 incorrectos. La función de verosimilitud es log_vero <- construir_log_verosim(20, 10) tibble(x = seq(0,1,0.001)) %>% mutate(log_ver = log_vero(x)) %>% ggplot(aes(x = x, y = log_ver)) + geom_line() + geom_vline(xintercept = 0.5, color = 'red') Ejemplo. Supongamos que en una población de transacciones hay un porcentaje \\(p\\) (desconocido) que son fraudulentas. Tenemos un sistema de clasificación humana que que marca transacciones como sospechosas. Con este sistema hemos medido que la proporción de transacciones normales que son marcadas como sospechosas es de 0.1%, y que la proporción de transacciones fraudulentas que son marcadas como sospechosas es de 98%. Supongamos que extraemos una muestra de 2000 transacciones, de manera que todas ellas tiene la misma probabilidad de ser fraudulentas. El sistema de clasificación marca 4 transacciones como sospechosas ¿Cómo estimamos la proporción de transacciones fraudulentas en la población? Solución: sea \\(p\\) la proporción de transacciones fraudulentas. Entonces la probabilidad de que una transacción sea marcada como sospechosa es (proba total): \\[0.98p + 0.001(1-p)\\] Pues tenemos que contar 98% de la proporción \\(p\\) de fraudulentas (correctamente detectadas) más 0.1% de la proporción \\((1-p)\\) de fraudulentas. Escribimos entonces nuestra función de verosimilitud crear_log_verosim <- function(n, n_sosp){ # devolver la función log verosimilitud log_verosimilitud_pct <- function(pct){ # sup que pct es la proporcentaje de fraudes, # que es el parámetro que queremos estimar prob_sosp <- 0.98 * pct / 100 + 0.001 * (1 - pct / 100) log_prob <- n_sosp * log(prob_sosp) + (n - n_sosp) * log(1- prob_sosp) log_prob } log_verosimilitud_pct } La verosimilitud es una función de \\(p\\). log_verosim <- crear_log_verosim(n = 2000, n_sosp = 4) A continuación la mostramos de manera gráfica. No se ve muy claro dónde ocurre el máximo, pero podemos ampliar cerca de cero la misma gráfica: Vemos que alrededor de 0.1% maximiza la probabilidad de haber observado 4 transacciones sospechosas. Notamos sin embargo que varios valores alrededor de este valor tienen probabilidad similar, así que también son consistentes con los datos (por ejemplo, valores como 0.05 o 0.15 tienen probabilidad similar). Tendremos que considerar esto para evaluar la incertidumbre en nuestra estimación. Obsérvese adicionalmente que si no tomáramos en cuenta las probabilidades de falsos negativos y falsos positivos la estimación simple daría \\(4/2000 = 0.002\\) (0.2%), que es dos veces más grande que nuestra estimación puntual por máxima verosimilitud. Ejemplo. Este es un ejemplo donde mostramos que cuando el soporte de las densidades teóricas es acotado hay que tener cuidado en la definición de la verosimilitud. En este caso, el soporte de la variable aleatoria es el párametro de interés. Supongamos que nuestros datos son generados por medio de una distribución uniforme en el intervalo \\([0,b].\\) Contamos con una muestra de \\(n\\) observaciones generadas de manera independiente \\(X_i \\sim U[0,b]\\) para \\(i= 1, \\ldots, n.\\) Sin embargo, no conocemos el valor de \\(b\\). ¿Cómo es la función de log verosimilitud \\({\\mathcal L}_n(b)\\) para este caso? Nótese que cuando el parámetro \\(b\\) es menor que alguna \\(x_i\\), tenemos que \\({\\mathcal L}_n(b) = 0\\): la verosimilitud es cero si tomamos una \\(b\\) más chica que algún dato, pues este valor es incosistente del todo con los datos observados. En otro caso, \\[{\\mathcal L}_n(b) = \\frac{1}{b^n},\\] pues la función de densidad de una uniforme en \\([0,b]\\) es igual a \\(1/b\\) en el intervalo \\([0,b]\\), y 0 en otro caso. Podemos escribir entonces: crear_verosim <- function(x){ n <- length(x) verosim <- function(b){ indicadora <- ifelse(all(x <= b), 1, 0) indicadora / b^n } } Ahora podemos hacer máxima verosimilitud para un ejemplo: set.seed(234) x <- runif(10, 0, 3) verosim <- crear_verosim(x) res_opt <- optimize(verosim, c(-1000, 1000), maximum = TRUE) res_opt$maximum ## [1] 2.788167 Y nótese que, como esperaríamos, este valor es el máximo de la muestra: max(x) ## [1] 2.788158 La gráfica de la función de verosimilitud es: tibble(b = seq(-1, 5, 0.001)) %>% mutate(verosim_1 = map_dbl(b, ~ verosim(.x))) %>% ggplot() + geom_line(aes(x = b, y = verosim_1)) + geom_rug(data = tibble(x = x), aes(x = x), colour = "red") Podemos escribir en una fórmula como: \\[\\begin{align} \\mathcal{L}(b; x_1, \\ldots, x_n) = \\prod_{i = 1}^n 1_{[0,b]}(x_i) \\frac1b. \\end{align}\\] Y podríamos resolver analíticamente como sigue: Si consideramos \\[ \\hat b_{\\textsf{MLE}} = x_{\\max} = \\max\\{x_i\\},\\] notemos que cualquier valor observado necesariamente satisface \\[x_i \\leq \\hat b_{\\textsf{MLE}},\\] y por lo tanto todas las funciones indicadoras están encendidas. El valor de la verosimilitud es igual a \\[\\mathcal{L}(\\hat b_{\\textsf{MLE}}; x_1, \\ldots, x_n) = \\left(\\frac{1}{x_{\\max}}\\right)^n \\geq \\left (\\frac1b\\right )^n\\] para cualquier \\(b\\geq x_{\\max}\\). Como la verosimilitud para \\(b<x_{\\max}\\) es igual a cero, esto demuestra que el máximo de la muestra es el estimador de máxima verosimilitud de \\(b\\). Observación. Este ejemplo también tiene dificultades numéricas, pues la verosimilitud presenta discontinuidades y regiones con derivada igual a cero, y la mayoria de los algoritmos numéricos no tienen garantías buenas de covergencia al máximo en estos casos. Si aplicamos sin cuidado descenso en gradiente, por ejemplo, podríamos comenzar incorrectamente en un valor \\(b_0 < x_{\\max}\\) y el algoritmo no avanzaría al máximo. Máxima verosimilitud para más de un parámetro Si nuestro modelo contiene más de un parámetro desconocido podemos también usar máxima verosimilitud. En este caso, optimizamos sobre todos los parámetros usando cálculo o alguna rutina numérica. Ejemplo. Considera el caso de \\(n\\) muestras iid de un modelo Gaussiano. Es decir, \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2).\\) Consideremos que ambos parámetros son desconocidos y nos gustaria encontrar el \\(\\textsf{MLE}\\). Para este problema denotamos \\(\\theta \\in \\mathbb{R}^2\\), donde \\(\\theta_1 = \\mu\\) y \\(\\theta_2 = \\sigma^2.\\) La función de verosimiltud se puede calcular (ignorando algunas constantes multiplicativas) como \\[\\begin{align} \\mathcal{L}_n(\\theta) &= \\prod_{i = 1}^n \\frac{1}{\\sigma} \\, \\exp\\left( - \\frac{(x_i - \\mu)^2}{2\\sigma^2}\\right) \\\\ &= \\theta_2^{-\\frac{n}{2}}\\exp\\left( - \\frac{1}{2 \\theta_2} \\sum_{i = 1}^n (x_i - \\theta_1)^2 \\right). \\end{align}\\] A continuación mostramos la representación gráfica de la función de verosimilitud de este ejemplo. Notamos lo mismo que para los ejemplos anteriores. Conforme más datos tenemos, más nos acercamos a los valores reales que no conocemos. Ejemplo. Como ejercicio, podemos encontrar los estimadores de máxima verosimilitud cuando tenemos una muestra \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2).\\) (puedes derivar e igualar el cero para encontrar el mínimo). También podemos resolver numéricamente, por ejemplo: Supongamos que tenemos la siguiente muestra: set.seed(41852) muestra <- rnorm(150, mean = 1, sd = 2) La función generadora de la log verosimilitud para una muestra es (ve la expresión del ejercicio anterior y calcula su logaritmo), y generamos la función de verosimilitud para nuestra muestra: crear_log_p <- function(x){ log_p <- function(pars){ media = pars[1] desv_est = pars[2] # ve la ecuación del ejercicio anterior z <- (x - media) / desv_est log_verosim <- -(log(desv_est) + 0.5 * mean(z ^ 2)) log_verosim } log_p } log_p <- crear_log_p(muestra) Ahora optimizamos: res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mv <- tibble(parametro = c("media", "sigma"), estimador = res$par) %>% column_to_rownames(var = "parametro") est_mv ## estimador ## media 1.136001 ## sigma 1.838421 Verifica que el estimador de la media y de la desviación estándar es el que esperábamos (y que puedes derivar analíticamente): n <- length(muestra) sd_n <- function(x) sqrt(mean((x - mean(x))^2)) c(media = mean(muestra), sigma = sd_n(muestra)) %>% round(4) ## media sigma ## 1.1364 1.8392 Ejemplo. Supongamos que en una población de estudiantes tenemos dos tipos: unos llenaron un examen de opción múltiple al azar (1 de 5), y otros contestaron las preguntas intentando sacar una buena calificación. Suponemos que una vez que conocemos el tipo de estudiante, todas las preguntas tienen la misma probabilidad de ser contestadas correctamente, de manera independiente. El modelo teórico está representado por la siguiente simulación: sim_formas <- function(p_azar, p_corr){ tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } Y una muestra se ve como sigue: set.seed(12) muestra <- map_dbl(1:200, ~ sim_formas(0.3, 0.75)) qplot(muestra) Supongamos que no conocemos la probabildad de contestar correctamente ni la proporción de estudiantes que contestó al azar. ¿Como estimamos estas dos cantidades? Escribimos la verosimilitud: crear_log_p <- function(x){ log_p <- function(pars){ p_azar = pars[1] p_corr = pars[2] sum(log(p_azar * dbinom(x, 10, 1/5) + (1 - p_azar) * dbinom(x, 10, p_corr))) } log_p } Creamos la función de verosimilitud con los datos log_p <- crear_log_p(muestra) y optimizamos res <- optim(c(0.5, 0.5), log_p, control = list(fnscale = -1)) res$par ## [1] 0.2827061 0.7413276 En este caso, obtenemos estimaciones razonables de ambos parámetros. Nota: dependiendo de los datos, este problema puede estar mal condicionado. Por ejemplo, ¿qué pasa si la probabilidad de acertar cuando se contesta bien está cercano al azar? La siguiente pregunta qué nos interesa hacer es: ¿cómo estimamos la variabilidad de estos estimadores? Más adelante veremos una respuesta basada en teoría, pero también podemos resolver este problema usando el bootstrap. Referencias "],["bootstrap-paramétrico.html", "Sección 7 Bootstrap paramétrico Ventajas y desventajas de bootstrap paramétrico Verificando los supuestos distribucionales Modelos mal identificados", " Sección 7 Bootstrap paramétrico Cuando nuestras observaciones provienen de un modelo teórico parametrizado con algunos parámetros que queremos estimar, y utilizamos máxima verosimilitud para hacer nuestra estimación, no es adecuado aplicar directamente el bootstrap no paramétrico que vimos en las secciones anteriores. Sin embargo, suponiendo que el modelo paramétrico que estamos usando es apropiado, podemos remuestrear de tal modelo para estimar la varianza de nuestros estimadores. Este proceso se llama el bootstrap paramétrico. Antes de hacer una definición precisa, veamos cómo calcularíamos error estándar para los estimadores de máxima verosimilitud de la normal que vimos en la sección anterior. Ejemplo (sección máxima verosimilitud). Como ejercicio, podemos encontrar los estimadores de máxima verosimilitud cuando tenemos una muestra \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2)\\) (puedes derivar e igualar a cero para encontrar el mínimo). También podemos resolver numéricamente. Supongamos que tenemos la siguiente muestra: set.seed(41852) muestra <- rnorm(150, mean = 1, sd = 2) La función generadora de la log-verosimilitud para una muestra es (ve la expresión del ejercicio anterior y calcula su logaritmo), y generamos la función de verosimilitud para nuestra muestra: crear_log_p <- function(x){ log_p <- function(pars){ media = pars[1] desv_est = pars[2] # ve la ecuación del ejercicio anterior z <- (x - media) / desv_est log_verosim <- -(log(desv_est) + 0.5 * mean(z^2)) log_verosim } log_p } log_p <- crear_log_p(muestra) Ahora optimizamos (revisa que el método converge): res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mle <- tibble(parametro = c("media", "sigma"), estimador = res$par) |> column_to_rownames(var = "parametro") Una vez que tenemos nuestros estimadores puntuales, est_mle ## estimador ## media 1.136001 ## sigma 1.838421 Sustituimos estos parámetros en la distribución normal y simulamos una muestra del mismo tamaño que la original: simular_modelo <- function(n, media, sigma){ rnorm(n, media, sigma) } muestra_bootstrap <- simular_modelo(length(muestra), est_mle["media", "estimador"], est_mle["sigma", "estimador"]) head(muestra_bootstrap) ## [1] 1.8583885 2.2084326 2.5852895 2.5174462 -0.7428032 0.5995989 Una vez que tenemos esta muestra bootstrap recalculamos los estimadores de máxima verosimlitud. Esto se hace optimizando: # creamos nueva verosimilitud para muestra bootstrap log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0, 0.5), log_p_boot, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res_boot$convergence ## [1] 0 est_mle_boot <- tibble(parametro = c("media", "sigma"), estimador = res_boot$par) |> column_to_rownames(var = "parametro") est_mle_boot ## estimador ## media 1.235914 ## sigma 1.710042 Y esta es nuestra replicación bootstrap de los estimadores de máxima verosimilitud. La idea es la misma que el bootstrap no paramétrico, con la ventaja de que estamos simulando del modelo que suponemos es el correcto, es decir, estamos usando información adicional que no teníamos en el bootstrap no paramétrico. Ahora es necesario repetir un número grande de veces. Nótese que esta función envuelve el proceso de remuestreo, cálculo de la función de verosimilitud y optimización: rep_boot <- function(rep, crear_log_p, est_mle, n){ muestra_bootstrap <- simular_modelo(length(muestra), est_mle["media", "estimador"], est_mle["sigma", "estimador"]) log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0, 0.5), log_p_boot, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") try(if(res_boot$convergence != 0) stop("No se alcanzó convergencia.")) tibble(parametro = c("media", "sigma"), estimador_boot = res_boot$par) } reps_boot <- map_dfr(1:5000, ~ rep_boot(.x, crear_log_p, est_mle, n = length(muestra)), rep = ".id") reps_boot ## # A tibble: 10,000 × 2 ## parametro estimador_boot ## <chr> <dbl> ## 1 media 0.797 ## 2 sigma 1.90 ## 3 media 1.23 ## 4 sigma 1.96 ## 5 media 1.14 ## 6 sigma 1.89 ## 7 media 1.33 ## 8 sigma 1.73 ## 9 media 1.19 ## 10 sigma 1.73 ## # ℹ 9,990 more rows Ya ahora podemos estimar error estándar: error_est <- reps_boot |> group_by(parametro) |> summarise(ee_boot = sd(estimador_boot)) error_est ## # A tibble: 2 × 2 ## parametro ee_boot ## <chr> <dbl> ## 1 media 0.150 ## 2 sigma 0.106 Así que nuestra estimación final sería: bind_cols(est_mle, error_est) |> mutate(across(where(is.numeric), round, 3)) |> select(parametro, estimador, ee_boot) ## parametro estimador ee_boot ## media media 1.136 0.150 ## sigma sigma 1.838 0.106 Si usamos la rutina estándar de R (dejaremos para después explicar cómo calcula los errores estándar esta rutina —no es con bootstrap): broom::tidy(MASS::fitdistr(muestra, "normal")) ## # A tibble: 2 × 3 ## term estimate std.error ## <chr> <dbl> <dbl> ## 1 mean 1.14 0.150 ## 2 sd 1.84 0.106 Podemos revisar también la normalidad aproximada de las distribuciones bootstrap para construir nuestros intervalos: ggplot(reps_boot, aes(sample = estimador_boot)) + geom_qq() + geom_qq_line(colour = "red") + facet_wrap(~parametro, scales = "free_y") La distribuciones son aproximadamente normales. Nótese que esto no siempre sucede, especialmente con parámetros de dispersión como \\(\\sigma\\). Ejemplo. Supongamos que tenemos una muestra más chica. Repasa los pasos para asegurarte que entiendes el procedimiento: set.seed(4182) muestra <- rnorm(6, mean = 1, sd = 2) # función de verosimilitud log_p <- crear_log_p(muestra) # máxima verosimilitud res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mle <- tibble(parametro = c("media", "sigma"), estimador = res$par) |> column_to_rownames(var = "parametro") est_mle ## estimador ## media 0.3982829 ## sigma 2.3988969 Hacemos bootstrap paramétrico reps_boot <- map_dfr(1:5000, ~ rep_boot(.x, crear_log_p, est_mle, n = length(muestra)), .id = "rep") reps_boot ## # A tibble: 10,000 × 3 ## rep parametro estimador_boot ## <chr> <chr> <dbl> ## 1 1 media 0.789 ## 2 1 sigma 0.945 ## 3 2 media -0.103 ## 4 2 sigma 1.37 ## 5 3 media 1.96 ## 6 3 sigma 1.70 ## 7 4 media 1.55 ## 8 4 sigma 2.28 ## 9 5 media -0.228 ## 10 5 sigma 1.73 ## # ℹ 9,990 more rows ggplot(reps_boot, aes(sample = estimador_boot)) + geom_qq() + geom_qq_line(colour = "red") + facet_wrap(~parametro, scales = "free_y") ggplot(reps_boot, aes(x = estimador_boot)) + geom_histogram() +facet_wrap(~parametro) Donde vemos que la distribución de \\(\\sigma\\) es asimétrica pues en algunos casos obtenemos estimaciones muy cercanas a cero. Podemos usar intervalos de percentiles. Ejercicio (extra). Con más de un parámetro, podemos preguntarnos cómo dependen las estimaciones individuales - en algunos casos pueden estar correlacionadas. Podemos examinar este comportamiendo visualizando las replicaciones bootstrap ggplot(reps_boot |> pivot_wider(names_from = parametro, values_from = estimador_boot), aes(x = media, y = sigma)) + geom_point(alpha = 0.5) + coord_equal() Esta es nuestra aproximación a la distribución de remuestreo de nuestro par de estadísticas \\((\\mu_{\\mathsf{MLE}}, \\sigma_{\\mathsf{MLE}})\\). En este caso, parecen ser independientes (lo cual es posible demostrar). Bootstrap paramétrico. Supongamos que tenemos una muestra iid \\(X_1,X_2,\\ldots, X_n \\sim f(x;\\theta)\\) de un modelo paramétrico, y un estimador de máxima verosimilitud \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) para \\(\\theta\\). El error estándar estimado para \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) por medio del bootstrap paramétrico se calcula como sigue: Se calcula \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) para la muestra observada Se simula una muestra iid de tamaño \\(n\\) de \\(f(x; \\hat{\\theta}_{\\mathsf{MLE}})\\) (muestra bootstrap) Se recalcula el estimador de máxima verosimilitud para la muestra bootstrap \\(\\hat{\\theta^*}_{\\mathsf{MLE}}\\) Se repiten 2-3 una cantidad grande de veces (1000 - 10000) Se calcula la desviación estándar de los valores \\(\\hat{\\theta^*}_{\\mathsf{MLE}}\\) obtenidos. Este es el error estándar estimado para el estimador \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) Ventajas y desventajas de bootstrap paramétrico Ventaja: el bootstrap paramétrico puede dar estimadores más precisos e intervalos más angostos y bien calibrados que el no paramétrico, siempre y cuando el modelo teórico sea razonable. Desventaja: Es necesario decidir el modelo teórico, que tendrá cierto grado de desajuste vs. el proceso generador real de los datos. Si el ajuste es muy malo, los resultados tienen poca utilidad. Para el no paramétrico no es necesario hacer supuestos teóricos. Ventaja: el bootstrap paramétrico puede ser más escalable que el no paramétrico, pues no es necesario cargar y remuestrear los datos originales, y tenemos mejoras adicionales cuando tenemos expresiones explícitas para los estimadores de máxima verosimilitud (como en el caso normal, donde es innecesario hacer optimización numérica). Desventaja: el bootstrap paramétrico es conceptualmente más complicado que el no paramétrico, y como vimos arriba, sus supuestos pueden ser más frágiles que los del no-paramétrico. Verificando los supuestos distribucionales Como hemos discutido antes, podemos hacer pruebas de hipótesis para revisar si una muestra dada proviene de una distribución conocida. Sin embargo, la herramienta más común es la de los qq-plots, donde podemos juzgar fácilmente el tamaño de las desviaciones y si estas tienen implicaciones prácticas importantes. El proceso es como sigue: si \\(X_1,X_,\\ldots, X_n\\) es una muestra de \\(f(x;\\theta)\\), calculamos el estimador de máxima verosimilitud \\(\\theta_{\\mathsf{MLE}}\\) con los datos observados. Enchufamos \\(\\hat{f} = f(x;\\theta_{\\mathsf{MLE}})\\), y hacemos una gráfica de los cuantiles teóricos de \\(\\hat{f}\\) contra los cuantiles muestrales. Ejemplo. Consideramos la siguiente muestra: set.seed(32) muestra <- rgamma(150, 0.4, 1) qplot(muestra) Y queremos usar un modelo exponencial. Encontramos los estimadores de maxima verosimilitud est_mle <- MASS::fitdistr(muestra, "exponential") rate_mle <- est_mle$estimate rate_mle ## rate ## 2.76054 g_exp <- ggplot(tibble(muestra = muestra), aes(sample = muestra)) + geom_qq(distribution = stats::qexp, dparams = list(rate = rate_mle)) + geom_abline() + labs(subtitle = "Gráfica de cuantiles exponenciales") g_exp Donde vemos que el desajuste es considerable, y los datos tienen una cola derecha considerablemente más larga que la de exponencial (datos son casi dos veces más grande de lo que esperaríamos), y la cola izquierda está más comprimida en los datos que en una exponencial. Sin embargo, si ajustamos una gamma: est_mle <- MASS::fitdistr(muestra, "gamma")$estimate g_gamma <- ggplot(tibble(muestra = muestra), aes(sample = muestra)) + geom_qq(distribution = stats::qgamma, dparams = list(shape = est_mle[1], rate = est_mle[2])) + geom_abline() + labs(subtitle = "Gráfica de cuantiles gamma") g_exp + g_gamma El ajuste es considerablemente mejor para la distribución gamma (puedes hacer el protocolo rorschach para afinar tu diagnóstico de este tipo de gráficas). Ejempĺo. Examinamos un modelo teórico para las cuentas totales del conjunto de datos de propinas. En primer lugar: Separamos comida y cena, pues sabemos que las cuentas tienden a ser más grandes en las cenas. En lugar de modelar la cuenta total, modelamos el gasto por persona, es decir, la cuenta total dividida por el numero de personas. Grupos grandes pueden producir colas largas que no tenemos necesidad de modelar de manera probabilística, pues conocemos el número de personas. En este caso intentaremos un modelo lognormal, es decir, el logaritmo de los valores observados se comporta aproximadamente normal. Puedes también intentar con una distribución gamma. Separamos por Cena y Comida, dividimos entre número de personas y probamos ajustando un modelo para cada horario: propinas <- read_csv("data/propinas.csv") |> mutate(cuenta_persona = cuenta_total / num_personas) propinas_mle <- propinas |> group_by(momento) |> summarise(est_mle = list(tidy(MASS::fitdistr(cuenta_persona, "lognormal")))) |> unnest(est_mle) propinas_mle ## # A tibble: 4 × 4 ## momento term estimate std.error ## <chr> <chr> <dbl> <dbl> ## 1 Cena meanlog 2.03 0.0273 ## 2 Cena sdlog 0.362 0.0193 ## 3 Comida meanlog 1.94 0.0366 ## 4 Comida sdlog 0.302 0.0259 Ojo: estos parámetros están en escala logarítmica. Puedes revisar aquí para ver cómo calcular media y desviación estándar de las distribuciones originales. Ahora verificamos el ajuste: g_1 <- ggplot(propinas |> filter(momento == "Cena"), aes(sample = cuenta_persona)) + geom_qq(dparams = list(mean = propinas_mle$estimate[1], sd = propinas_mle$estimate[2]), distribution = stats::qlnorm) + ylim(c(0, 20)) + geom_abline() + labs(subtitle = "Cena") g_2 <- ggplot(propinas |> filter(momento == "Comida"), aes(sample = cuenta_persona)) + geom_qq(dparams = list(mean = propinas_mle$estimate[3], sd = propinas_mle$estimate[4]), distribution = stats::qlnorm) + ylim(c(0, 20)) + geom_abline() + labs(subtitle = "Comida") g_1 + g_2 El ajuste es bueno, aunque podríamos revisar la cola de la derecha en la Comida: ¿por qué existen esos valores relativamente grandes (alrededor de 25% más altos de lo que esperaríamos). ¿Tiene sentido ajustar dos distribuciones con parámetros separados? ¿Crees que estas dos distribuciones podrían compartir algún parámetro? Para esto puedes revisar el error estándar de los estimadores de máxima verosimilitud que mostramos arriba. ¿Qué ventajas verías en usar menos parámetros? ¿Cómo implementarías la estimación? ¿Qué pasa si intentas ajustar un modelo normal a estos datos? Modelos mal identificados Para algunos modelos y algunos parámetros, puede suceder que existan varias configuraciones muy diferentes de los parámetros que sean consistentes con los datos (en términos de verosimilitud, tienen verosimilitud alta similar), y en estos casos decimos que el modelo (con los datos observados) está mal identificado. Esto presenta problemas múltiples: optimizar es más difícil, hay incertidumbre grande en la estimación, y los parámetros se acoplan, haciendo difícil su interpretación. Ejemplo. Consideremos el ejemplo donde queríamos estimar dos proporciones: la proporción de examenes contestados al azar y la tasa de correctos. Vamos a suponer que la probabilidad de tener respuesta correcta dado que el examen no fue contestado al azar no es muy lejano a 1/5, que es la probabilidad de acertar a al azar. Aquí está la función para simular y la log verosimilitud correspondiente. Aquí vamos a ver un problema más difícil, así que usaremos la transformación logit para las proporciones, y no obtener resultados fuera del rango 0-1 al optimizar: inv_logit <- function(theta){ exp(theta) / (1 + exp(theta)) } logit <- function(p){ log(p / (1-p)) } # Simular datos sim_formas <- function(probs){ p_azar <- probs[1] p_corr <- probs[2] tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } simular_modelo <- function(n, params){ muestra <- map_dbl(1:n, ~ sim_formas(probs = inv_logit(params))) muestra } # log verosimilitud crear_log_p <- function(x){ log_p <- function(pars){ p_azar = inv_logit(pars[1]) p_corr = inv_logit(pars[2]) sum(log(p_azar * dbinom(x, 10, 1/5) + (1 - p_azar) * dbinom(x, 10, p_corr))) } log_p } # simular datos set.seed(12) muestra <- simular_modelo(2000, params = logit(c(0.3, 0.29))) qplot(muestra) log_p <- crear_log_p(muestra) res <- optim(c(0.0, 0.0), log_p, control = list(fnscale = -1)) res$convergence ## [1] 0 est_mle <- res$par names(est_mle) <- c("p_azar_logit", "p_corr_logit") est_mle ## p_azar_logit p_corr_logit ## -0.9194029 -0.8896454 probs_mle <- inv_logit(est_mle) names(probs_mle) <- c("p_azar", "p_corr") probs_mle ## p_azar p_corr ## 0.2850796 0.2911830 En primer lugar, parece ser que nuestras estimaciones son menos precias. Vamos a hacer bootstrap paramétrico: rep_boot <- function(rep, simular, crear_log_p, pars, n){ muestra_bootstrap <- simular(n, pars) log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0.0, 0.0), log_p_boot, control = list(fnscale = -1)) try(if(res_boot$convergence != 0) stop("No se alcanzó convergencia.")) est_mle_boot <- res_boot$par names(est_mle_boot) <- names(pars) est_mle_boot["rep"] <- rep est_mle_boot["convergence"] <- res_boot$convergence est_mle_boot } set.seed(8934) reps_boot <- map(1:500, ~ rep_boot(.x, simular_modelo, crear_log_p, est_mle, n = length(muestra))) |> bind_rows() reps_boot |> mutate(across(everything(), round, 2)) |> head() ## # A tibble: 6 × 4 ## p_azar_logit p_corr_logit rep convergence ## <dbl> <dbl> <dbl> <dbl> ## 1 -1.14 -0.92 1 0 ## 2 -1.11 -0.85 2 0 ## 3 -1.17 -0.95 3 0 ## 4 -2.74 -1.01 4 0 ## 5 -1.05 -0.93 5 0 ## 6 -0.91 -0.87 6 0 El optimizador encontró resultados que no tienen sentido: ggplot(reps_boot, aes(x = inv_logit(p_azar_logit), y = inv_logit(p_corr_logit), colour = factor(convergence))) + geom_point(show.legend = FALSE) + xlab("p_azar") + ylab("p_corr") Y notamos un problema grave: Tenemos mucha variación en nuestros estimadores, y la correlación entre las estimaciones es alta. Esto deberíamos haberlo esperado, pues como las probabilidades de contestar correctamente son muy similares a las de contestar al azar: Existen muchas combinaciones de parámetros que son consistentes con los datos. Decimos entonces que este modelo está mal identificado con estos datos. La mala identificación, como vemos, es una propiedad tanto de modelo como datos. ¿Qué conclusiones acerca del examen obtienes al ver estas simulaciones bootstrap? ¿Cómo se deberían reportar estos resultados? Qué pasa en este ejemplo si la \\(p_{corr}\\) es más grande, o el tamaño de muestra es más grande? Repite el ejercicio con los parámetros del primer ejemplo (\\(p_{azar} = 0.3, p_{corr}=0.75\\)) y el mismo tamaño de muestra. ¿Qué sucede en este caso? En el caso extremo, decimos que el modelo no está indentificado, y eso generalmente sucede por un problema en el planteamiento del modelo, independientemente de los datos. ¿Puedes imaginar un modelo así? "],["propiedades-teóricas-de-mle.html", "Sección 8 Propiedades teóricas de MLE Consistencia Equivarianza del \\(\\textsf{MLE}\\) Normalidad asintótica Optimalidad del \\(\\textsf{MLE}\\)", " Sección 8 Propiedades teóricas de MLE El método de máxima verosimiltud es uno de los métodos más utilizados en la inferencia estadística paramétrica. En esta sección estudiaremos las propiedades teóricas que cumplen los estimadores de máxima verosimilitud (\\(\\textsf{MLE}\\)) y que han ayudado en su casi adopción universal. Estas propiedades de los \\(\\textsf{MLE}\\) son válidas siempre y cuando el modelo \\(f(x; \\theta)\\) satisfaga ciertas condiciones de regularidad. En particular veremos las condiciones para que los estimadores de máxima verosimilitud sean: consistentes, asintóticamente normales, asintóticamente insesgados, asintóticamente eficientes, y equivariantes. Los estimadores \\(\\textsf{MLE}\\) en ocasiones son malinterpretados como una estimación puntual en la inferencia, y por ende, incapaces de cuantificar incertidumbre. A lo largo de estas notas hemos visto cómo extraer intervalos de confianza por medio de simulación y por lo tanto incorporar incertidumbre en la estimación. Sin embargo, hay otros maneras de reportar incertidumbre para \\(\\textsf{MLE}\\). Y hablaremos de ello en esta sección. A lo largo de esta sección asumiremos muestras de la forma \\[\\begin{align} X_1, \\ldots, X_n \\overset{\\text{iid}}{\\sim} f(x; \\theta^*), \\end{align}\\] donde \\(\\theta^*\\) es el valor verdadero —que suponemos desconocido pero fijo— del parámetro \\(\\theta \\in \\Theta\\), y sea \\(\\hat \\theta_n\\) el estimador de máxima verosimilitud de \\(\\theta.\\) Ejemplo Usaremos este ejemplo para ilustrar los diferentes puntos teóricos a lo largo de esta sección. Consideremos el caso de una muestra de variables binarias que registran el éxito o fracaso de un experimento. Es decir, \\(X_1, \\ldots, X_n \\sim \\textsf{Bernoulli}(p),\\) donde el párametro desconocido es el procentaje de éxitos. Éste último denotado por \\(p.\\) Este ejemplo lo hemos estudiado en secciones pasadas, y sabemos que el \\(\\textsf{MLE}\\) es \\[\\begin{align} \\hat p_n = \\frac{S_n}{n} = \\bar X_n, \\end{align}\\] donde \\(S_n= \\sum_i X_i\\) es el número total de éxitos en la muestra. La figura siguiente ilustra el estimador \\(\\hat p_n\\) como función del número de observaciones en nuestra muestra. Podemos apreciar cómo el promedio parece estabilizarse alrededor del verdadero valor de \\(p^* = 0.25\\) cuando tenemos una cantidad suficientemente grande de observaciones. Como es de esperarse, diferentes muestras tendrán diferentes valores de \\(n\\) dónde las trayectorias parezca que se haya estabilizado (Ver figura siguiente). Sin embargo, se puede notar que este comportamiento parece estar controlado y son raras las trayectorias que se encuentran más lejos. Los conceptos siguientes nos permitirán cuantificar el porcentaje de trayectorias que se mantienen cercanas a \\(p^*,\\) en el caso límite de un número grande de observaciones, cuando trabajemos con estimadores de máxima verosimilitud. Más aún, nos permitirán cracterizar la distribución para dicho límite y aprenderemos de otras propiedades bajo este supuesto asintótico. Consistencia Es prudente pensar que para un estimador, lo que nos interesa es que conforme más información tengamos, más cerca esté del valor desconocido. Esta propiedad la representamos por medio del concepto de consistencia. Para hablar de esta propiedad necesitamos definir un tipo de convergencia para una secuencia de variables aleatorias, convergencia en probabilidad. Definición. Una sucesión de variables aleatorias \\(X_n\\) converge en probabilidad a la variable aleatoria \\(X,\\) lo cual denotamos por \\(X_n \\overset{P}{\\rightarrow} X\\), si para toda \\(\\epsilon \\gt 0\\), \\[\\lim_{n \\rightarrow \\infty} \\mathbb{P}(|X_n - X| > \\epsilon) = 0.\\] Ahora, definimos un estimador consistente como: Definición. Un estimador \\(\\tilde \\theta_n\\) es consistente si converge en probabilidad a \\(\\theta^*.\\) Donde \\(\\theta^*\\) denota el verdadero valor del parámetro, que asumimos fijo. En particular, los estimadores \\(\\textsf{MLE}\\) son consistentes. Teorema. Sea \\(X_n \\sim f(X; \\theta^*),\\) una muestra iid, tal que \\(f(X; \\theta)\\) cumple con ciertas condiciones de regularidad. Entonces, \\(\\hat \\theta_n,\\) el estimador de máxima verosimilitud, converge en probabilidad a \\(\\theta^*.\\) Es decir, \\(\\hat \\theta_n\\) es consistente. La demostración de este teorema la pueden encontrar en Wasserman (2013). Ejemplo El estimador \\(\\hat p_n\\) es consistente. Esto quiere decir que el estimador se vuelve más preciso conforme obtengamos más información. En general esta es una propiedad que los estimadores deben satisfacer para ser útiles en la práctica. La figura siguiente muestra el estimador \\(\\hat p_n\\) como función del número de observaciones utilizado. Distintas curvas corresponden a distintas realizaciones de muestras obtenidas del modelo (\\(B = 500\\)). Nota que la banda definida por \\(\\epsilon\\) se puede hacer tan pequeña como se requiera, lo único que sucederá es que necesitaremos un mayor número de observaciones para garantizar que las trayectorias de los estimadores \\(\\hat p_n\\) se mantengan dentro de las bandas con alta probabilidad. Equivarianza del \\(\\textsf{MLE}\\) Muchas veces nos interesa reparametrizar la función de verosimilitud con el motivo de simplificar el problema de optimización asociado, o simplemente por conveniencia interpretativa. Por ejemplo, si el parámetro de interés es tal que \\(\\theta \\in [a, b],\\) entonces encontrar el \\(\\textsf{MLE}\\) se traduce en optimizar la log-verosimilitud en el espacio restringido al intervalo \\([a,b].\\) En este caso, los métodos tradicionales de búsqueda local por descenso en gradiente podrían tener problemas de estabilidad cuando la búsqueda se realice cerca de las cotas. El concepto de equivarianza nos dice que si el cambio de coordenadas parametrales está definida, y si este cambio de variable se realiza por medio de una función bien comportada (derivable y cuya derivada no es cero), entonces la solución de encontrar el \\(\\textsf{MLE}\\) en las coordenadas originales y transformar, es igual a realizar la inferencia en las coordenadas fáciles. Teorema. Sea \\(\\tau = g(\\theta)\\) una función de \\(\\theta\\) bien comportada. Entonces si \\(\\hat \\theta_n\\) es el \\(\\textsf{MLE}\\) de \\(\\theta,\\) entonces \\(\\hat \\tau_n = g(\\hat \\theta_n)\\) es el \\(\\textsf{MLE}\\) de \\(\\tau.\\) Ejemplo El concepto de equivarianza lo ilustraremos para nuestro ejemplo de esta sección. En particular la parametrización la realizamos por cuestiones de interpretación como un factor de riesgo. Como hemos visto estimador \\(\\hat p_n\\) es equivariante. Es importante mencionar que esta propiedad es general para cualquier tamaño de muestra. Es decir, no descansa en supuestos de muestras grandes. Supongamos que nos interesa estimar el momio de éxitos (bastante común en casas de apuestas). El momio está definido como \\[ \\theta = \\frac{p}{1-p},\\] y podemos rescribir la función de verosimilitud en términos de este parámetro. Sustituyendo \\(p = \\frac{\\theta}{1+\\theta}\\) en \\(\\mathcal{L}_n(p)\\) obtenemos \\[\\begin{align} \\mathcal{L}_n(\\theta) = \\left( \\frac{\\theta}{1 + \\theta} \\right)^{S_n} \\left(\\frac{1}{1 + \\theta} \\right)^{n - S_n}, \\end{align}\\] cuya función encuentra su máximo en \\[\\begin{align} \\hat \\theta_n = \\frac{\\bar X_n}{ 1 - \\bar X_n}. \\end{align}\\] Comprueba que el estimador de arriba para \\(\\theta\\) es el MLE. Normalidad asintótica Está propiedad nos permite caracterizar la distribución asintótica del MLE. Es decir, nos permite caracterizar la incertidumbre asociada una muestra suficientemente grande por medio de una distribución Gaussiana. Esto es, bajo ciertas condiciones de regularidad, \\[\\hat \\theta_n \\overset{.}{\\sim} \\mathsf{N}( \\theta^*, \\mathsf{ee}^2),\\] donde \\(\\mathsf{ee}\\) denota el error estándar del \\(\\textsf{MLE},\\) \\(\\mathsf{ee} = \\mathsf{ee}(\\hat \\theta_n) = \\sqrt{\\mathbb{V}(\\hat \\theta_n)}\\). Esta distribución se puede caracterizar de manera aproximada por métodos analíticos. Para esto necesitamos las siguientes definiciones. Definición. La función de score está definida como \\[\\begin{align} s(X; \\theta) = \\frac{\\partial \\log f(X; \\theta)}{\\partial \\theta}. \\end{align}\\] La información de Fisher está definida como \\[\\begin{align} I_n(\\theta) &= \\mathbb{V}\\left( \\sum_{i = 1}^ns(X_i; \\theta) \\right) \\\\ &= \\sum_{i = 1}^n \\mathbb{V} \\left(s(X_i; \\theta) \\right) \\end{align}\\] Estas cantidades nos permiten evaluar qué tan fácil será identificar el mejor modelo dentro de la familia parámetrica \\(f(X; \\theta)\\). La función de score nos dice qué tanto cambia locamente la distribución cuando cambiamos el valor del parámetro. Calcular la varianza, nos habla de la dispersión de dicho cambio a lo largo del soporte de la variable aleatoria \\(X.\\) Si \\(I_n(\\theta)\\) es grande entonces el cambio de la distribución es muy importante. Esto quiere decir que la distribución es muy diferente de las distribuciones cercanas que se generen al evaluar en \\(\\theta\\)s diferentes. Por lo tanto, si \\(I_n(\\theta)\\) es grande, la distribución será fácil de identificar cuando hagamos observaciones. La información de Fisher también nos permite caracterizar de forma analítica la varianza asíntotica del \\(\\textsf{MLE}\\) pues la aproximación \\(\\mathsf{ee}^2 \\approx \\frac{1}{I_n(\\theta^*)}\\) es válida. El siguiente resultado utiliza la propiedad de la función de score: \\(\\mathbb{E}[s(X; \\theta)] = 0,\\) que implica que \\(\\mathbb{V} \\left(s(X_i; \\theta) \\right) = \\mathbb{E}[s^2(X; \\theta)],\\) y permite a su vez un cómputo más sencillo de la información de Fisher. Teorema. El cálculo de la información de Fisher para una muestra de tamaño \\(n\\) se puede calcular de manera simplificada como \\(I_n(\\theta) = n \\, I(\\theta).\\) Por otro lado, tenemos la siguiente igualdad \\[ I(\\theta) = - \\mathbb{E}\\left( \\frac{\\partial^2 \\log f(X; \\theta)}{\\partial \\theta^2} \\right).\\] Con estas herramientas podemos formular el teorema siguiente. Teorema. Bajo ciertas condiciones de regularidad se satisface que \\(\\mathsf{ee} \\approx \\sqrt{1/I_n(\\theta^*)}\\) y \\[ \\hat \\theta_n \\overset{d}{\\rightarrow} \\mathsf{N}( \\theta^*, \\mathsf{ee}^2).\\] El resultado anterior es teóricamente interesante y nos asegura un comportamiento controlado conforme tengamos más observaciones disponibles. Sin embargo, no es práctico pues no conocemos \\(\\theta^*\\) en la práctica y por consiguiente no conoceríamos la varianza. Sin embargo, también podemos aplicar el principio de plug-in y caracterizar la varianza de la distribución asintótica por medio de \\[\\hat{\\mathsf{ee}} = \\sqrt{1/I_n(\\hat \\theta_n)}.\\] Esto último nos permite constuir intervalos de confianza, por ejemplo al 95%, a través de \\[ \\hat \\theta_n \\pm 2 \\, \\hat{\\mathsf{ee}}.\\] Asimismo, el teorema de Normalidad asintótica nos permite establecer que el \\(\\textsf{MLE}\\) es asíntoticamente insesgado. Es decir, \\[\\lim_{n \\rightarrow \\infty}\\mathbb{E}[\\hat \\theta_n] = \\theta^*.\\] Definición. Sea una muestra \\(X_1, \\ldots, X_n \\overset{iid}{\\sim} f(X; \\theta^*)\\). Un estimador \\(\\tilde \\theta_n\\) es insesgado si satisface que \\[\\mathbb{E}[\\tilde \\theta_n] =\\theta^*.\\] El sesgo del estimador es precisamente la diferencia: \\(\\textsf{Sesgo} = \\mathbb{E}[\\tilde \\theta_n] - \\theta^*.\\) Ejemplo: Información de Fisher En el caso Bernoulli obtenemos \\(I_n(\\theta) = \\frac{n}{\\theta(1-\\theta)}\\), si \\(n = 20\\) podemos comparar con \\(\\theta=0.5, 0.7, 0.8\\), library(patchwork) # Verosimilitud X_1,...,X_n ~ Bernoulli(theta) L_bernoulli <- function(n, S){ function(theta){ theta ^ S * (1 - theta) ^ (n - S) } } xy <- data.frame(x = 0:1) l_b1 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 10)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 10") + ylim(0, 5e-05) l_b2 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 14)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 14") + ylim(0, 5e-05) l_b3 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 16)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 19") + ylim(0, 5e-05) l_b1 + l_b2 + l_b3 Ejemplo: Normalidad Regresando a nuestro ejemplo. Veremos empiricamente que el estimador \\(\\hat \\theta_n\\) es asintóticamente normal. Esta propiedad la hemos visto anteriormente para un caso muy particular. Lo vimos en el TLC para el caso de promedios, \\(\\bar X_n,\\) que en nuestro ejemplo corresponde a \\(\\hat p_n\\). Como hemos visto, esta propiedad la satisface cualquier otro estimador que sea máximo verosímil. Por ejemplo, podemos utilizar el \\(\\mathsf{MLE}\\) de los momios. La figura que sigue muestra la distribución de \\(\\hat \\theta_n\\) para distintas remuestras \\((B = 500)\\) con distintos valores de \\(n.\\) El gráfico anterior valida empíricamente la distribución asintótica para casos de muchas observaciones. A continuación ilustraremos cómo explotar este resultado para obtener intervalos de confianza. Para el caso de \\(\\hat p_n\\) hemos visto que el error estándar se calcula analíticamente como \\[\\textsf{ee}_p^2 = \\mathbb{V}(\\hat p_n) = \\mathbb{V}\\left(\\frac1n \\sum_{i = 1}^n x_i\\right) = \\frac{p^* (1 - p^*)}{n}.\\] Éste empata con el valor del error estándar asintótico \\[\\textsf{ee}_p^2 \\approx \\sqrt{\\frac{1}{I_n(p^*)}},\\] pues la información de Fisher es igual a \\[I_n(p) = n \\, I(p) = \\frac{n}{p ( 1- p)}.\\] En este caso podemos utilizar el estimador plug-in, \\(\\hat{\\textsf{ee}}_p = \\textsf{ee}_p(\\hat p_n).\\) Para estimar el momio, \\(\\theta,\\) el cálculo no es tan fácil pues tendríamos que calcular de manera analítica la varianza de un cociente \\[\\textsf{ee}_\\theta^2 = \\mathbb{V}\\left( \\frac{\\hat p_n}{1-\\hat p_n}\\right).\\] Utilizando la distirbución asintótica, el error estándar se puede calcular mediante \\[\\textsf{ee}_\\theta \\approx \\sqrt{\\frac{1}{I_n(\\theta^*)}} = \\sqrt{\\frac{\\theta (1 + \\theta)^2 }{n}}.\\] A continuación mostramos los errores estándar para nuestro ejemplo utilizando la distribución asintótica y por medio de la distribución de bootstrap. Como es de esperarse, ambos coinciden para muestras relativamente grandes. # Genero muestra muestras <- tibble(tamanos = 2**seq(4,7)) %>% mutate(obs = map(tamanos, ~rbernoulli(., p = p_true))) calcula_momio <- function(x){ x / (1 - x) } calcula_ee_momio <- function(x){ sqrt(((1+x)**2) * x) } # Calculo MLE muestras_est <- muestras %>% group_by(tamanos) %>% mutate(media_hat = map_dbl(obs, mean), media_ee = sqrt(media_hat * (1 - media_hat)/tamanos), momio_hat = calcula_momio(media_hat), momio_ee = calcula_ee_momio(momio_hat)/sqrt(tamanos)) # Calculo por bootstrap muestras_boot <- muestras_est %>% group_by(tamanos) %>% mutate(sims_muestras = map(tamanos, ~rerun(1000, sample(muestras %>% filter(tamanos == ..1) %>% unnest(obs) %>% pull(obs), size = ., replace = TRUE))), sims_medias = map(sims_muestras, ~map_dbl(., mean)), sims_momios = map(sims_medias, ~map_dbl(., calcula_momio)), media_boot = map_dbl(sims_medias, mean), momio_boot = map_dbl(sims_momios, mean), media_ee_boot = map_dbl(sims_medias, sd), momio_ee_boot = map_dbl(sims_momios, sd) ) ## # A tibble: 4 × 5 ## # Groups: tamanos [4] ## tamanos momio_hat momio_boot momio_ee momio_ee_boot ## <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 16 0.333 0.367 0.192 0.236 ## 2 32 0.333 0.342 0.136 0.140 ## 3 64 0.123 0.123 0.0492 0.0498 ## 4 128 0.407 0.417 0.0793 0.0800 Comprueba las fórmulas para los errores estándar tanto para la probabilidad de éxito como para los momios. El método delta El ejercicio anterior nos sugiere una pregunta natural: Cómo establecer la distribución asintótica de un estimador cuando ya se conoce la de una pre-imagen de él? Es decir, si ya conocemos la distribución de \\(\\theta,\\) podemos establecer la distribución de \\(\\tau = g(\\theta)?\\) La respuesta es afirmativa y la enunciamos por medio de un teorema. El resultado se conoce como el método delta. Teorema. Si \\(\\tau = g(\\theta)\\) es una función diferenciable y \\(g'(\\theta) \\neq 0\\), entonces \\[\\hat \\tau_n \\overset{d}{\\rightarrow} \\mathsf{N}( \\tau^*, \\hat{\\mathsf{ee}}^2_\\tau),\\] donde \\(\\hat \\tau_n = g(\\hat \\theta_n)\\) y \\[\\hat{\\mathsf{ee}}_\\tau = \\bigg| g'(\\hat \\theta_n) \\bigg| \\times \\hat{\\mathsf{ee}}_\\theta(\\hat \\theta_n).\\] Por ejemplo, este resultado lo podemos utilizar para nuestro experimento de Bernoullis. Pues \\(g(p) = \\frac{p}{1-p}\\) es una función diferenciable y por lo tanto \\[\\hat{\\mathsf{ee}}_\\theta = \\sqrt{\\frac1n} \\times \\left[ \\hat p_n^{1/2} (1-\\hat p_n)^{-3/2}\\right].\\] Comprueba la fórmula del método delta para el momio en función de la fracción de éxitos, y también comprueba que de el mismo resultado analítico que habías calculado en el ejercicio anterior. Optimalidad del \\(\\textsf{MLE}\\) Consideremos el caso de una muestra iid \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\theta, \\sigma^2).\\) Y consideremos dos estimadores para \\(\\theta.\\) El primero será la media muestral \\(\\bar X_n\\) y el segundo la mediana muestral, la cual denotaremos por \\(\\tilde \\theta_n.\\) Sabemos que ambos son insesgados. Por lo tanto, en promedio emiten estimaciones correctas. Pero ¿cómo escogemos cual utilizar? Un criterio para comparar estimadores es el error cuadrático medio (\\(\\textsf{ECM}\\), por sus siglas en inglés). Definición. El error cuadrático medio de un estimador \\(\\tilde \\theta_n\\) se calcula como \\[\\textsf{ECM}[\\tilde \\theta_n] = \\mathbb{E}[(\\tilde \\theta_n - \\theta^*)^2].\\] Por lo tanto, el \\(\\textsf{ECM}\\) mide la distancia promedio entre el estimador y el valor verdadero valor del parámetro. La siguiente igualdad es bastante útil para comparar dos estimadores. \\[\\textsf{ECM}[\\tilde \\theta_n] = \\mathbb{V}\\left(\\tilde \\theta_n\\right) + \\textsf{Sesgo}\\left[\\tilde \\theta_n\\right]^2.\\] Por lo tanto si dos estimadores son insesgados, uno es más eficiente que el otro si su varianza es menor. La media sabemos que es el \\(\\textsf{MLE}\\) y por el TCL tenemos que \\[\\sqrt{n} \\left( \\bar X_n - \\theta \\right) \\overset{d}{\\rightarrow} \\mathsf{N}( 0, \\sigma^2).\\] La mediana, en contraste, tiene una distribución asintótica \\[\\sqrt{n} \\left( \\tilde X_n - \\theta \\right) \\overset{d}{\\rightarrow} \\mathsf{N}\\left( 0, \\sigma^2 \\frac{\\pi}{2}\\right),\\] es decir tiene una varianza ligeramente mayor. Por lo tanto, decimos que la mediana tiene una eficiencia relativa con respecto a la media del \\(.63 \\% (\\approx 2/\\pi)\\). Es decir, la mediana sólo utliza una fracción de los datos comparado con la media. El siguiente teorema, la desigualdad de Cramer-Rao, nos permite establecer esta resultado de manera mas general para cualquier estimador insesgado. Teorema. Sea \\(\\tilde \\theta_n\\) cualquier estimador insesgado de \\(\\theta\\) cuyo valor verdadero es \\(\\theta^*,\\) entonces \\[\\begin{align} \\mathbb{V}(\\tilde \\theta_n) \\geq \\frac{1}{n I(\\theta^*)}. \\end{align}\\] Un estimador insesgado que satisfaga esta desigualdad se dice que es eficiente. Nota que el lado derecho de la desigualdad es precisamente la varianza asintótica del \\(\\textsf{MLE}.\\) Por lo tanto, éste es asintóticamente eficiente. Es importante hacer enfásis en que la optimalidad del \\(\\textsf{MLE}\\) es un resultado asintótico. Es decir, sólo se satisface cuando tenemos un número suficiente de observaciones. Qué tan grande debe ser el tamaño de muestra varia de problema a problema. Es por esto que para muestras de tamaño finito se prefieren estimadores que minimicen el \\(\\textsf{ECM},\\) como cuando hacemos regresión ridge o utilizamos el estimador James–Stein para un vector de medias. Referencias "],["más-de-pruebas-de-hipótesis-e-intervalos.html", "Sección 9 Más de pruebas de hipótesis e intervalos Prueba de Wald Observación: pruebas \\(t\\) y práctica estadística Prueba de Wald para dos medias o proporciones Datos pareados Pruebas de cociente de verosimilitud Otro tipo de pruebas Errores tipo I y tipo II Consideraciones prácticas Pruebas múltiples", " Sección 9 Más de pruebas de hipótesis e intervalos En esta sección veremos enfoques más clásicos para analizar una prueba de hipótesis, en particular veremos situaciones donde podemos hacer algunos supuestos teóricos acerca de la distribución de las poblaciones. Esta es una sección complementaria para entender prácticas estadísticas usuales: recuerda que discutimos antes que hacer estimación por intervalos generalmente es más útil que hacer pruebas de hipótesis, y adicionalmente, tenemos también la técnica de pruebas de permutaciones que podemos aplicar en muchos de los casos que discutiremos a continuación. El enfoque básico es el mismo que cuando vimos pruebas de permutaciones: calculamos una estadística de prueba de los datos y luego, con una distribución de referencia (asociada a la hipótesis nula), calculamos un valor-\\(p\\). Si el valor-\\(p\\) es chico, entonces los resultados observados no pueden explicarse fácilmente por variación muestral, y rechazamos la hipótesis nula. Con esta idea básica, y supuestos distribucionales acerca de las poblaciones, podemos construir pruebas que requieren menos cómputo. La desventaja es que hay que checar con cuidado los supuestos distribucionales que hagamos. Si los supuestos son incorrectos, las valores-\\(p\\) no tienen mucho sentido y son difíciles de interpretar. Para esta sección seguiremos más a Wasserman (2013) (capítulo 10), pero puedes revisar también Chihara and Hesterberg (2018) (capítulo 8). Prueba de Wald Como hemos visto, existe normalidad asintótica en varios estimadores que hemos considerado, como medias y proporciones muestrales. También vimos que estimadores de máxima verosimilitud cumplen muchas veces un teorema central del límite. Así que supongamos que tenemos una estadística \\(\\hat{\\theta}_n\\) que estima \\(\\theta\\) y es asintóticamente insesgada y normal. Denotamos por \\(\\hat{\\textsf{ee}}\\) una estimación de su error estándar —hay distintas maneras de hacerlo: por ejemplo, con simulación (bootstrap), o por medios analíticos (teoría). Recuerda que el error estándar de una estadística es la desviación estándar de su distribución de muestreo. Si nos interesa probar la hipótesis de que \\(\\theta = 125\\), por ejemplo, y \\(\\hat{\\theta}_n\\) es aproximadamente normal, entonces podemos construir una distribución de referencia aproximada como sigue: Si la nula es cierta, entonces la distribución de muestreo de \\(\\hat{\\theta}\\) es aproximadamente \\(\\mathsf{N}(125, \\hat{\\textsf{ee}})\\). Esto implica que la siguiente estadística \\(W\\) es aproximadamente normal estándar bajo la nula: \\[W = \\frac{\\hat{\\theta} - 125}{\\hat{\\textsf{ee}}} \\sim \\mathsf{N}(0,1)\\] Por lo que valores lejanos de \\([-2,2]\\), por ejemplo, dan evidencia en contra de la hipótesis nula. Como \\(W\\) no depende de ningún parámetro desconocido, podemos usarla como distribución de referencia para comparar el valor de \\(W\\) que obtuvimos en la muestra. Si observamos para nuestra muestra un valor \\(W=w\\) entonces, el valor-\\(p\\) (dos colas) de esta prueba es, aproximadamente, \\[\\mathsf{valor-}p \\approx P(|Z| > |w|) = 2(1 - \\Phi(|w|))\\] donde \\(Z\\sim \\mathsf{N}(0,1)\\) y \\(\\Phi\\) es su función de distribución acumulada. Ejemplo: media muestral. La media nacional de las escuelas de enlace está alrededor de 454 (matemáticas en 6o. grado). Tomamos una muestra de 180 escuelas del Estado de México, y queremos saber si la media obtenida es consistente o no con la media nacional. Ya que estamos usando como estimador una media de una muestra iid, podemos estimar el error estándar de la media con \\[\\hat{\\textsf{ee}} = s / \\sqrt{n}\\] Obtenemos: set.seed(29) muestra_edomex <- read_csv("data/enlace.csv") |> filter(estado == "ESTADO DE MEXICO") |> sample_n(180) resumen <- muestra_edomex |> summarise(media = mean(mate_6), s = sd(mate_6), n = n()) |> mutate(ee = s / sqrt(n)) resumen ## # A tibble: 1 × 4 ## media s n ee ## <dbl> <dbl> <int> <dbl> ## 1 456. 155. 180 11.5 La hipótesis nula es que la media poblacional del Estado de México es igual a 454. Calculamos el valor-\\(p\\) usando la prueba de Wald: dif <- (resumen |> pull(media)) - 454 ee <- resumen |> pull(ee) w <- dif / ee p <- 2 * (1 - pt(abs(w), 179)) p ## [1] 0.8413082 y vemos que esta muestra es consistente con la media nacional. No tenemos evidencia en contra de que la media del estado de México es muy similar a la nacional. Repite esta prueba con una muestra de Chiapas. ¿Qué resultado obtienes? Tenemos entonces: Prueba de Wald. Consideramos probar la hipótesis nula \\(H_0: \\theta = \\theta_0\\) contra la alternativa \\(H_1: \\theta \\neq \\theta_0\\). Suponemos que \\(\\hat{\\theta}_n\\) es asintóticamente normal e insesgada, de modo que bajo la hipótesis nula \\[\\frac{\\hat{\\theta}_n - \\theta_0}{\\hat{\\textsf{ee}}} \\sim \\mathsf{N}(0,1).\\] Entonces el valor-\\(p\\) de la prueba de Wald para esta hipótesis nula es \\[\\mathsf{valor-}p \\approx P(|Z| > |w|) = 2(1 - \\Phi(|w|)).\\] Ejemplo. Podemos hacer la prueba de Wald para proporciones con el estimador usual \\(\\hat{p}_n\\) que estima una proporción poblacional \\(p\\). En este caso, utilizamos la estimación usual del error estándar de \\(\\hat{p}_n\\), que está dada por \\[\\hat{\\textsf{ee}} = \\sqrt{\\frac{\\hat{p}_n(1-\\hat{p}_n)}{n}}.\\] Supongamos por ejemplo que en nuestros datos observamos que en \\(n=80\\) muestras independientes, tenemos \\(x=47\\) éxitos. ¿Es esto consistente con la hipótesis nula \\(p = 0.5\\)? Calcuamos primero: p_hat <- 47 / 80 ee <- sqrt(p_hat * (1 - p_hat) / 80) y la estadística \\(W\\) de prueba es: w <- (p_hat - 0.5) / ee w ## [1] 1.58978 Calculamos su valor p: valor_p <- 2 * (1 - pnorm(abs(w))) valor_p ## [1] 0.1118843 Y vemos que en este caso tenemos evidencia baja de que la proporción poblacional es distinta de 0.5. Observación: pruebas \\(t\\) y práctica estadística Con más supuestos distribucionales podemos hacer otros tipos de pruebas donde no requerimos hacer supuestos asintóticos. Por ejemplo, si suponemos que la muestra obtenida \\(X_1,\\ldots, X_n\\) proviene de una distribución normal \\(\\mathsf{N}(\\mu, \\sigma)\\) (cosa que es necesario verificar), entonces es posible demostrar que la estadística \\[T = \\frac{\\bar{X} - \\mu}{S / \\sqrt{n}}\\] tiene una distribución exacta que es \\(t\\) de Student con \\(n-1\\) grados de libertad, y no depende de otros parámetros, de manera que podemos usarla como distribución de referencia y podemos calcular valores \\(p\\) exactos (revisa la sección 8.1 de Chihara and Hesterberg (2018)). La diferencia con usar una prueba de Wald está en que aquí consideramos también la variablidad del error estándar estimado, lo que correctamente sugiere que esperamos variaciones proporcionalmente más grandes en \\(T\\) comparado con lo que sucede si no consideramos esta variación (como en la prueba de Wald). Sin embargo: Si la muestra \\(n\\) es grande, la distribución \\(t\\) de Student con \\(n-1\\) grados de libertad es muy similar a la normal estándar, de manera que la aproximación de Wald es apropiada. Cuando la muestra \\(n\\) es chica, es difícil validar el supuesto de normalidad, a menos que tengamos alguna información adicional acerca de la distribución poblacional. La prueba tiene cierta robustez a desviaciones de normalidad de las observaciones, pero si el sesgo es muy grande, por ejemplo, el supuesto es incorrecto y da valores \\(p\\) distorsionados. Puedes ver aquí, o el apéndice B.11 de Chihara and Hesterberg (2018) para ver descripciones de la distribución \\(t\\) y cómo se compara con una normal estándar dependiendo de los grados de libertad. En muchas ocasiones, en la práctica es común no checar supuestos y saltar directamente a hacer pruebas \\(t\\), lo cual no es muy seguro. Si tenemos duda de esos supuestos, podemos hacer pruebas gráficas o de permutaciones, si son apropiadas. Prueba de Wald para dos medias o proporciones Cuando tenemos dos muestras extraidas de manera independiente de dos poblaciones distintas, y queremos ver si la hipótesis de medias poblacionales iguales es consistente con los datos, podemos usar también una prueba de Wald. Sea \\(\\bar{X}_1\\) y \\(\\bar{X}_2\\) las medias muestrales correspondientes. Si la hipótesis de normalidad aplica para ambas distribuciones muestrales (normalidad asintótica), la variable \\[\\hat{\\delta} = \\bar{X}_1 - \\bar{X}_2\\] es aproximadamente normal con media \\(\\mathsf{N}(\\mu_1 - \\mu_2, \\textsf{ee})\\), donde \\(\\mu_1\\) y \\(\\mu_2\\) son las medias poblacionales correspondientes, y donde el error estándar de \\(\\hat{\\delta}\\) es la raíz de la suma de los cuadrados de los errores estándar de \\(\\bar{X}\\) y \\(\\bar{Y}\\): \\[ \\textsf{ee} = \\sqrt{\\textsf{ee}_1^2 + \\textsf{ee}_{2}^2}.\\] Se sigue entonces que: \\[\\textsf{ee} =\\sqrt{\\frac{\\sigma_1^2}{n_1}+\\frac{\\sigma_2^2}{n_2} }\\] (Nota: usa probabilidad para explicar por qué es cierto esto). De esto se deduce que bajo la hipótesis nula de igualdad de medias \\(\\mu_1 = \\mu_2\\), tenemos que la estadística de Wald \\[W = \\frac{\\hat{\\delta} - 0}{\\sqrt{\\frac{s_1^2}{n_1}+\\frac{s_2^2}{n_2}} } \\sim \\mathsf{N}(0,1)\\] es aproximamente normal estándar. Procedemos entonces a calcular el valor \\(p\\) usando la función de distribución acumulada de la normal estándar. En el caso particular de proporciones, podemos simplificar, como hicimos arriba, a \\[W = \\frac{\\hat{p}_1 - \\hat{p}_2}{\\sqrt{\\frac{\\hat{p}_1(1-\\hat{p}_1)}{n_1}+\\frac{\\hat{p}_2(1-\\hat{p}_2)}{n_2}} } \\sim \\mathsf{N}(0,1)\\] Haz una prueba comparando las medias en enlace de la Ciudad de México vs Estado de México. ¿Hay evidencia de que tienen distintas medias? Ejemplo (Wasserman (2013)). Supongamos tenemos dos conjuntos de prueba para evaluar algoritmos de predicción, de tamaños \\(n_1=100\\) y \\(n_2=250\\) respectivamente, tenemos dos algoritmos para generar predicciones de clase (digamos positivo y negativo). Usaremos el primer conjunto para evaluar el algoritmo 1 y el segundo para evaluar el algoritmo 2. El algoritmo 1 corre en 1 hora, y el algoritmo 2 tarda 24 horas. Supón que obtenemos que la tasa de clasificación correcta del primer algoritmo es \\(\\hat{p}_1 = 0.85\\), y la tasa del segundo es de \\(\\hat{p}_2 = 0.91\\). ¿Estos datos son consistentes con la hipótesis de que los algoritmos tienen desempeño muy similar? Es decir, queremos probar la hipótesis \\(p_1 = p_2\\). Calculamos la estadística de Wald: n_1 <- 100 n_2 <- 250 p_hat_1 <- 0.86 p_hat_2 <- 0.90 ee <- sqrt(p_hat_1 * (1 - p_hat_1) / n_1 + p_hat_2 * (1 - p_hat_2) / n_2) delta = p_hat_1 - p_hat_2 w <- delta / ee w ## [1] -1.011443 que da un valor p de: 2 * (1 - pnorm(abs(w))) ## [1] 0.3118042 Y vemos que valor-\\(p\\) es grande, de forma que los datos son consistentes con la hipótesis de que los algoritmos tienen desempeño similar. ¿Cómo tomaríamos nuestra decisión final? Si la diferencia entre 1 hora y 24 horas no es muy importante, entonces preferíamos usar el algoritmo 2. Sin embargo, si el costo de 24 horas es más alto que 1 hora de corrida, los datos no tienen indicios fuertes de que vayamos a perder en desempeño, y podriamos seleccionar el algoritmo 1. Datos pareados Las pruebas que acabamos de ver para comparar medias requieren poblaciones independientes. Si las dos muestras están pareadas (es decir, son dos mediciones en una misma muestra), podemos tomar considerar las diferencias \\(D_i = X_i - Y_i\\) y utilizar la prueba para una sola muestra con la media \\(\\bar{D}\\). Esta es una prueba de Wald pareada. Ejemplo (Wasserman (2013)). Ahora supongamos que utilizamos la misma muestra de tamaño \\(n=300\\) para probar los dos algoritmos. En este caso, no debemos hacer la prueba para medias de muestras independientes. Sin embargo, esto podemos ponerlo en términos de una prueba para una sola muestra. Tenemos las observaciones \\(X_1,\\ldots, X_n\\) y \\(Y_1,\\dots, Y_n\\), donde \\(X_i=1\\) si el algoritmo 1 clasifica correctamente, y 0 en otro caso. Igualmente, \\(Y_i=1\\) si el algoritmo 2 clasifica correctamente, y 0 en otro caso. Definimos \\[D_i= X_i - Y_i\\] Y \\(D_1,\\ldots, D_n\\) es una muestra iid. Ahora observemos que la media \\(\\bar{D}\\) tiene valor esperado \\(p_1 - p_2\\), donde \\(p_1\\) y \\(p_2\\) son las tasas de correctos del algoritmo 1 y del algoritmo 2 respectivamente. Podemos hacer una prueba de Wald como al principio de la sección: \\[W = \\frac{\\bar{D} - 0}{{\\textsf{ee}}}\\] Y notemos que el error estándar no se calcula como en el ejemplo anterior. Podríamos usar bootstrap para estimarlo, pero en este caso podemos usar el estimador usual \\[\\hat{\\textsf{ee}} = S / \\sqrt{n}\\] donde \\[S = \\frac{1}{n}\\sum_{i=1}^n (D_i - \\bar{D})^2\\] y nótese que necesitamos las decisiones indiviudales de cada algoritmo para cada caso, en contraste al ejemplo anterior de muestras independientes donde los errores estándar se calculaban de manera independiente. Esto tiene sentido, pues la variablidad de \\(\\bar{D}\\) depende de cómo están correlacionados los aciertos de los dos algoritmos. Supongamos por ejemplo que los datos que obtenemos son: datos_clasif |> head() ## # A tibble: 6 × 3 ## caso x y ## <chr> <dbl> <dbl> ## 1 1 1 1 ## 2 2 0 1 ## 3 3 0 1 ## 4 4 0 1 ## 5 5 0 1 ## 6 6 1 0 Como explicamos arriba, nos interesa la diferencia. Calculamos \\(d\\): datos_clasif <- datos_clasif |> mutate(d = x - y) datos_clasif |> head() ## # A tibble: 6 × 4 ## caso x y d ## <chr> <dbl> <dbl> <dbl> ## 1 1 1 1 0 ## 2 2 0 1 -1 ## 3 3 0 1 -1 ## 4 4 0 1 -1 ## 5 5 0 1 -1 ## 6 6 1 0 1 datos_clasif |> summarise(sd_x = sd(x), sd_y = sd(y), sd_d = sd(d)) ## # A tibble: 1 × 3 ## sd_x sd_y sd_d ## <dbl> <dbl> <dbl> ## 1 0.393 0.309 0.539 Y ahora calculamos la media de \\(d\\) (y tasa de correctos de cada clasificador:) medias_tbl <- datos_clasif |> summarise(across(where(is.numeric), mean, .names = "{col}_hat")) d_hat <- pull(medias_tbl, d_hat) medias_tbl ## # A tibble: 1 × 3 ## x_hat y_hat d_hat ## <dbl> <dbl> <dbl> ## 1 0.81 0.893 -0.0833 Ahora necesitamos calcular el error estándar. Como explicamos arriba, hacemos ee <- datos_clasif |> mutate(d_hat = mean(d)) |> mutate(dif_2 = (d - d_hat)) |> summarise(ee = sd(dif_2) / sqrt(n())) |> pull(ee) ee ## [1] 0.03112829 Y ahora podemos calcular la estadística \\(W\\) y el valor p correspondiente: w <- d_hat / ee valor_p <- 2 * (1 - pnorm(abs(w))) c(w = w, valor_p = valor_p) |> round(3) ## w valor_p ## -2.677 0.007 Y vemos que tenemos evidencia considerable de que el desempeño no es el mismo: el algoritmo 2 parece ser mejor. ¿Qué pasaría si incorrectamente usaras la prueba de dos muestras para este ejemplo? ¿Qué cosa cambia en la fórmula de la estadística de Wald? Pruebas de cociente de verosimilitud Otra técnica clásica para hacer pruebas de hipótesis es el de cociente de verosimilitudes. Con esta técnica podemos hacer pruebas que involucren varios parámetros, y podemos contrastar hipótesis nulas contra alternativas especificas. Para aplicar este tipo de pruebas es necesario hacer supuestos distribucionales (modelos probabilísticos), pues estas pruebas se basan en la función de verosimilitud \\(\\mathcal{L}(\\theta; x_1,\\ldots, x_n)\\). Ejemplo. Supongamos que tenemos la hipótesis nula de que una moneda es justa (\\(p =0.5\\) de sol). En 120 tiros de la moneda (que suponemos independientes), observamos 75 soles. Recordemos la función de log-verosimilitud para el modelo binomial (ignorando constantes que no dependen de \\(p\\)) es \\[\\ell(p) = 75 \\log(p) + (120 - 75)\\log(1-p) \\] Primero calculamos el estimador de máxima verosimilitud de \\(p\\), que es \\(\\hat{p} = 75/120 = 0.625\\). Evaluamos la verosimilitud \\[\\ell(\\hat{p}) = \\ell(0.625) = 75\\log(0.625) + 45\\log(0.375) = -79.388\\] - Ahora evaluamos la verosimlitud según la hipótesis nula, donde asumimos que \\(p = 0.5\\): \\[\\ell(p_0) = \\ell(0.5) = 75\\log(0.5) + 45\\log(0.5) = -83.177\\] - Finalmente, contrastamos estos dos números con una estadística que denotamos con \\(\\lambda\\): \\[\\lambda = 2\\left[\\ell(\\hat{p}) - \\ell(p_0)\\right] = 2[\\ell(0.625)- \\ell(0.5)] = 2(3.79)=7.58\\] A \\(\\lambda\\) se le llama la estadística de cociente de verosimilitud. Tomamos la diferencia de log verosimilitudes, que es los mismo que tomar el logaritmo del cociente de verosimilitudes, y de ahí el nombre de la prueba. Nótese que cuando este número \\(\\lambda\\) es muy grande, esto implica que la hipótesis nula es menos creíble, o menos consistente con los datos, pues la nula tiene mucho menos verosimilitud de lo que los datos indican. Por otro lado, cuando este valor es cercano a 0, entonces tenemos menos evidencia en contra de la hipótesis nula. Esto se explica en la siguiente gráfica: log_verosim <- function(p){ 75 * log(p) + (120 - 75) * log(1 - p) } verosim_tbl <- tibble(p = seq(0.4, 0.7, 0.01)) |> mutate(log_verosim = log_verosim(p)) ggplot(verosim_tbl, aes(x = p, y = log_verosim)) + geom_line() + geom_segment(x = 75/120, xend = 75/120, y = -130, yend = log_verosim(75/120), colour = "red") + geom_segment(x = 0.5, xend = 0.5, y = -130, yend = log_verosim(0.5), colour = "gray") + geom_errorbar(aes(x = 0.5, ymin = log_verosim(0.5), ymax = log_verosim(75/120)), colour = "orange", width = 0.05) + annotate("text", x = 0.48, y = -81.5, label = "3.79") + annotate("text", x = 0.515, y = -91, label ="nula", colour = "gray20") + annotate("text", x = 0.665, y = -91, label ="max verosímil", colour = "red") + labs(subtitle = expression(paste(lambda, "=2(3.79)=7.58"))) Este método puede generalizarse para que no solo aplique a hipótesis nulas donde \\(\\theta = \\theta_0\\), sino en general, \\(\\theta \\in \\Theta_0\\). Por ejemplo, podemos construir pruebas para \\(\\theta < 0.4\\). Definición. Consideramos la hipótesis nula \\(\\theta= \\theta_0\\). La estadística del cociente de verosimilitudes está dada por: \\[\\lambda = 2\\log\\left( \\frac{\\max_{\\theta}\\mathcal{L}(\\theta)}{\\max_{\\theta=\\theta_0}\\mathcal{L}(\\theta)} \\right ) = 2\\log\\left( \\frac{\\mathcal{L}(\\hat{\\theta})}{\\mathcal{L}(\\theta_0)} \\right)\\] donde \\(\\hat{\\theta}\\) es el estimador de máxima verosimilitud. Para construir una prueba asociada, como siempre, necesitamos una distribución de referencia. Esto podemos hacerlo con simulación, o usando resultados asintóticos. Distribución de referencia para pruebas de cocientes Para nuestro ejemplo anterior, podemos simular datos bajo la hipótesis nula, y ver cómo se distribuye la estadística \\(\\lambda\\): Ejemplo. Simulamos bajo la hipótesis nula como sigue: n_volados <- 120 # número de volados simulados_nula <- rbinom(4000, n_volados, p = 0.5) lambda <- function(n, x, p_0 = 0.5){ # estimador de max verosim p_mv <- x / n # log verosimilitud bajo mv log_p_mv <- x * log(p_mv) + (n - x) * log(1 - p_mv) # log verosimllitud bajo nula log_p_nula <- x * log(p_0) + (n - x) * log(1 - p_0) lambda <- 2*(log_p_mv - log_p_nula) lambda } lambda_obs <- lambda(n_volados, 75, 0.5) sims_tbl <- tibble(sim_x = simulados_nula) |> mutate(lambda = map_dbl(sim_x, ~ lambda(n_volados, .x, p_0 = 0.5))) ggplot(sims_tbl, aes(x = lambda)) + geom_histogram(binwidth = 0.7) + geom_vline(xintercept = lambda_obs, color = "red") Con esta aproximación a la distribución de referencia podemos calcular el valor p en nuestro ejemplo anterior: valor_p <- mean(sims_tbl$lambda >= lambda_obs) valor_p ## [1] 0.00675 y observamos que tenemos evidencia fuerte en contra de la hipótesis nula: la moneda no está balanceada. Ejemplo. Este ejemplo es un poco artificial, pero lo usamos para entender mejor las pruebas de cocientes de verosimlitud. Supongamos que tenemos una muestra de \\(\\mathsf{N}(\\mu, 1)\\), y queremos probar si \\(\\mu = 8\\). Asumimos que el supuesto de normalidad y desviación estándar iugal a 1 se cumplen. set.seed(3341) n_muestra <- 100 muestra_1 <- rnorm(n_muestra, 7.9, 1) crear_log_p <- function(x){ # crear log verosim para dos muestras normales independientes. log_p <- function(params){ mu <- params[1] log_vero <- dnorm(x, mean = mu, sd = 1, log = TRUE) |> sum() log_vero } } lambda_calc <- function(muestra, crear_log_p){ log_p <- crear_log_p(muestra) res <- optim(c(0), log_p, control = list(fnscale = -1)) lambda_mv <- log_p(res$par) lambda_nula <- log_p(8.0) lambda <- 2 * (lambda_mv - lambda_nula) lambda } lambda <- lambda_calc(muestra_1, crear_log_p) lambda ## [1] 2.101775 Ahora construimos con simulación la distribución de referencia usando simulaciones bajo la nula sims_nula <- map(1:10000, ~ rnorm(n_muestra, 8, 1)) lambda_nula_sim <- map_dbl(sims_nula, ~ lambda_calc(.x, crear_log_p)) tibble(lambda = lambda_nula_sim) |> ggplot(aes(x = lambda)) + geom_histogram() + geom_vline(xintercept = lambda, colour = "red") valor_p <- mean(lambda_nula_sim >= lambda) valor_p ## [1] 0.1537 Estos datos muestran consistencia con la hipótesis \\(\\mu = 8\\). Discusión: Nota en los dos ejemplos anteriores la similitud entre las distribuciones de referencia. En ambos casos, estas distribuciones resultan ser aproximadamente \\(\\chi\\)-cuadrada con 1 grado de libertad (ji-cuadrada). Podemos checar para el último ejemplo: teorica <- tibble(x = seq(0.1, 10, 0.01)) |> mutate(f_chi_1 = dchisq(x, df = 1)) tibble(lambda = lambda_nula_sim) |> ggplot() + geom_histogram(aes(x = lambda, y = ..density..), binwidth = 0.1) + geom_line(data = teorica, aes(x = x, y = f_chi_1), colour = "red") O mejor, con una gráfica de cuantiles de las simulaciones vs la téorica: tibble(lambda = lambda_nula_sim) |> ggplot(aes(sample = lambda)) + geom_qq(distribution = stats::qchisq, dparams = list(df = 1)) + geom_qq_line(distribution = stats::qchisq, dparams = list(df = 1)) Este resultado asintótico no es trivial, y se usa comúnmente para calcular valores \\(p\\). Discutiremos más este punto más adelante. Otro tipo de pruebas Con cocientes de verosimlitud podemos diseñar pruebas para contrastar condiciones que sólo un subconjunto de parámetros cumple. Ejemplo. Supongamos que queremos hacer una prueba de igualdad de medias \\(\\mu_1 = \\mu_2\\) para dos poblaciones normales \\(\\mathsf{N}(\\mu_1, \\sigma_1)\\) y \\(\\mathsf{N}(\\mu_2, \\sigma_2)\\), donde extraemos las muestras de manera independiente, y no conocemos las desviaciones estándar. Obtenemos dos muestras (que supondremos provienen de distribuciones normales, pues ese es nuestro supuesto) set.seed(223) muestra_1 <- rnorm(80, 0.8, 0.2) muestra_2 <- rnorm(120, 0.8, 0.4) Necesitamos: 1) calcular el valor de la estadística \\(\\lambda\\) de cociente de verosimilitudes, 2) Calcular la distribución de referencia para \\(\\lambda\\) bajo la hipótesis nula y finalmente 3) Ver qué tan extremo es el valor obtenido de \\(\\lambda\\) en relación a la distribución de referencia. crear_log_p <- function(x, y){ # crear log verosim para dos muestras normales independientes. log_p <- function(params){ mu_1 <- params[1] mu_2 <- params[2] sigma_1 <- params[3] sigma_2 <- params[4] log_vero_1 <- dnorm(x, mean = mu_1, sd = sigma_1, log = TRUE) |> sum() log_vero_2 <- dnorm(y, mean = mu_2, sd = sigma_2, log = TRUE) |> sum() log_vero <- log_vero_1 + log_vero_2 #se suman por independiencia log_vero } } log_p <- crear_log_p(muestra_1, muestra_2) crear_log_p_nula <- function(x, y){ log_p <- function(params){ # misma media mu <- params[1] sigma_1 <- params[2] sigma_2 <- params[3] log_vero_1 <- dnorm(x, mean = mu, sd = sigma_1, log = TRUE) |> sum() log_vero_2 <- dnorm(y, mean = mu, sd = sigma_2, log = TRUE) |> sum() log_vero <- log_vero_1 + log_vero_2 #se suman por independiencia log_vero } } log_p_nula <- crear_log_p_nula(muestra_1, muestra_2) Ahora tenemos el problema de que no conocemos las sigma. Estas deben ser estimadas para después calcular el cociente de verosimilitud: res <- optim(c(0, 0, 1, 1), log_p, method = "Nelder-Mead", control = list(fnscale = -1)) res$convergence ## [1] 0 est_mv <- res$par names(est_mv) <- c("mu_1", "mu_2", "sigma_1", "sigma_2") est_mv ## mu_1 mu_2 sigma_1 sigma_2 ## 0.8153471 0.7819913 0.1987545 0.3940484 Y tenemos lambda_1 <- log_p(est_mv) lambda_1 ## [1] -42.76723 Ahora calculamos el máximo bajo el supuesto de la hipótesis nula: res <- optim(c(0, 1, 1), log_p_nula, method = "Nelder-Mead", control = list(fnscale = -1)) res$convergence ## [1] 0 est_mv_nula <- res$par names(est_mv) <- c("mu", "sigma_1", "sigma_2") est_mv_nula ## [1] 0.8062091 0.1989438 0.3948603 y evaluamos lambda_2 <- log_p_nula(est_mv_nula) lambda_2 ## [1] -43.07902 Finalmente, nuestra estadística \\(\\lambda\\) es lambda <- 2 * (lambda_1 - lambda_2) lambda ## [1] 0.6235661 Y ahora necesitamos calcular un valor-\\(p\\). El problema que tenemos en este punto es que bajo la hipótesis nula no están determinados todos los parámetros, así que no podemos simular de manera simple muestras para obtener la distribución de referencia. Podemos sin embargo usar bootstrap paramétrico usando los estimadores de máxima verosimilitud bajo la nula simular_boot <- function(n_1, n_2, est_mv_nula){ x <- rnorm(n_1, est_mv_nula[1], est_mv_nula[2]) y <- rnorm(n_2, est_mv_nula[1], est_mv_nula[3]) list(x = x, y = y) } lambda_nula_sim <- function(est_mv_nula){ muestras <- simular_boot(80, 120, est_mv_nula) x <- muestras$x y <- muestras$y log_p <- crear_log_p(x, y) log_p_nula <- crear_log_p_nula(x, y) est_1 <- optim(c(0,0,1,1), log_p, control = list(fnscale = -1)) est_2 <- optim(c(0,1,1), log_p_nula, control = list(fnscale = -1)) lambda <- 2*(log_p(est_1$par) - log_p_nula(est_2$par)) lambda } lambda_sim <- map_dbl(1:2000, ~ lambda_nula_sim(est_mv_nula = est_mv_nula)) Y graficamos la distribución de referencia junto con el valor de \\(\\lambda\\) que obtuvimos: tibble(lambda = lambda_sim) |> ggplot(aes(x = lambda)) + geom_histogram() + geom_vline(xintercept = lambda, colour = "red") Y claramente los datos son consistentes con medias iguales. El valor-\\(p\\) es mean(lambda_sim > lambda) ## [1] 0.4275 Verificamos una vez más que la distribución de referencia es cercana a una \\(\\chi\\)-cuadrada con un grado de libertad. tibble(lambda = lambda_sim) |> ggplot(aes(sample = lambda)) + geom_qq(distribution = stats::qchisq, dparams = list(df = 1)) + geom_qq_line(distribution = stats::qchisq, dparams = list(df = 1)) Esta es la definición generalizada de las pruebas de cociente de verosimilitudes Definición. Consideramos la hipótesis nula \\(\\theta \\in \\Theta_0\\). La estadística del cociente de verosimilitudes está dada por: \\[\\lambda = 2\\log\\left( \\frac{\\max_{\\theta}\\mathcal{L}(\\theta)}{\\max_{\\theta\\in\\Theta_0}\\mathcal{L}(\\theta)} \\right ) = 2\\log\\left( \\frac{ \\mathcal{L}(\\hat{\\theta})}{\\mathcal{L}(\\hat{\\theta}_0)} \\right)\\] donde \\(\\hat{\\theta}\\) es el estimador de máxima verosimilitud de \\(\\theta\\) y \\(\\hat{\\theta}_0\\) es el estimador de máxima verosimilitud de \\(\\theta\\) cuando restringimos a que \\(\\theta \\in \\Theta_0\\). En nuestro ejemplo anterior, el espacio \\(\\Theta_0\\) era \\(\\{ (\\mu,\\mu,\\sigma_1, \\sigma_2)\\}\\), que es un subconjunto de \\(\\{ (\\mu_1,\\mu_2,\\sigma_1, \\sigma_2)\\}\\). Nótese que el espacio \\(\\Theta_0\\) tiene tres parámetros libres, mientras que el espacio total tiene 4. Aunque podemos usar el bootstrap paramétrico para construir distribuciones de referencia para estas pruebas y calcular un valor-\\(p\\), el siguiente teorema, cuya demostración no es trivial, explica las observaciones que hicimos arriba. Este teorema enuncia la estrategia del enfoque clásico, que utiliza una aproximación asintótica. Valores p para pruebas de cocientes de verosimilitud. Supongamos que \\(\\theta = (\\theta_1,\\theta_2, \\ldots, \\theta_p)\\). Sea \\[\\Theta_0 = \\{\\theta : \\theta_1 = a_1, \\theta_2 = a_2, \\dots, \\theta_q = a_q \\},\\] es decir la hipótesis \\(\\theta \\in \\Theta_0\\) es que los primeros \\(q\\) parámetros de \\(\\theta\\) estan fijos en algún valor. Los otros parámetros no se consideran en esta prueba. Si \\(\\lambda\\) es la estadística de cociente de verosimilitudes de esta prueba, entonces, bajo la nula \\(\\theta \\in \\Theta_0\\) tenemos que la distribución de \\(\\lambda\\) es asintóticamente \\(\\chi\\)-cuadrada con \\(q\\) grados de libertad, denotada por \\(\\chi^2_q\\). El valor-\\(p\\) para esta prueba es \\[P(\\chi^2_{q} > \\lambda)\\] Observaciones: Para hacer cálculos con la distribución \\(\\chi\\)-cuadrada usamos rutinas numéricas (por ejemplo la función pchisq en R). Nótese que \\(p\\) es la dimensión del espacio \\(\\Theta\\) (\\(p\\) parámetros), y que \\(p-q\\) es la dimensión del espacio \\(\\Theta_0\\) (pues \\(q\\) parámetros están fijos), de modo que los grados de libertad son la dimensión de \\(\\Theta\\) menos la dimensión de \\(\\Theta_0\\). En nuestro primer ejemplo (proporción de éxitos) solo teníamos un parámetro. El espacio \\(\\Theta_0\\) es de dimensión 0, así que los grados de libertad son \\(1 = 1 - 0\\) En este último ejemplo donde probamos igualdad de medias, el espacio \\(\\Theta\\) tiene dimensión 4, y el espacio \\(\\Theta_0\\) es de dimensión 3 (tres parámetros libres), por lo tanto los grados de libertad son \\(1 = 4 -3\\). Ejemplo En nuestro ejemplo de prueba de igualdad de medias, usaríamos pchisq(lambda, df =1, lower.tail = FALSE) ## [1] 0.4297252 que es similar al que obtuvimos con la estrategia del bootstrap paramétrico. Errores tipo I y tipo II En algunas ocasiones, en lugar de solamente calcular un valor-\\(p\\) queremos tomar una decisión asociada a distintas hipótesis que consideramos posibles. Por ejemplo, nuestra hipótesis nula podría ser Hipótesis nula \\(H_0\\): Una medicina nueva que estamos probando no es efectiva en reducir el colesterol en pacientes. Y queremos contrastar con una alternativa: Hipótesis alternativa \\(H_A\\): la medicina nueva reduce los niveles de colesterol en los pacientes. La decisión que está detrás de estas pruebas es: si no podemos rechazar la nula, la medicina no sale al mercado. Si rechazamos la nula, entonces la medicina es aprobada para salir al mercado. Para diseñar esta prueba, procedemos como sigue: Definimos cómo recolectar datos \\(X\\) de interés Definimos una estádistica \\(T(X)\\) de los datos. Definimos una región de rechazo \\(R\\) de valores tales que si \\(T(X)\\in R\\), entonces rechazaremos la hipótesis nula (e implícitamente tomaríamos la decisión asociada a la alternativa). Ejecutamos la prueba observando datos \\(X=x\\), calculando \\(T(x)\\), y checando si \\(T(x) \\in R\\). Si esto sucede entonces decimos que rechazamos la hipótesis nula, y tomamos la decisión asociada a la alternativa. Ejemplo. Si tenemos la hipótesis nula \\(p_1=0.5\\) para una proporción, y al alternativa es \\(p_1\\neq 0.5\\), podemos usar la estadística de Wald \\(T(x) = \\frac{\\hat{p_1} - 0.5}{\\hat{\\textsf{ee}}}\\). Podríamos definir la región de rechazo como \\(R = \\{T(x) : |T(x)| > 3 \\}\\) (rechazamos si en valor absoluto la estadística de Wald es mayor que 3). Cuando diseñamos una prueba de este tipo, quisiéramos minimizar dos tipos de errores: Rechazar la hipótesis nula \\(H_0\\) cuando es cierta: Error tipo I No rechazar la hipótesis nula \\(H_0\\) cuando \\(H_0\\) es falsa: Error tipo II La gravedad de cada error depende del problema. En nuestro ejemplo de la medicina, por ejemplo: Un error tipo II resultaría en una medicina efectiva que no sale al mercado, lo que tiene consecuencias financieras (para la farmaceútica) y costos de oportunidad en salud (para la población). Por otra parte, Un error tipo I resultaría en salir al mercado con una medicina que no es efectiva. Esto tiene costos de oportunidad financieros que pueden ser grandes para la sociedad. Todos estos costos dependen, por ejempĺo, de qué tan grave es la enfermedad, qué tan costosa es la medicina, y así sucesivamente. En el enfoque más clásico, los errores tipo I y tipo II generalmente no se balancean según su severidad o probabilidad. En lugar de eso, generalmente se establece un límite para la probabilidad de cometer un error del tipo I (usualmente 5%, por una tradición que no tiene mucho fundamento) En vista de este ejemplo simple, y las observaciones de arriba: Reducir una decisión compleja a una prueba de hipótesis con resultados binarios (rechazar o no) es generalmente erróneo. Las pruebas de hipótesis se usan muchas veces incorrectamente cuando lo más apropiado es usar estimación por intervalos o algo similar que cuantifique la incertidumbre de las estimaciones. Consulta por ejemplo el comunicado de la ASA acerca de p-values y pruebas de hipótesis En el caso de la medicina, por ejemplo, realmente no nos interesa que la medicina sea mejor que un placebo. Nos importa que tenga un efecto considerable en los pacientes. Si estimamos este efecto, incluyendo incertidumbre, tenemos una mejor herramienta para hacer análisis costo-beneficio y tomar la decisión más apropiada. Como dijimos, típicamente se selecciona la región de rechazo de forma que bajo la hipótesis nula la probabilidad de cometer un error tipo I está acotada. Definición. Supongamos que los datos \\(X_1,X_2,\\ldots, X_n\\) provienen de una distribución \\(F_\\theta\\), donde no conocemos \\(\\theta\\). Supongamos que la hipótesis nula es que \\(\\theta = \\theta_0\\) (que llamamos una hipótesis simple). La función de potencia de una prueba con región de rechazo \\(R\\) se define como la probabilidad de rechazar para cada posible valor del parámetro \\(\\theta\\) \\[\\beta(\\theta) = P_\\theta (X\\in R).\\] El tamaño de una prueba se define como el valor \\[\\alpha = \\beta(\\theta_0),\\] es decir, la probabilidad de rechazar la nula (\\(\\theta = \\theta_0\\)) erróneamente. Observación. Esto se generaliza para hipótesis compuestas, donde la nula es que el parámetro \\(\\theta\\) está en un cierto conjunto \\(\\Theta_0\\). Por ejemplo, una hipótesis nula puede ser \\(\\theta < 0.5\\). En este caso, \\(\\alpha\\) se define como el valor más grande que \\(\\beta(\\theta)\\) toma cuando \\(\\theta\\) está en \\(\\Theta_0\\), es decir, la probabilidad de rechazo más grande cuando la hipótesis nula se cumple. Decimos que una prueba tiene nivel de significancia de \\(\\alpha\\) si su tamaño es menor o igual a \\(\\alpha\\). Decimos que la potencia de una prueba es la probabilidad de, correctamente, rechazar la hipótesis nula cuando la alterna es verdadera: \\[\\beta(\\theta_a) = P_{\\theta_a} (X \\in R).\\] Observación: Sería deseable encontrar la prueba con mayor potencia bajo \\(H_a\\), entre todas las pruebas con tamaño \\(\\alpha\\). Esto no es trivial y no siempre existe. Observación: El valor \\(p\\) es el menor tamaño con el que podemos rechazar \\(H_0\\). Ejemplo (Chihara and Hesterberg (2018)) Supongamos que las calificaciones de Enlace de alumnos en México se distribuye aproximadamente como una normal con media 515 y desviación estándar de 120. En una ciudad particular, se quiere decidir si es neceario pedir fondos porque la media de la ciudad es más baja que la nacional. Nuestra hipótesis nula es \\(H_0: \\mu \\geq 515\\) y la alternativa es \\(\\mu < 515\\), así que si rechazamos la nula se pedirían los fondos. Supondremos que la distribución de calificaciones en la ciudad es también aproximadamente normal con desviación estándar de 130. Se plantea tomar una muestra de 100 alumnos, y rechazar si la media muestral \\(\\bar{X}\\) es menor que 505. ¿Cuál es la probabilidad \\(\\alpha\\) de tener un error de tipo I? La función de potencia es \\[\\beta(\\mu) = P_\\mu(\\bar{X} < 505)\\] Restando la media \\(\\mu\\) y estandarizando obtenemos \\[\\beta(\\mu) = P \\left (\\frac{\\bar{X} - \\mu}{130/\\sqrt{100}} < \\frac{505 -\\mu}{130/\\sqrt{100}} \\right )\\] así que \\[\\beta(\\mu) = \\Phi \\left (\\frac{505 -\\mu}{130/\\sqrt{100}}\\right ),\\] donde \\(\\Phi\\) es la función acumulada de la normal estándar. La gráfica de la función potencia es entonces potencia_tbl <- tibble(mu = seq(450, 550, 0.5)) |> mutate(beta = pnorm((505 - mu)/13)) |> # probabilidad de rechazar mutate(nula_verdadera = factor(mu >= 515)) # nula verdadera ggplot(potencia_tbl, aes(x = mu, y = beta, colour = nula_verdadera)) + geom_line() Es decir, si la media \\(\\mu\\) de la ciudad es muy baja, con mucha seguridad rechazamos. Si es relativamente alta entonces no rechazamos. El tamaño de la prueba es el mayor valor de probabilidad de rechazo que se obtiene sobre los valores \\(\\mu\\geq 515\\) (la nula). Podemos calcularlo analíticamente como sigue: Si \\(\\mu \\geq 515\\), entonces \\[\\beta(\\mu) \\leq \\beta(515) = \\Phi\\left (\\frac{505 -515}{130/\\sqrt{100}}\\right ) = \\Phi( - 10 / 13) = \\Phi(-0.7692)\\] que es igual a pnorm(-0.7692) ## [1] 0.2208873 Y este es el tamaño de la prueba. En otras palabras: si la ciudad no está por debajo de la media nacional, hay una probabilidad de 22% de que erróneamente se pidan fondos (al rechazar \\(H_0\\)). Ejemplo Supongamos que los que programan el presupuesto deciden que se requiere tener una probabilidad de a lo más 5% de rechazar erróneamente la hipótesis nula (es decir, pedir fondos cuando en realidad su media no está debajo de la nacional) para poder recibir fondos. ¿Cuál es la región de rechazo que podríamos escoger? En el caso anterior usamos la región \\(\\bar{X}<505\\). Si el tamaño de muestra está fijo en \\(n=100\\) (por presupuesto), entonces tenemos que escoger un punto de corte más extremo. Si la región de rechazo es \\(\\bar{X} < C)\\) entonces tenemos, siguiendo los cálculos anteriores, que \\[0.05 = \\alpha = \\Phi \\left ( \\frac{C -515}{130/\\sqrt{100}}\\right) = \\Phi \\left( \\frac{C- 515}{13} \\right)\\] Buscamos el cuantil 0.05 de la normal estándar, que es z_alpha <- qnorm(0.05) z_alpha ## [1] -1.644854 Y entonces requerimos que \\[\\frac{C- 515}{13} = -1.6448.\\] Despejando obtenemos C <- 13*z_alpha + 515 C ## [1] 493.6169 Así que podemos usar la región \\(\\bar{X} < 493.5\\), que es más estricta que la anterior de \\(\\bar{X} < 505\\). Considera la potencia de la prueba \\(\\beta(\\mu)\\) que vimos arriba. Discute y corre algunos ejemplos para contestar las siguientes preguntas: Recuerda la definición: ¿qué significa \\(\\beta(\\mu)\\)? ¿Qué pasa con la potencia cuando \\(\\mu\\) está más lejos de los valores de la hipótesis nula? ¿Qué pasa con la potencia cuando hay menos variabilidad en la población? ¿Y cuando la muestra es más grande? ¿Qué pasa si hacemos más chico el nivel de significancia? Consideraciones prácticas Algunos recordatorios de lo que hemos visto: Rechazar la nula no quiere decir que la nula es falsa, ni que encotramos un “efecto”. Un valor-\\(p\\) chico tampoco quiere decir que la nula es falsa. Lo que quiere decir es que la nula es poco consistente con los datos que observamos, o que es muy poco probable que la nula produzca los datos que observamos. Rechazar la nula (encontrar un efecto “significativo”) no quiere decir que el efecto tiene importancia práctica. Si la potencia es alta (por ejemplo cuando el tamaño de muestra es grande), puede ser que la discrepancia de los datos con la nula es despreciable, entonces para fines prácticos podríamos trabajar bajo el supuesto de la nula. Por eso en general preferimos hacer estimación que pruebas de hipótesis para entender o resumir los datos y tamaños de las discrepancias. Adicionalmente, muchas de las hipótesis nulas que generalmente se utilizan se pueden rechazar sin datos (por ejemplo, igualdad de proporciones en dos poblaciones reales). Lo que importa es qué tan diferentes son, y qué tan bien podemos estimar sus diferencias. En la literatura, muchas veces parece que “encontrar una cosa interesante” es rechazar una hipótesis nulas con nivel 5% de significancia. Es más importante entender cómo se diseñó el estudio, cómo se recogieron los datos, cuáles fueron las decisiones de análisis que pasar el mítico nivel de 5% Cuando la potencia es baja (por ejemplo porque el tamaño de muestra es muy chico), tenemos que observar diferencias muy grandes para rechazar. Si probamos algo poco factible (por ejemplo, que la vitamina \\(C\\) aumenta la estatura a los adultos), entonces los rechazos generalmente se deben a variabilidad en la muestra (error tipo II). Cuando diseñamos y presentamos resultados de un estudio o análisis, es mejor pensar en describir los datos y su variabilidad, y mostrar estimaciones incluyendo fuentes de incertidumbre, en lugar de intentar resumir con un valor-\\(p\\) o con el resultado de una prueba de hipótesis. Pruebas múltiples En algunas ocasiones se hacen muchas pruebas para “filtrar” las cosas que son interesantes y las que no. Por ejemplo, cuando comparamos miles de genes entre dos muestras (la nula es que son similares). Si cada prueba se conduce a un nivel \\(\\alpha\\), la probablilidad de tener al menos un rechazo falso (un error tipo I) es considerablemente más alta que \\(\\alpha\\). Por ejemplo, si repetimos una prueba de hipótesis con nivel \\(\\alpha\\) con muestras independientes, la probabilidad de tener al menos un rechazo falso es \\(1-(1-\\alpha)^n\\), que es muy cercano a uno si \\(n\\) es grande (¿cómo derivas esta fórmula?). Por ejemplo, si \\(\\alpha = 0.05\\) y \\(n = 100\\), con más de 99% probabilidad tendremos al menos un rechazo falso, o un “hallazgo” falso. Sin \\(n\\) es muy grande, varios de los hallazgos que encontremos serán debidos a variabilidad muestral. Puedes ver en (Wasserman 2013), sección 10.7 métodos conservadores como corrección de Bonferroni (sólo rechazar cuando el valor-\\(p\\) es menor a \\(0.05/n\\)), o la técnica más moderna de control de tasa de descubrimientos falsos (FDR). Cuando estamos en una situación como esta (que es más retadora en cuanto a análisis), sin embargo, sugerimos usar estimaciones que tomen cuenta todos los datos con regularización apropiada: por ejemplo, en lugar de trabajar con cada muestra por separado, intentamos construir un modelo para el proceso completo de muestreo. Una posibilidad son modelos jerárquicos bayesianos. Ver por ejemplo (Gelman, Hill, and Yajima 2012). Referencias "],["introducción-a-inferencia-bayesiana-1.html", "Sección 10 Introducción a inferencia bayesiana Un primer ejemplo completo de inferencia bayesiana Ejemplo: estimando una proporción Ejemplo: observaciones uniformes Probabilidad a priori Análisis conjugado Pasos de un análisis de datos bayesiano Verificación predictiva posterior Predicción", " Sección 10 Introducción a inferencia bayesiana Para esta sección seguiremos principalmente Kruschke (2015). Adicionalmente puedes ver la sección correspondiente de Chihara and Hesterberg (2018). En las secciones anteriores estudiamos el método de máxima verosimilitud y métodos de remuestreo. Esto lo hemos hecho para estimar parámetros, y cuantificar la incertidumbre qué tenemos acerca de valores poblacionales. La inferencia bayesiana tiene objetivos similares. Igual que en máxima verosimilitud, la inferencia bayesiana comienza con modelos probabilísticos y observaciones. En contraste con máxima verosimilitud, la inferencia bayesiana está diseñada para incorporar información previa o de expertos que tengamos acerca de los parámetros de interés. La inferencia bayesiana cubre como caso particular métodos basados en máxima verosimilitud. 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: 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. 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. Es decir, 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. 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. 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 # 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, n_volados, 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, proceso generador de datos 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 Consideremos ahora el problema de estimar una proporción \\(\\theta\\) de una población dada usando una muestra iid \\(X_1,X_2,\\ldots, X_n\\) de variables Bernoulli. Ya sabemos calcular la verosimilitud (el modelo de los datos): \\[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: 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 quantile(sim_inicial$theta, c(0.025, 0.975)) |> round(2) ## 2.5% 97.5% ## 0.14 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 \\[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}\\] 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: 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: 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.61 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: 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.14 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. Puedes experimentar en esta shiny app con diferentes iniciales, número de volados y observación de éxitos. 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: qbeta(0.025, shape1 = 22, shape2 = 14) |> round(2) ## [1] 0.45 qbeta(0.975, shape1 = 22, shape2 = 14) |> round(2) ## [1] 0.76 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 si \\(\\alpha = 1.1\\) el cuantil 99% es: alpha <- 1.1 (300/(0.01)^(1/alpha)) ## [1] 19738 es decir, alrededor de 20 millones de números. Creemos que es 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: loteria_tbl <- read_csv("data/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: 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: sims_pareto_inicial <- tibble( theta = rpareto(20000, 300, 1.1 ), dist = "inicial") Y con los datos de la muestra, simulamos de la posterior: 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. Regresaremos más adelante a este problema. Si obtenemos percentiles, obtenemos el intervalo 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 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 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, pues la posterior no tiene un forma reconocible. Tendremos que usar otras estrategias de simulación para ejemplos como este (Monte Carlo por medio de Cadenas de Markov, que veremos más adelante). 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. Análisis conjugado Los dos ejemplos que hemos visto arriba son ejemplos de análisis conjugado: (Beta-bernoulli) Si las observaciones \\(X_i\\) son \\(\\mathsf{Bernoulli}(p)\\) (\\(n\\) fija) queremos estimar \\(p\\), y tomamos como distribución inicial para \\(p\\) una \\(\\mathsf{Beta}(a,b)\\), entonces la posterior para \\(p\\) cuando \\(S_n=k\\) es \\(\\mathsf{Beta}(k + a, n - k + b)\\), donde \\(S_n = X_1 + X_2 +\\cdots +X_n\\). Y más en general: (Beta-binomial) Si las observaciones \\(X_i, i=1,2,\\ldots, m\\) son \\(\\mathsf{Binomial}(n_i, p)\\) (\\(n_i\\)’s fijas) independientes, queremos estimar \\(p\\), y tomamos como distribución inicial para \\(p\\) una \\(\\mathsf{Beta}(a,b)\\), entonces la posterior para \\(p\\) cuando \\(S_m=k\\) es \\(\\mathsf{Beta}(k + a, n - k + b)\\), donde \\(S_m = X_1 + X_2 +\\cdots +X_m\\) y \\(n= n_1+n_2+\\cdots+n_m\\) También aplicamos: (Uniforme-Pareto) Si el modelo de datos \\(X_i\\) es uniforme \\(\\mathsf{U}[0,\\theta]\\) (\\(n\\) fija), queremos estimar \\(\\theta\\), y tomamos como distribución inicial para \\(\\theta\\) una Pareto \\((\\theta_0, \\alpha)\\), entonces la posterior para \\(p\\) si el máximo de las \\(X_i\\)’s es igual a \\(M\\) es Pareto con parámetros \\((\\max\\{\\theta_0, M\\}, \\alpha + n)\\). Nótese que en estos casos, dada una forma de la verosimilitud, tenemos una familia conocida de iniciales tales que las posteriores están en la misma familia. Estos modelos son convenientes porque podemos hacer simulaciones de la posterior de manera fácil, o usar sus propiedades teóricas. Otro ejemplo típico es el modelo normal-normal: (Normal-normal) Si \\(X_i\\sim \\mathsf{N}(\\mu,\\sigma)\\), con \\(\\sigma\\) conocida, y tomamos como distribución inicial para \\(\\mu \\sim \\mathsf{N}(\\mu_0,\\sigma_0)\\), y definimos la precisión \\(\\tau\\) como el inverso de la varianza \\(\\sigma^2\\), entonces la posterior de \\(\\mu\\) es Normal con media \\((1-\\lambda) \\mu_0 + \\lambda\\overline{x}\\), y precisión \\(\\tau_0 + n\\tau\\), donde \\(\\lambda = \\frac{n\\tau}{\\tau_0 + n\\tau}\\) Completa cuadrados para mostrar las fórmulas del modelo normal-normal con varianza conocida. Más útil es el siguiente modelo: (Normal-Gamma inverso) Sean \\(X_i\\sim \\mathsf{N}(\\mu, \\sigma)\\). Queremos estimar \\(\\mu\\) y \\(\\sigma\\). Tomamos como distribuciones iniciales (dadas por 4 parámetros: \\(\\mu_0, n_0, \\alpha,\\beta\\)): \\(\\tau = \\frac{1}{\\sigma^2} \\sim \\mathsf{Gamma}(\\alpha,\\beta)\\) \\(\\mu|\\sigma\\) es normal con media \\(\\mu_0\\) y varianza \\(\\sigma^2 / {n_0}\\) , y \\(p(\\mu, \\sigma) = p(\\mu|\\sigma)p(\\sigma)\\) Entonces la posterior es: \\(\\tau|x\\) es \\(\\mathsf{Gamma}(\\alpha', \\beta')\\), con \\(\\alpha' = \\alpha + n/2\\), \\(\\beta' = \\beta + \\frac{1}{2}\\sum_{i=1}^{n}(x_{i} - \\bar{x})^2 + \\frac{nn_0}{n+n_0}\\frac{({\\bar{x}}-\\mu_{0})^2}{2}\\) \\(\\mu|\\sigma,x\\) es normal con media \\(\\mu' = \\frac{n_0\\mu_{0}+n{\\bar{x}}}{n_0 +n}\\) y varianza \\(\\sigma^2/({n_0 +n})\\). \\(p(\\mu,\\sigma|x) = p(\\mu|x,\\sigma)p(\\sigma|x)\\) Observaciones Nótese que este último ejemplo tiene más de un parámetro. En estos casos, el objeto de interés es la posterior conjunta de los parámetros \\(p(\\theta_1,\\theta_2,\\cdots, \\theta_p|x)\\). Este último ejemplo es relativamente simple pues por la selección de iniciales, para simular de la conjunta de \\(\\mu\\) y \\(\\tau\\) podemos simular primero \\(\\tau\\) (o \\(\\sigma\\)), y después usar este valor para simular de \\(\\mu\\): el par de valores resultantes son una simulación de la conjunta. Los parámetros \\(\\alpha,\\beta\\) para la inicial de \\(\\tau\\) pueden interpretarse como sigue: \\(\\sqrt{\\beta/\\alpha}\\) es un valor “típico” a priori para la varianza poblacional, y \\(a\\) indica qué tan seguros estamos de este valor típico. Nótese que para que funcionen las fórmulas de la manera más simple, escogimos una dependencia a priori entre la media y la precisión: \\(\\tau = \\sigma^{-2}\\) indica la escala de variabilidad que hay en la población, la incial de la media tiene varianza \\(\\sigma^2/n_0\\). Si la escala de variabilidad de la población es más grande, tenemos más incertidumbre acerca de la localización de la media. Aunque esto tiene sentido en algunas aplicaciones, y por convenviencia usamos esta familia conjugada, muchas veces es preferible otro tipo de especificaciones para las iniciales: por ejemplo, la media normal y la desviación estándar uniforme, o media normal, con iniciales independientes. Sin embargo, estos casos no son tratables con análisis conjugado (veremos más adelante cómo tratarlos con MCMC). 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\\). Como está el modelo, esta inicial debe estar dada para la precisión \\(\\tau\\), pero podemos simular para ver cómo se ve nuestra inicial para la desviación estándar. En la población general la desviación estándar es alrededor de 7 centímetros # Comenzamos seleccionando un valor que creemos típico para la desviación estándar sigma_0 <- 7 # seleccionamos un valor para a, por ejemplo: si es más chico sigma tendrá más # disperisón a <- 3 # ponemos 7 = sqrt(b/a) -> b = a * 64 b <- a * sigma_0 ^ 2 c(a = a, b = b) ## a b ## 3 147 Ahora simulamos para calcular cuantiles tau <- rgamma(1000, a, b) quantile(tau, c(0.05, 0.95)) ## 5% 95% ## 0.005781607 0.042170161 sigma <- 1 / sqrt(tau) mean(sigma) ## [1] 8.002706 quantile(sigma, c(0.05, 0.95)) ## 5% 95% ## 4.869653 13.151520 Que es dispersión considerable: con poca probabilidad la desviación estándar es menor a 4 centímetros, y también creemos que es poco creíble la desviación estándar sea de más de 13 centímetros. 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\\): mu_0 <- 175 # valor medio de inicial n_0 <- 5 # cuánta concentración en la inicial tau <- rgamma(1000, a,b) sigma <- 1/sqrt(tau) mu <- map_dbl(sigma, ~ rnorm(1, mu_0, .x / sqrt(n_0))) quantile(mu, c(0.05, 0.5, 0.95)) ## 5% 50% 95% ## 168.7275 174.8412 180.7905 Que consideramos un rango en el que con alta probabilidad debe estar la media poblacional de los cantantes. Podemos checar nuestros supuestos simulando posibles muestras usando sólo nuestra información previa: simular_normal_invgamma <- function(n, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular media tau <- rgamma(1, a, b) sigma <- 1 / sqrt(tau) mu <- rnorm(1, mu_0, sigma/sqrt(n_0)) # simular sigma rnorm(n, mu, sigma) } set.seed(3461) sims_tbl <- tibble(rep = 1:20) |> mutate(estatura = map(rep, ~ simular_normal_invgamma(500, c(mu_0, n_0, a, b)))) |> unnest(cols = c(estatura)) ggplot(sims_tbl, aes(x = estatura)) + geom_histogram() + facet_wrap(~ rep) + geom_vline(xintercept = c(150, 180), colour = "red") 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 140, que deberían ser menos probables). Ahora podemos usar los datos para calcular nuestras posteriores. 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 Los cálculos son un poco tediosos, pero podemos construir una función apropiada: calcular_pars_posterior <- function(x, pars_inicial){ # iniciales mu_0 <- pars_inicial[1] n_0 <- pars_inicial[2] a_0 <- pars_inicial[3] b_0 <- pars_inicial[4] # muestra n <- length(x) media <- mean(x) S2 <- sum((x - media)^2) # sigma post a_1 <- a_0 + 0.5 * n b_1 <- b_0 + 0.5 * S2 + 0.5 * (n * n_0) / (n + n_0) * (media - mu_0)^2 # posterior mu mu_1 <- (n_0 * mu_0 + n * media) / (n + n_0) n_1 <- n + n_0 c(mu_1, n_1, a_1, b_1) } pars_posterior <- calcular_pars_posterior(cantantes$estatura_cm, c(mu_0, n_0, a, b)) pars_posterior ## [1] 175.8 25.0 13.0 509.0 ¿Cómo se ve nuestra posterior comparada con la inicial? Podemos hacer simulaciones: sim_params <- function(m, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular sigmas sims <- tibble(tau = rgamma(m, a, b)) |> mutate(sigma = 1 / sqrt(tau)) # simular mu sims <- sims |> mutate(mu = rnorm(m, mu_0, sigma / sqrt(n_0))) sims } sims_inicial <- sim_params(5000, c(mu_0, n_0, a, b)) |> mutate(dist = "inicial") sims_posterior <- sim_params(5000, pars_posterior) |> mutate(dist = "posterior") sims <- bind_rows(sims_inicial, sims_posterior) ggplot(sims, aes(x = mu, y = sigma, colour = dist)) + geom_point(alpha = 0.4) 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. medias_post <- sims |> filter(dist == "posterior") |> select(-dist) |> summarise(across(everything(), mean)) ggplot(sims |> filter(dist == "posterior"), aes(x = mu, y = sigma)) + geom_point(colour = "#00BFC4") + geom_point(data = medias_post, size = 5, colour = "black") + coord_equal() Podemos construir intervalos creíbles del 90% para estos dos parámetros, por ejemplo haciendo intervalos de percentiles: f <- c(0.05, 0.5, 0.95) sims |> pivot_longer(cols = mu:sigma, names_to = "parametro") |> group_by(dist, parametro) |> reframe(cuantil = quantile(value, f) |> round(1), f = f) |> pivot_wider(names_from = f, values_from = cuantil) ## # A tibble: 4 × 5 ## dist parametro `0.05` `0.5` `0.95` ## <chr> <chr> <dbl> <dbl> <dbl> ## 1 inicial mu 169. 175. 181. ## 2 inicial sigma 4.8 7.4 13.3 ## 3 posterior mu 174. 176. 178. ## 4 posterior sigma 5.1 6.3 8.2 Como comparación, los estimadores de máxima verosimlitud son 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. 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. Elicitando probablidades subjetivas (opcional) No siempre es fácil elicitar probabilidades subjetivas de manera que capturemos el verdadero conocimiento de dominio que tenemos. Una manera clásica de hacerlo es con apuestas Considera una pregunta sencilla que puede afectar a un viajero: ¿Qué tanto crees que habrá una tormenta que ocasionará el cierre de la autopista México-Acapulco en el puente del \\(20\\) de noviembre? Como respuesta debes dar un número entre \\(0\\) y \\(1\\) que refleje tus creencias. Una manera de seleccionar dicho número es calibrar las creencias en relación a otros eventos cuyas probabilidades son claras. Como evento de comparación considera una experimento donde hay canicas en una urna: \\(5\\) rojas y \\(5\\) blancas. Seleccionamos una canica al azar. Usaremos esta urna como comparación para considerar la tormenta en la autopista. Ahora, considera el siguiente par de apuestas de las cuales puedes elegir una: A. Obtienes \\(\\$1000\\) si hay una tormenta que ocasiona el cierre de la autopista el próximo \\(20\\) de noviembre. B. Obtienes \\(\\$1000\\) si seleccionas una canica roja de la urna que contiene \\(5\\) canicas rojas y \\(5\\) blancas. Si prefieres la apuesta B, quiere decir que consideras que la probabilidad de tormenta es menor a \\(0.5\\), por lo que al menos sabes que tu creencia subjetiva de una la probabilidad de tormenta es menor a \\(0.5\\). Podemos continuar con el proceso para tener una mejor estimación de la creencia subjetiva. A. Obtienes \\(\\$1000\\) si hay una tormenta que ocasiona el cierre de la autopista el próximo \\(20\\) de noviembre. C. Obtienes \\(\\$1000\\) si seleccionas una canica roja de la urna que contiene \\(1\\) canica roja y \\(9\\) blancas. Si ahora seleccionas la apuesta \\(A\\), esto querría decir que consideras que la probabilidad de que ocurra una tormenta es mayor a \\(0.10\\). Si consideramos ambas comparaciones tenemos que tu probabilidad subjetiva se ubica entre \\(0.1\\) y \\(0.5\\). 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 observaciones, producidas simulando 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. Y ahora simulamos otra muestra muestra_sim <- simular_normal_invgamma(20, pars_posterior) muestra_sim |> round(0) ## [1] 167 181 184 181 167 167 172 170 177 172 169 174 182 184 176 171 175 176 168 ## [20] 181 Podemos simular varias muestras y hacer una prueba de lineup: library(nullabor) set.seed(9921) sims_obs <- tibble(.n = 1:19) |> mutate(estatura_cm = map(.n, ~ simular_normal_invgamma(20, pars_posterior))) |> unnest(estatura_cm) pos <- sample(1:20, 1) lineup_tbl <- lineup(true = cantantes |> select(estatura_cm), samples = sims_obs, 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? 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: 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: 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. Predicción Cuando queremos hacer predicciones particulares acerca de datos que observemos en el futuro, también podemos usar la posterior predictiva. En este caso, tenemos que considerar La variabilidad que produce la incertidumbre en la estimación de los parámetros La variabilidad de las observaciones dados los parámetros. Es decir, tenemos que simular sobre todos las combinaciones factibles de los parámetros. Ejemplo: cantantes Si un nuevo tenor llega a un coro, ¿cómo hacemos una predicción de su estatura? Como siempre, quisiéramos obtener un intervalo que exprese nuestra incertidumbre acerca del valor que vamos a observar. Entonces haríamos: sims_posterior <- sim_params(50000, pars_posterior) |> mutate(y_pred = rnorm(n(), mu, sigma)) sims_posterior |> head() ## # A tibble: 6 × 4 ## tau sigma mu y_pred ## <dbl> <dbl> <dbl> <dbl> ## 1 0.0286 5.91 175. 181. ## 2 0.0200 7.07 177. 178. ## 3 0.0257 6.23 176. 170. ## 4 0.0344 5.39 176. 174. ## 5 0.0297 5.80 175. 169. ## 6 0.0282 5.96 177. 170. f <- c(0.025, 0.5, 0.975) sims_posterior |> summarise(f = f, y_pred = quantile(y_pred, f)) ## # A tibble: 3 × 2 ## f y_pred ## <dbl> <dbl> ## 1 0.025 163. ## 2 0.5 176. ## 3 0.975 189. Y con esto obtenemos el intervalo (163, 189), al 95%, para una nueva observación. Nótese que este intervalo no puede construirse con una simulación particular de la posterior de los parámetros, pues sería demasiado corto. Es posible demostrar que en este caso, la posterior predictiva tiene una forma conocida: La posterior predictiva para el modelo normal-gamma inverso es una distribución \\(t\\) con \\(2\\alpha'\\) grados de libertad, centrada en \\(\\mu'\\), y con escala \\(s^2 = \\frac{\\beta'}{\\alpha'}\\frac{n + n_0 + 1}{n +n_0}\\) mu_post <- pars_posterior[1] n_post <- pars_posterior[2] alpha_post <- pars_posterior[3] beta_post <- pars_posterior[4] s <- sqrt(beta_post/alpha_post) * sqrt((n_post + 1)/n_post) qt(c(0.025, 0.5, 0.975), 2 * alpha_post) * s + mu_post ## [1] 162.6832 175.8000 188.9168 Calcula la posterior predictiva del modelo Beta-Bernoulli y Beta-Binomial. (Más difícil) Calcula la posterior predictiva del modelo Poisson-Gamma. Ejemplo: posterior predictiva de Pareto-Uniforme. La posterior predictiva del modelo Pareto-Uniforme no tiene un nombre estándar, pero podemos aproximarla usando simulación. Usando los mismos datos del ejercicio de la lotería, haríamos: 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 posterior de los parámetros lim_inf_post <- max(c(300, muestra_loteria$numero)) k_posterior <- nrow(muestra_loteria) + 1.1 sims_pareto_posterior <- tibble( theta = rpareto(100000, lim_inf_post, k_posterior)) # Simulamos una observación para cada una de las anteriores: sims_post_pred <- sims_pareto_posterior |> mutate(x_pred = map_dbl(theta, ~ runif(1, 0, .x))) # Graficamos ggplot(sims_post_pred, aes(x = x_pred)) + geom_histogram(binwidth = 50) + geom_vline(xintercept = lim_inf_post, colour = "red") Que es una mezcla de una uniforme con una Pareto. Referencias "],["calibración-bayesiana-y-regularización.html", "Sección 11 Calibración bayesiana y Regularización Enfoque bayesiano y frecuentista Ejemplo: estimación de una proporción Intervalos de Agresti-Coull Incorporando información inicial Inferencia bayesiana y regularización Ejemplo: modelo normal y estaturas Ejemplo: estimación de proporciones Teoría de decisión Riesgo de Bayes", " Sección 11 Calibración bayesiana y Regularización El enfoque bayesiano se puede formalizar coherentemente en términos de probabilidades subjetivas, y como vimos, esta es una fortaleza del enfoque bayesiano. En la práctica, sin embargo, muchas veces puede ser difícil argumentar en términos exclusivos de probabilidad subjetiva, aunque hagamos los esfuerzos apropiados para incorporar la totalidad de información que distintos actores involucrados pueden tener. Consideremos, por ejemplo, que INEGI produjera un intervalo creíble del 95% para el ingreso mediano de los hogares de México. Aún cuando nuestra metodología sea transparente y correctamente informada, algunos investigadores interesados puede ser que tengan recelo en usar esta información, y quizá preferirían hacer estimaciones propias. Esto restaría valor al trabajo cuidadoso que pusimos en nuestras estimaciones oficiales. Por otra parte, el enfoque frecuentista provee de ciertas garantías mínimas para la utilización de las estimaciones, que no dependen de la interpretación subjetiva de la probabilidad, sino de las propiedades del muestreo. Consideremos la cobertura de los intervalos de confianza: Bajo ciertos supuestos de nuestros modelos, la probabilidad de que un intervalo de confianza del 95% cubra al verdadero valor poblacional es del 95%. Esta probabilidad es sobre las distintas muestras que se pueden obtener según el diseño del muestreo. Los intervalos creíbles en principio no tienen por qué cumplir esta propiedad, pero consideramos que en la práctica es una garantía mínima que deberían cumplir. El enfoque resultante se llama bayesiano calibrado, Little (2011) . La idea es seguir el enfoque bayesiano usual para construir nuestras estimaciones, pero verificar hasta donde sea posible que los intervalos resultantes satisfacen alguna garantía frecuentista básica. Observación. checar que la cobertura real es similar a la nominal es importante en los dos enfoques: frecuentista y bayesiano. Los intervalos frecuentistas, como hemos visto, generalmente son aproximados, y por lo tanto no cumplen automáticamente esta propiedad de calibración. Enfoque bayesiano y frecuentista Los métodos estadísticos clásicos toman el punto de vista frecuentista y se basa en los siguientes puntos (Wasserman (2013)): La probabilidad se interpreta como un límite de frecuencias relativas, donde las probabilidades son propiedades objetivas en el mundo real. En un modelo, los parámetros son constantes fijas (desconocidas). Como consecuencia, no se pueden realizar afirmaciones probabilísticas útiles en relación a éstos. Los procedimientos estadísticos deben diseñarse con el objetivo de tener propiedades frecuentistas bien definidas. Por ejemplo, un intervalo de confianza del \\(95\\%\\) debe contener el verdadero valor del parámetro con frecuencia límite de al menos el \\(95\\%\\). En contraste, el acercamiento Bayesiano muchas veces se describe por los siguientes postulados: La probabilidad describe grados de creencia, no frecuencias limite. Como tal uno puede hacer afirmaciones probabilísticas acerca de muchas cosas y no solo datos sujetos a variabilidad aleatoria. Por ejemplo, puedo decir: “La probabilidad de que Einstein tomara una taza de té el primero de agosto de \\(1948\\)” es \\(0.35\\), esto no hace referencia a ninguna frecuencia relativa sino que refleja la certeza que yo tengo de que la proposición sea verdadera. Podemos hacer afirmaciones probabilísticas de parámetros. Podemos hacer inferencia de un parámetro \\(\\theta\\) por medio de distribuciones de probabilidad. Las inferencias como estimaciones puntuales y estimaciones de intervalos se pueden extraer de dicha distribución. Finalmente, en el enfoque bayesiano calibrado (Little (2011)): Usamos el enfoque bayesiano para modelar y hacer afirmaciones probabilísticas de los parámetros. Buscamos cumplir las garantías frecuentistas del inciso 3). Ejemplo: estimación de una proporción Recordamos nuestro problema de estimación de una proporcion \\(\\theta\\). Usando la distribución inicial \\(p(\\theta)\\sim \\mathsf{Beta}(2,2)\\), y la verosimilitud estándar binomial, vimos que la posterior cuando observamos \\(k\\) éxitos es \\[p(\\theta|k) \\sim \\mathsf{Beta}(k + 2, n - k + 2)\\]. La media posterior es \\[\\frac{k + 2}{n + 4} \\] que podemos interpretar como: agrega 2 éxitos y 2 fracasos a los datos observados y calcula la proporción de éxitos. Un intervalo posterior de credibilidad del 95% se calcula encontrando los cuantiles 0.025 y 0.975 de una \\(\\mathsf{Beta}(k + 2, n - k + 2)\\) \\[I_a = \\left [q_{0.025}(k+2, n+4), q_{0.975}(k+2, n+4)\\right ]\\] Que compararemos con el intervalo usual de Wald: si \\(\\hat{\\theta} = \\frac{k}{n}\\), entonces \\[I_w = \\left [\\hat{\\theta} - 2 \\sqrt{\\frac{\\hat{\\theta}(1-\\hat{\\theta})}{n}}, \\hat{\\theta} + 2 \\sqrt{\\frac{\\hat{\\theta}(1-\\hat{\\theta})}{n}}\\right]\\] ¿Cómo podemos comparar la calibración de estos dos intervalos? Nominalmente, deben tener cobertura de 95%. Hagamos un ejercicio de simulación para distintos tamaños de muestra \\(n\\) y posibles valores \\(\\theta\\in (0,1)\\): set.seed(332) simular_muestras <- function(M, n, p){ k = rbinom(M, n, p) tibble(rep = 1:M, n = n, p = p, k = k) } intervalo_wald <- function(n, k){ p_hat <- k / n ee_hat <- sqrt(p_hat * (1 - p_hat) / n) tibble(inf = p_hat - 2 * ee_hat, sup = p_hat + 2 * ee_hat) } intervalo_bayes <- function(n, k, a = 2, b = 2){ a <- k + a b <- n - k + b tibble(inf = qbeta(0.025, a, b), sup = qbeta(0.975, a, b)) } set.seed(812) ejemplo <- simular_muestras(5, 20, 0.4) ejemplo |> mutate(intervalo = intervalo_wald(n, k)) |> pull(intervalo) |> bind_cols(ejemplo) |> select(-rep) ## # A tibble: 5 × 5 ## inf sup n p k ## <dbl> <dbl> <dbl> <dbl> <int> ## 1 0.0211 0.379 20 0.4 4 ## 2 0.228 0.672 20 0.4 9 ## 3 0.276 0.724 20 0.4 10 ## 4 0.228 0.672 20 0.4 9 ## 5 0.137 0.563 20 0.4 7 ejemplo |> mutate(intervalo = intervalo_bayes(n, k)) |> pull(intervalo) |> bind_cols(ejemplo) |> select(-rep) ## # A tibble: 5 × 5 ## inf sup n p k ## <dbl> <dbl> <dbl> <dbl> <int> ## 1 0.102 0.437 20 0.4 4 ## 2 0.268 0.655 20 0.4 9 ## 3 0.306 0.694 20 0.4 10 ## 4 0.268 0.655 20 0.4 9 ## 5 0.197 0.573 20 0.4 7 ¿Cuáles de estos intervalos cubren al verdadero valor? Nótese que no podemos descalificar a ningún método por no cubrir una vez. Es fácil producir un intervalo con 100% de cobertura: (0,1). Pero no nos informa dónde es probable que esté el parámetro. Sin embargo, podemos checar la cobertura frecuentista haciendo una cantidad grande de simulaciones: parametros <- crossing(n = c(5, 10, 30, 60, 100, 400), p = c(0.01, 0.015, 0.02, 0.025, 0.03, 0.035, 0.04, 0.05, 0.07, 0.1, 0.15)) set.seed(2343) # simulaciones simulaciones <- parametros |> mutate(muestra = map2(n, p, ~ simular_muestras(50000, .x, .y) |> select(rep, k))) |> unnest(muestra) # calcular_cobertura calcular_cobertura <- function(simulaciones, construir_intervalo){ # nombre de función intervalo_nombre <- substitute(construir_intervalo) |> as.character() cobertura_tbl <- simulaciones |> mutate(intervalo = construir_intervalo(n, k)) |> pull(intervalo) |> bind_cols(simulaciones) |> mutate(cubre = p >= inf & p <= sup) |> group_by(n, p) |> summarise(cobertura = mean(cubre), long_media = mean(sup - inf)) cobertura_tbl |> mutate(tipo = intervalo_nombre) } cobertura_wald <- calcular_cobertura(simulaciones, intervalo_wald) cobertura_wald ## # A tibble: 66 × 5 ## # Groups: n [6] ## n p cobertura long_media tipo ## <dbl> <dbl> <dbl> <dbl> <chr> ## 1 5 0.01 0.0483 0.0347 intervalo_wald ## 2 5 0.015 0.0733 0.0527 intervalo_wald ## 3 5 0.02 0.0954 0.0689 intervalo_wald ## 4 5 0.025 0.119 0.0862 intervalo_wald ## 5 5 0.03 0.140 0.102 intervalo_wald ## 6 5 0.035 0.165 0.120 intervalo_wald ## 7 5 0.04 0.187 0.137 intervalo_wald ## 8 5 0.05 0.227 0.167 intervalo_wald ## 9 5 0.07 0.299 0.223 intervalo_wald ## 10 5 0.1 0.398 0.303 intervalo_wald ## # ℹ 56 more rows graficar_cobertura <- function(cobertura_tbl){ ggplot(cobertura_tbl, aes(x = p, y = cobertura, colour = tipo)) + geom_hline(yintercept = 0.95, colour = "black") + geom_line() + geom_point() + facet_wrap(~n) + ylim(0, 1) } cobertura_wald |> graficar_cobertura() La cobertura real es mucho más baja que la nominal en muchos casos, especialmente cuando la \\(p\\) es baja y \\(n\\) es chica. Pero incluso para muestras relativamente grandes (100), la cobertura es mala si \\(p\\) es chica. Ahora probamos nuestro método alternativo: cobertura_bayes <- calcular_cobertura(simulaciones, intervalo_bayes) bind_rows(cobertura_wald, cobertura_bayes) |> mutate(tipo = factor(tipo, levels = c('intervalo_wald', 'intervalo_bayes'))) |> graficar_cobertura() Y vemos que en general el intervalo de Bayes es superior al de Wald, en sentido de que su cobertura real es más cercana a la nominal. El caso donde fallan los dos es para muestras muy chicas \\(n=5, 10\\), con probabilidades de éxito chicas \\(p\\leq 0.02\\). Sin embargo, si tenemos información previa acerca del tamaño de la proporción que estamos estimando, es posible obtener buena calibración con el método bayesiano. En este caso particular, tenemos argumentos frecuentistas para utilizar el método bayesiano. Por ejemplo, si el INEGI utilizara estos intervalos creíbles, un análisis de calibración de este tipo sostendría esa decisión. Intervalos de Agresti-Coull Un método intermedio que se usa para obtener mejores intervalos cuando estimamos proporciones es el siguiente: Agregar dos 1’s y dos 0’s a los datos. Utilizar el método de Wald con estos datos modificados. intervalo_agresti_coull <- function(n, k){ p_hat <- (k + 2)/ (n + 4) ee_hat <- sqrt(p_hat * (1 - p_hat) / n) tibble(inf = p_hat - 2 * ee_hat, sup = p_hat + 2 * ee_hat) } cobertura_ac <- calcular_cobertura(simulaciones, intervalo_agresti_coull) bind_rows(cobertura_wald, cobertura_bayes, cobertura_ac) |> mutate(tipo = factor(tipo, levels = c('intervalo_wald', 'intervalo_bayes', 'intervalo_agresti_coull'))) |> graficar_cobertura() Que tiende a ser demasiado conservador para proporciones chicas: graficar_cobertura(cobertura_ac) + ylim(c(0.9, 1)) Conclusión 1: Los intervalos de Agresti-Coull son una buena alternativa para estimar proporciones como sustituto de los intervalos clásicos de Wald, aunque tienden a ser muy conservadores para muestras chicas Idealmente podemos utilizar un método bayesiano pues normalmente tenemos información inicial acerca de las proporciones que queremos estimar. Incorporando información inicial Nótese que generalmente tenemos información acerca de la cantidad que queremos estimar: por ejemplo, que proporción de visitantes de un sitio web compra algo (usualmente muy baja, menos de 2%), qué proporción de personas tiene diabetes tipo 1 (una proporción muy baja, menos de 1 por millar), o qué proporción de hogares tienen ingresos trimestrales mayores a 150 mil pesos (menos de %5 con alta probabilidad). En este caso, tenemos que ajustar nuestra inicial. Por ejemplo, para el problema de ingresos, podríamos usar una \\(\\mathsf{Beta}(2, 100)\\), cuyos cuantiles son: # uno de cada 100 a <- 2 b <- 100 beta_sims <- rbeta(5000, a, b) quantile(beta_sims, c(0.01, 0.05, 0.50, 0.90, 0.99)) |> round(3) ## 1% 5% 50% 90% 99% ## 0.001 0.004 0.016 0.039 0.067 qplot(beta_sims) Veamos cómo se ven los intervalos bayesianos producidos con esta inicial: crear_intervalo_bayes <- function(a, b){ intervalo_fun <- function(n, k){ a_post <- k + a b_post <- n - k + b tibble(inf = qbeta(0.025, a_post, b_post), sup = qbeta(0.975, a_post, b_post)) } intervalo_fun } intervalo_bayes_2 <- crear_intervalo_bayes(a, b) cobertura_bayes <- calcular_cobertura(simulaciones, intervalo_bayes_2) graficar_cobertura(bind_rows(cobertura_bayes, cobertura_ac) |> filter(p < 0.05)) + ylim(c(0.5, 1)) Y vemos que la calibración es similar. Notemos sin embargo que la longitud del del intervalo bayesiano es mucho menor que el de Agresti-Coull cuando la muestra es chica: ggplot(bind_rows(cobertura_bayes, cobertura_ac), aes(x = p, y = long_media, colour = tipo)) + geom_point() + facet_wrap(~n) Cuando la muestra es chica, los intervalos de bayes son similares a los iniciales, y mucho más cortos que los de Agresti-Coull. Para muestras intermedias (50-100) los intervalos bayesianos son más informativos que los de Agresti-Coull, con calibración similar, y representan aprendizaje por encima de lo que sabíamos en la inicial. Para muestras grandes, obtenemos resultados simililares. Por ejemplo: set.seed(2131) k <- rbinom(1, 50, 0.03) k ## [1] 4 intervalo_agresti_coull(50, k) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.022 0.2 es un intervalo muy grande que puede incluir valores negativos. En contraste, el intervalo bayesiano es: intervalo_bayes_2(50, k) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.015 0.076 Aún quitando valores negativos, los intervalos de Agresti-Coull son mucho más anchos. La aproximación bayesiana, entonces, utiliza información previa para dar un resultado considerablemente más informativo, con calibración similar a Agresti-Coull. ¿Aprendimos algo? Comparemos la posterior con la inicial: beta_sims_inicial <- tibble(prop = rbeta(5000, a, b), dist = "inicial") beta_sims_posterior <- tibble(prop = rbeta(5000, a + k, b + 50), dist = "posterior") bind_rows(beta_sims_inicial, beta_sims_posterior) |> ggplot(aes(x = prop, fill = dist)) + geom_histogram(alpha = 0.5, position = "identity") Donde vemos que no aprendimos mucho en este caso, pero nuestras creencias sí cambiaron en comparación con la inicial. Conclusión 2: con el enfoque bayesiano podemos obtener intervalos informativos con calibración razonable, incluso con información inicial que no es muy precisa. Los intervalos de Agresti-Coull son poco informativos para muestras chicas y/o proporciones chicas. Ejemplo: porporción de hogares de ingresos grandes Usaremos los datos de ENIGH como ejemplo (ignorando el diseño, pero es posible hacer todas las estimaciones correctamente) para estimar el porcentaje de hogares que tienen ingreso corriente de más de 150 mil pesos al trimestre. Suponemos que la muestra del enigh es la población, y tomaremos una muestra iid de esta población. Usamos la misma inicial que mostramos arriba, que es una Beta con parámetros c(a,b) ## [1] 2 100 set.seed(2521) muestra_enigh <- read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) |> sample_n(120) |> mutate(mas_150mil = ing_cor > 150000) Un intervalo de 95% es entonces k <- sum(muestra_enigh$mas_150mil) k ## [1] 3 intervalo_bayes_2(120, sum(muestra_enigh$mas_150mil)) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.007 0.046 La media posterior es prop_post <- (a + k) / (120 + b) prop_post ## [1] 0.02272727 ¿Cuál es la verdadera proporción? read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) |> mutate(mas_150mil = ing_cor > 150000) |> summarise(prop_pob = mean(mas_150mil)) ## # A tibble: 1 × 1 ## prop_pob ## <dbl> ## 1 0.0277 En este caso, nuestro intervalo cubre a la proporción poblacional. Inferencia bayesiana y regularización Como hemos visto en análisis y modelos anteriores, la posterior que usamos para hacer inferencia combina aspectos de la inicial con la verosimilitud (los datos). Una manera de ver esta combinación y sus beneficios es pensando en término de regularización de estimaciones. En las muestras hay variación. Algunas muestras particulares nos dan estimaciones de máxima verosimilitud pobres de los parámetros de interés (estimaciones ruidosas). Cuando esas estimaciones pobres están en una zona de baja probabilidad de la inicial, la estimación posterior tiende a moverse (o encogerse) hacia las zonas de alta probabilidad de la inicial. Esto filtra ruido en las estimaciones. El mecanismo resulta en una reducción del error cuadrático medio, mediante una reducción de la varianza de los estimadores (aunque quizá el sesgo aumente). Esta es una técnica poderosa, especialmente para problemas complejos donde tenemos pocos datos para cada parámetro. En general, excluímos resultados que no concuerdan con el conocimiento previo, y esto resulta en mayor precisión en las estimaciones. Ejemplo: modelo normal y estaturas Haremos un experimento donde simularemos muestras de los datos de cantantes. Usaremos el modelo normal-gamma inverso que discutimos anteriormente, con la información inicial que elicitamos. ¿Cómo se compara la estimación de máxima verosimilitud con la media posterior? # inicial para media, ver sección anterior para discusión (normal) mu_0 <- 175 n_0 <- 5 # inicial para sigma^2 (gamma inversa) a <- 3 b <- 140 Para este ejemplo chico, usaremos muestras de tamaño 5: set.seed(3413) # ver sección anterior para explicación de esta función calcular_pars_posterior <- function(x, pars_inicial){ # iniciales mu_0 <- pars_inicial[1] n_0 <- pars_inicial[2] a_0 <- pars_inicial[3] b_0 <- pars_inicial[4] # muestra n <- length(x) media <- mean(x) S2 <- sum((x - media)^2) # sigma post a_1 <- a_0 + 0.5 * n b_1 <- b_0 + 0.5 * S2 + 0.5 * (n * n_0) / (n + n_0) * (media - mu_0)^2 # posterior mu mu_1 <- (n_0 * mu_0 + n * media) / (n + n_0) n_1 <- n + n_0 c(mu_1, n_1, a_1, b_1) } Y también de la sección anterior: sim_params <- function(m, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular sigmas sims <- tibble(tau = rgamma(m, a, b)) |> mutate(sigma = 1 / sqrt(tau)) # simular mu sims <- sims |> mutate(mu = rnorm(m, mu_0, sigma / sqrt(n_0))) sims } # simular muestras y calcular medias posteriores simular_muestra <- function(rep, mu_0, n_0, a_0, b_0){ cantantes <- lattice::singer |> mutate(estatura_cm = 2.54 * height) |> filter(str_detect(voice.part, "Tenor")) |> sample_n(5, replace = FALSE) pars_posterior <- calcular_pars_posterior(cantantes$estatura_cm, c(mu_0, n_0, a_0, b_0)) medias_post <- sim_params(1000, pars_posterior) |> summarise(across(everything(), mean)) |> select(mu, sigma) media <- mean(cantantes$estatura_cm) est_mv <- c("mu" = media, "sigma" = sqrt(mean((cantantes$estatura_cm - media)^2))) bind_rows(medias_post, est_mv) |> mutate(rep = rep, tipo = c("media_post", "max_verosim")) |> pivot_longer(mu:sigma, names_to = "parametro", values_to = "estimador") } poblacion <- lattice::singer |> mutate(estatura_cm = 2.54 * height) |> filter(str_detect(voice.part, "Tenor")) |> summarise(mu = mean(estatura_cm), sigma = sd(estatura_cm)) |> pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor_pob") errores <- map(1:2000, ~ simular_muestra(.x, mu_0, n_0, a, b)) |> bind_rows() |> left_join(poblacion) |> mutate(error = (estimador - valor_pob)) ggplot(errores, aes(x = error, fill = tipo)) + geom_histogram(bins = 20, position = "identity", alpha = 0.5) + facet_wrap(~parametro) Vemos claramente que la estimación de la desviación estándar de nuestro modelo es claramente superior a la de máxima verosimilitud. En resumen: errores |> group_by(tipo, parametro) |> summarise(recm = sqrt(mean(error^2)) |> round(2)) |> arrange(parametro) ## # A tibble: 4 × 3 ## # Groups: tipo [2] ## tipo parametro recm ## <chr> <chr> <dbl> ## 1 max_verosim mu 2.85 ## 2 media_post mu 1.55 ## 3 max_verosim sigma 2.45 ## 4 media_post sigma 1.04 Obtenemos una ganancia considerable en cuanto a la estimación de la desviación estandar de esta población. Los estimadores de la media posterior son superiores a los de máxima verosimilitud en términos de error cuadrático medio. Podemos graficar las dos estimaciones, muestra a muestra, para entender cómo sucede esto: errores |> select(-error) |> pivot_wider(names_from = tipo, values_from = estimador) |> filter(parametro == "sigma") |> ggplot(aes(x = max_verosim, y = media_post)) + geom_abline(colour = "red") + geom_hline(yintercept = sqrt(b/(a - 1)), lty = 2, color = 'black') + geom_point() + labs(subtitle = "Estimación de sigma") + xlab("Estimador MV de sigma") + ylab("Media posterior de sigma") + coord_fixed() + geom_segment(aes(x = 13, y = 11, xend = 13, yend = sqrt(b/(a - 1))), colour='red', size=1, arrow =arrow(length = unit(0.5, "cm"))) + geom_segment(aes(x = .5, y = 6, xend = .5, yend = sqrt(b/(a - 1))), colour='red', size=1, arrow =arrow(length = unit(0.5, "cm"))) Nótese como estimaciones demasiado bajas o demasiada altas son contraídas hacia valores más consistentes con la inicial, lo cual resulta en menor error. El valor esperado de \\(\\sigma\\) bajo la distribución inicial se muestra como una horizontal punteada. Ejemplo: estimación de proporciones Ahora repetimos el ejercicio # inicial a <- 2 b <- 100 qbeta(c(0.01, 0.99), a, b) ## [1] 0.001477084 0.063921446 # datos datos <- read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) # estimaciones obtener_estimados <- function(datos){ muestra_enigh <- datos |> sample_n(120) |> mutate(mas_150mil = ing_cor > 150000) k <- sum(muestra_enigh$mas_150mil) tibble(k = k, est_mv = k/120, media_post = (a + k) / (120 + b), pob = 0.02769) } estimadores_sim <- map(1:200, ~obtener_estimados(datos)) |> bind_rows() # calculo de errores error_cm <- estimadores_sim |> summarise(error_mv = sqrt(mean((est_mv - pob)^2)), error_post = sqrt(mean((media_post - pob)^2))) error_cm ## # A tibble: 1 × 2 ## error_mv error_post ## <dbl> <dbl> ## 1 0.0147 0.00928 Podemos ver claramente que las medias posteriores están encogidas hacia valores más chicos (donde la inicial tiene densidad alta) comparadas con las estimaciones de máxima verosimilitud: estimadores_sim_ag <- estimadores_sim |> group_by(k, est_mv, media_post) |> summarise(n = n()) ggplot(estimadores_sim_ag, aes(x = est_mv, media_post, size = n)) + geom_point() + geom_abline() Teoría de decisión En esta parte (que sigue a Wasserman (2013) a grandes rasgos), discutimos brevemente teoría general que nos sirve para seleccionar estimadores puntuales, y que esperemos ponga en contexto la parte anterior que acabamos de discutir. Usaremos algunos conceptos que vimos en la parte de propiedades de estimadores de máxima verosimilitud. Definimos una función de pérdida \\(L(\\theta, \\hat{\\theta}_n)\\), que mide el costo de la discrepancia entre nuestro estimador \\[\\hat{\\theta}_n = t(X_1,\\ldots, X_n) = t(X)\\] y el verdadero valor \\(\\theta\\) poblacional. Es posible considerar distintas funciones de pérdida, pero como en secciones anteriores, usaremos la pérdida cuadrática, definida por: \\[L(\\theta, \\hat{\\theta}_n) = (\\theta - \\hat{\\theta}_n)^2\\] Esta función toma distintos valores dependiendo de la muestra y del parámetro \\(\\theta\\), y necesitamos resumirla para dar una evaluación de qué tan bueno es el estimador \\(\\hat{\\theta}_n\\). Ahora que hemos considerado tanto estadística bayesiana como frecuentista, podemos pensar en resumir esta función de distintas maneras. Comenzamos pensando de manera frecuentista. En este caso, consideramos a \\(\\theta\\) como un valor fijo, y nos preguntamos qué pasaría con la pérdida con distintas muestras potenciales que podríamos observar. Definimos como antes el riesgo (frecuentista) como: \\[R(\\theta, t) = \\mathbb{E}_X\\left[ (\\theta - \\hat{\\theta}_n)^2 \\, \\big| \\, \\theta\\right]\\] donde promediamos a lo largo de las muestras posibles, con \\(\\theta\\) fijo. Esta cantidad no nos dice necesariamente cómo escoger un buen estimador para \\(\\theta\\), pues dependiendo de dónde está \\(\\theta\\) puede tomar valores distintos. Ahora vamos a pensar de manera bayesiana: en este caso, los datos serán fijos una vez que los obervemos de manera que \\(\\hat{\\theta}_n\\) está fijo, y el parámetro \\(\\theta\\) es una cantidad aleatoria con distribución inicial \\(p(\\theta)\\). Entonces consideraríamos el promedio sobre la posterior dado por: \\[\\rho(t, X) = \\mathbb{E}_{p(\\theta|X)}\\left[(\\theta - \\hat{\\theta})^2 \\, \\big | \\, X \\right]\\] que llamamos riesgo posterior. Esta cantidad se calcula con la posterior de los parámetros dados los datos, y nos dice, una vez que vimos los datos, cómo es el error de nuestro estimador. Nótese que esta cantidad no es útil para escoger un estimador bueno \\(t\\) antes de ver los datos, pero nos sirve para evaluar a un estimador dados los datos. En el primer caso, promediamos sobre posibles muestras, y en el segundo por valores posibles de \\(\\theta\\) para una muestra dada. Ejemplo: riesgo frecuentista Para observaciones bernoulli, el estimador de máxima verosimilitud es \\(\\hat{p}_1 = k /n\\), donde \\(n\\) es el tamaño de muestra y \\(k\\) el número de éxitos observados. Podemos usar también como estimador la media posterior de un modelo Beta-Bernoulli con inicial \\(a=2, b=2\\), que nos daría \\(\\hat{p}_2 = \\frac{k + 2}{n + 4}\\). Aunque podemos hacer los cálculos analíticos, aproximaremos el riesgo bajo el error cuadrático usando simulación perdida_cuad <- function(p, p_hat){ (p - p_hat)^2 } # dos estimadores t_1 <- function(n, x) x / n t_2 <- function(n, x) (x + 2) / (n + 4) estimar_riesgo <- function(n = 20, theta, perdida, reps = 10000){ x <- rbinom(reps, n, theta) # calcular estimaciones theta_1 <- t_1(n, x) theta_2 <- t_2(n, x) # calcular pérdida media_perdida <- tibble( n = n, theta = theta, estimador = c("MLE", "Posterior"), riesgo = c(mean(perdida(theta, theta_1)), mean(perdida(theta, theta_2)))) media_perdida } estimar_riesgo(n = 20, theta = 0.1, perdida = perdida_cuad) ## # A tibble: 2 × 4 ## n theta estimador riesgo ## <dbl> <dbl> <chr> <dbl> ## 1 20 0.1 MLE 0.00449 ## 2 20 0.1 Posterior 0.00755 Como dijimos, esta cantidad depende de \\(\\theta\\) que no conocemos. Así que calculamos para cada valor de \\(\\theta:\\) Las funciones de riesgo \\(R(\\theta, t_1)\\) y \\(R(\\theta, t_2)\\) (dependen de \\(\\theta\\)) se ven aproximadamente como sigue: p_seq <- seq(0, 1, 0.001) riesgo_tbl <- map(p_seq, ~ estimar_riesgo(n = 20, theta = .x, perdida = perdida_cuad)) |> bind_rows() ggplot(riesgo_tbl, aes(x = theta, y = riesgo, colour = estimador)) + geom_line() Y vemos que el riesgo depende del verdadero valor del parametro: en los extremos, el estimador de máxima verosimilitud tiene menos riesgo, pero en el centro tiene más (esto es independiente del tipo de intervalos que construyamos y su cobertura). La razón es que las estimaciones de tipo Agresti-Coull (\\(\\theta_2\\)) están contraídas hacia 0.5 (agregamos dos éxitos y dos fracasos). Esto produce sesgo en la estimación para valores extremos de \\(\\theta\\). Sin embargo, para valores centrales de \\(\\theta\\) tiene menos variabilidad (por regularización) que el estimador de máxima verosimilitud, y sufre poco de sesgo. Ejemplo: riesgo posterior Supongamos que la inicial es \\(\\theta \\sim \\mathsf{Beta}(5,3)\\) estimar_riesgo_post <- function(n = 20, x, perdida, reps = 20000){ # calcular estimaciones theta_1 <- t_1(n, x) theta_2 <- t_2(n, x) # simular de posterior theta_post <- rbeta(reps, x + 5, n - x + 3) # calcular pérdida media_perdida <- tibble( n = n, x = x, estimador = c("MLE", "Posterior"), riesgo_post= c(mean(perdida(theta_post, theta_1)), mean(perdida(theta_post, theta_2)))) media_perdida } estimar_riesgo_post(n = 20, x = 8, perdida = perdida_cuad) ## # A tibble: 2 × 4 ## n x estimador riesgo_post ## <dbl> <dbl> <chr> <dbl> ## 1 20 8 MLE 0.0127 ## 2 20 8 Posterior 0.0109 Como dijimos, esta cantidad depende de los datos \\(x\\) que no hemos observado. Así que calculamos para cada valor de \\(x\\): Las funciones de pérdida promedio \\(\\rho(x, t_1)\\) y \\(\\rho(x, t_2)\\) (dependen de \\(x\\)) se ven aproximadamente como sigue: x_seq <- seq(0, 20, 1) riesgo_post_tbl <- map(x_seq, ~ estimar_riesgo_post(n = 20, x = .x, perdida = perdida_cuad)) |> bind_rows() ggplot(riesgo_post_tbl, aes(x = x, y = riesgo_post, colour = estimador)) + geom_line() + geom_point() Donde vemos que la pérdida del estimador bayesiano es mejor para valores extremos de número de éxitos observado \\(x\\), pero tiene más riesgo posterior para valores chicos de \\(x\\). En general es mejor el estimador \\(\\theta_2\\). El estimador de máxima verosimilitud tiene más riesgo en los extremos, lo que esperaríamos porque no tenemos la regularización que aporta la posterior. Igualmente, vemos más riesgo para valores chicos de \\(x\\) que para valores grandes: esto es porque la inicial está concentrada en valores reslativamente grandes de \\(\\theta\\). Riesgo de Bayes Finalmente, podemos crear un resumen unificado considerando: Si no conocemos el valor del parámetro \\(\\theta\\), podemos promediar el riesgo frecuentista con la inicial \\(p(\\theta)\\) Si no conocemos los datos observados, podemos promediar usando datos generados por la marginal \\(p(x)\\) de \\(x\\) bajo el modelo de datos \\(p(x|\\theta)\\) y la inicial \\(p(\\theta)\\). Por la ley de la esperanza iterada, estos dos resultados son iguales. La cantidad resultante \\[r(t) = \\int R(\\theta,t) p(\\theta)\\, d\\theta = \\int r(x, t)p(x|\\theta)p(\\theta)\\, d\\theta\\, dx\\] Se llama riesgo de Bayes para el estimador \\(t\\). Ejemplo Podemos calcular marginal_tbl <- function(n = 20, m = 5000){ theta <- rbeta(m, 5, 3) x <- rbinom(m, size = n, p = theta) tibble(x = x) |> group_by(x) |> summarise(n_x = n()) } riesgo_post_tbl |> left_join(marginal_tbl()) |> group_by(estimador) |> summarise(riesgo_bayes = sum(riesgo_post * n_x) / sum(n_x)) ## # A tibble: 2 × 2 ## estimador riesgo_bayes ## <chr> <dbl> ## 1 MLE 0.0104 ## 2 Posterior 0.00833 o también theta_tbl <- tibble(theta = rbeta(50000, 5, 3) |> round(3)) |> group_by(theta) |> summarise(n_x = n()) riesgo_tbl |> left_join(theta_tbl) |> mutate(n_x = ifelse(is.na(n_x), 0, n_x)) |> group_by(estimador) |> summarise(riesgo_bayes = sum(riesgo * n_x) / sum(n_x)) ## # A tibble: 2 × 2 ## estimador riesgo_bayes ## <chr> <dbl> ## 1 MLE 0.0104 ## 2 Posterior 0.00839 Ahora consideremos cómo decidiríamos, desde el punto de vista Bayesiano, qué estimador usar: (Estimador de Bayes) Si tenemos los datos \\(X\\), escogeríamos una función \\(t_X\\) que minimice el riesgo posterior \\(\\rho(t, X)\\), y nuestro estimador es \\(\\hat{\\theta}_n = t_X (X)\\). (Regla de Bayes) Si no tenemos los datos, escogeríamos el estimador una función \\(t\\) que minimice el riesgo de Bayes \\(r(t)\\), y estimaríamos usando \\(\\hat{\\theta}_n = t(X)\\) Pero como el riesgo de Bayes es el promedio del riesgo posterior, la solución de 1 nos da la solución de 2. Es decir, el estimador que escogemos condicional a los datos \\(X\\) es el mismo que escogeríamos antes de escoger los datos, dada una distribución inicial \\(p(\\theta).\\) Por ejemplo, es posible demostrar que bajo la pérdida cuadrática, la regla de Bayes es utilizar la media posterior, bajo la pérdida absoluta, la mediana posterior, etc. Este estimador de Bayes tiene sentido desde el punto de vista frecuentista, también, porque minimiza el riesgo frecuentista promedio, suponiendo la inicial \\(p(\\theta)\\). Por ejemplo, para la pérdida cuadrática podemos usar la descomposición de sesgo y varianza y obtenemos: \\[r(t) = \\mathbb{E}[R(\\theta,t)] = \\mathbb{E}[ \\mathsf{Sesgo}_\\theta^2(t)] +\\mathbb{E}[\\mathsf{Var}_\\theta(t)] \\] Podemos ver entonces que el estimador de Bayes, en este caso la media posterior, es resultado de minimizar la suma de estas dos cantidades: por eso puede incurrir en sesgo, si ese costo se subsana con una reducción considerable de la varianza. Los estimadores insesgados que vimos en esta sección fueron subóptimos en muchos casos justamente porque son insesgados, e incurren en varianza grande. Regresa a los ejemplos anteriores donde evaluamos el desempeño de la media posterior en varios ejemplos. Muestra en las gráficas dónde ves el balance entre sesgo y varianza que cumplen cuando los comparamos con estimadores insesgados. Desde el punto de vista frecuentista, la cuestión es más complicada y hay varias maneras de proceder. En primer lugar, comenzaríamos con el riesgo frecuentista \\(R(\\theta, t)\\). Una idea es,por ejemplo, calcular el riesgo máximo: \\[R_{\\max} (t) = \\underset{\\theta}{\\max} R(\\theta, t).\\] En nuestro ejemplo de arriba el máximo se alcanza en 0.5, y tomaríamos eso evaluación de los estimadores \\(\\theta_1\\) o \\(\\theta_2\\). Buscaríamos entonces estimadores que minimicen este máximo, es decir, estimadores minimax. Pero también es posible enfocar este problema considerando sólo estimadores insesgados, lo que nos lleva por ejemplo a buscar estimadores con mínima varianza. También podemos enfocarnos en buscar estimador admisibles, que son aquellos cuyo riesgo no está dominado para toda \\(\\theta\\) por otro estimador, y así sucesivamente. Finalmente, es posible demostrar (ver Wasserman (2013)) que típicamente, para muestras grandes, el estimador de máxima verosimilitud es cercano a ser minimax y además es una regla de Bayes. Estas son buenas propiedades, pero debemos contar con que el régimen asintótico se cumpla aproximadamente. Referencias "],["métodos-de-cadenas-de-markov-monte-carlo.html", "Sección 12 Métodos de Cadenas de Markov Monte Carlo Integrales mediante subdivisiones Métodos Monte Carlo Simulando de la posterior 12.1 Ejemplo de islas ¿Por qué funciona Metrópolis? Método de Metrópolis Ajustando el tamaño de salto Metrópolis con varios parámetros Muestreador de Gibbs Conclusiones y observaciones Metrópolis y Gibbs HMC y Stan Diagnósticos generales para MCMC", " Sección 12 Métodos de Cadenas de Markov Monte Carlo Hasta ahora, hemos considerado modelos bayesianos conjugados, donde la posterior tiene una forma conocida. Esto nos permitió simular directamente de la posterior usando las rutinas estándar de R, o utilizar cálculos teóricos o funciones estándar de R para calcular resúmenes de interés, como medias o medianas posteriores o intervalos de credibilidad. Sin embargo, en aplicaciones rara vez es factible este tipo de análisis tan simple, pues: Los modelos que estamos considerando son más complejos y la distribución posterior conjunta de los parámetros no tiene una forma simple conocida. Queremos usar distribuciones iniciales que no son conjugadas para utilizar correctamente nuestra información inicial. Recordamos que tenemos expresiones explícitas para la inicial \\(p(\\theta)\\) y la verosimilitud \\(p(x|\\theta)\\), así que conocemos explícitamente la posterior, módulo la constante de normalización, \\[p(\\theta|x) \\propto p(x|\\theta) \\, p(\\theta).\\] Supongamos por ejemplo que quisiéramos calcular las medias posteriores de los parámetros \\(\\theta\\). En teoría, tendríamos que calcular \\[\\hat \\theta = \\mathbb{E}[{\\theta}\\, |\\, x] = \\int \\theta \\, p(\\theta|x) \\, d\\theta\\] Entonces es necesario calcular también \\(p(x)\\), que resulta de la integral \\[p(x) = \\int p(x|\\theta) \\, p(\\theta)\\, d\\theta\\] Si no tenemos expresiones analíticas simples, tendremos que aproximar numéricamente estas integrales de alguna forma. Si la posterior tiene una forma conocida, podemos calcular cantidades de interés usando fórmulas o rutinas de simulación de distribuciones conocidas que producen muestras independientes. Cuando la posterior no tiene una forma conocida, sin embargo: Podemos intentar usar integración numérica usual. Como veremos, este enfoque no es muy escalable. Podemos usar simulaciones bajo cadenas de Markov (Markov Chain Monte Carlo, MCMC), que es un enfoque más escalable. Mucho del uso generalizado actual de la estadística bayesiana se debe a que gracias al poder de cómputo disponible y los métodos MCMC, no estamos restringidos al uso de 1 y 2, que tienen desventajas grandes. Primero mostraremos cómo el método de integración por subdivisión no es escalable. Integrales mediante subdivisiones Como tenemos una expresión analítica para el integrando, podemos intentar una rutina numérica de integración. Una vez calculada, podríamos entonces usar otra rutina numérica para calcular las medias posteriores \\(\\hat{\\theta}\\). Las rutinas usuales de integración pueden sernos útiles cuando el número de parámetros es chico. Consideremos primero el caso de 1 dimensión, y supongamos que \\(a\\leq\\theta\\leq b\\). Si dividimos el rango de \\(\\theta\\) en intervalos determinados por \\(a = \\theta^1<\\theta^2<\\cdots \\theta^M =b\\), tales que \\(\\Delta\\theta = \\theta^{i+1} -\\theta^{i}\\), podríamos aproximar con \\[p(x) \\approx \\sum_{i=1}^M p(x|\\theta^i)p(\\theta^i) \\Delta\\theta\\] Lo que requiere \\(M\\) evaluaciones del factor \\(p(x|\\theta)p(\\theta)\\). Podríamos usar por ejemplo \\(M=100\\) para tener precisión razonable. Ejemplo: estimación de una proporción Teníamos que \\(p(S_n = k|\\theta) \\propto \\theta^k(1-\\theta)^{n-k}\\) cuando observamos \\(k\\) éxitos en \\(n\\) pruebas independientes. Supongamos que nuestra inicial es \\(p(\\theta) = 2\\theta\\) (checa que es una densidad), es decir, creemos que es más probable a priori observar proporciones altas. Podemos integrar numéricamente crear_log_post <- function(n, k){ function(theta){ verosim <- k * log(theta) + (n - k) * log(1 - theta) inicial <- log(theta) log_p_factor <- verosim + inicial log_p_factor } } # observamos 3 éxitos en 4 pruebas: log_post <- crear_log_post(4, 3) prob_post <- function(x) { exp(log_post(x))} # integramos numéricamente p_x <- integrate(prob_post, lower = 0, upper = 1, subdivisions = 100L) p_x ## 0.03333333 with absolute error < 3.7e-16 Y ahora podemos calcular la media posterior: media_funcion <- function(theta){ theta * prob_post(theta) / p_x$value } integral_media <- integrate(media_funcion, lower = 0, upper = 1, subdivisions = 100L) media_post <- integral_media$value media_post ## [1] 0.7142857 Podemos verificar nuestro trabajo pues sabemos que la posterior es \\(\\mathsf{Beta}(5, 2)\\) cuya media es 5/(2+5) ## [1] 0.7142857 Y podríamos intentar una estrategia similar, por ejemplo, para calcular intervalos de credibilidad. Sin embargo, veremos abajo que este método no escala con el número de parámetros. Más de un parámetro Ahora supongamos que tenemos \\(2\\) parámetros. Dividiríamos cada parámetro en 100 intervalos, y luego tendríamos que calcular \\[p(x) \\approx \\sum_{i=1}^M \\sum_{j=1}^M p(x|\\theta_1^i, \\theta_2^j)p(\\theta_1^i, \\theta_2^j) \\Delta\\theta_1\\Delta\\theta_2\\] Y esto requeriría \\(M^2 = 10,000\\) evaluaciones de \\(p(x|\\theta)p(\\theta)\\). Si tenemos \\(p\\) parámetros, entonces tendríamos que hacer \\(M^p\\) evaluaciones de la posterior. Incluso cuando \\(p=10\\), esta estrategia es infactible, pues tendríamos que hacer más de millones de millones de millones de evaluaciones de la posterior. Si sólo tenemos esta técnica disponible, el análisis bayesiano está considerablemente restringido. Regresión bayesiana con unas 10 covariables por ejemplo, no podría hacerse. De modo que tenemos que replantearnos cómo atacar el problema de calcular o aproximar estas integrales. Métodos Monte Carlo En varias ocasiones anteriormente hemos usado el método Monte Carlo para aproximar integrales: por ejemplo, para calcular medias posteriores. Supongamos que tenemos una densidad \\(p(\\theta)\\). Integración Monte Carlo. Supongamos que queremos calcular el valor esperado de \\(g(X)\\), donde \\(X\\sim p(X\\,|\\,\\theta).\\) Es decir, la variable aleatoria \\(X\\) se distribuye de acuerdo al modelo probabilistico \\(p(X \\, | \\, \\theta),\\) de tal forma que lo que nos interesa calcular es \\[\\mathbb{E}[g(X)] = \\int g(x) p(x|\\theta)\\, dx.\\] Si tomamos una muestra \\(x^{(1)},x^{(2)}, \\ldots x^{(N)} \\overset{iid}{\\sim} p(x|\\theta)\\), entonces \\[\\mathbb{E}[g(X)] \\approx \\, \\frac1N \\, \\sum_{n = 1}^N g(x^{(n)})\\] cuando \\(N\\) es grande. Esto es simplemente una manera de escribir la ley de los grandes números, y hemos aplicado este teorema en varias ocasiones. Nos ha sido útil cuando sabemos cómo simular de distribución \\(p(\\theta | x)\\) (usando alguna rutina de R, por ejemplo, o usando un método estándar como inversión de la función de distribución acumulada). Ejemplo En este ejemplo repetimos cosas que ya hemos visto. En el caso de estimación de una proporción \\(\\theta\\), tenemos como inicial \\(p(\\theta) \\propto \\theta\\), que es \\(\\mathsf{Beta}(2,1)\\). Si observamos 3 éxitos en 4 pruebas, entonces sabemos que la posterior es \\(p(\\theta|x)\\propto \\theta^4(1-\\theta)\\), que es \\(\\mathsf{Beta}(5, 2)\\). Si queremos calcular media y segundo momento posterior para \\(\\theta\\), en teoría necesitamos calcular \\[\\mu = \\int_0^1 \\theta p(\\theta|X = 3)\\, d\\theta,\\,\\, \\mu_2=\\int_0^1 \\theta^2 p(\\theta|X = 3)\\, d\\theta\\] integramos con Monte Carlo theta <- rbeta(10000, 5, 2) media_post <- mean(theta) momento_2_post <- mean(theta^2) c(media_post, momento_2_post) ## [1] 0.7155559 0.5372170 Y podemos aproximar de esta manera cualquier cantidad de interés que esté basada en integrales, como probabilidades asociadas a \\(\\theta\\) o cuantiles asociados. Por ejemplo, podemos aproximar fácilmente \\(P(e^{\\theta}> 2|x)\\) haciendo mean(exp(theta) > 2) ## [1] 0.5958 y así sucesivamente. Este enfoque, sin embargo, es mucho más flexible y poderoso. Ejemplo: varias pruebas independientes Supongamos que probamos el nivel de gusto para 4 sabores distintos de una paleta. Usamos 4 muestras de aproximadamente 50 personas diferentes para cada sabor, y cada uno evalúa si le gustó mucho o no. Obtenemos los siguientes resultados: datos <- tibble( sabor = c("fresa", "limón", "mango", "guanábana"), n = c(50, 45, 51, 50), gusto = c(36, 35, 42, 29)) %>% mutate(prop_gust = gusto / n) datos ## # A tibble: 4 × 4 ## sabor n gusto prop_gust ## <chr> <dbl> <dbl> <dbl> ## 1 fresa 50 36 0.72 ## 2 limón 45 35 0.778 ## 3 mango 51 42 0.824 ## 4 guanábana 50 29 0.58 Usaremos como inicial \\(\\mathsf{Beta}(2, 1)\\) (pues hemos obervado cierto sesgo de cortesía en la calificación de sabores, y no es tan probable tener valores muy bajos) para todos los sabores, es decir \\(p(\\theta_i)\\) es la funcion de densidad de una \\(\\mathsf{Beta}(2, 1)\\). La inicial conjunta la definimos entonces, usando idependiencia inicial, como \\[p(\\theta_1,\\theta_2, \\theta_3,\\theta_4) = p(\\theta_1)p(\\theta_2)p(\\theta_3)p(\\theta_4).\\] Pues inicialmente establecemos que ningún parámetro da información sobre otro: saber que mango es muy gustado no nos dice nada acerca del gusto por fresa. Bajo este supuesto, y el supuesto adicional de que las muestras de cada sabor son independientes, podemos mostrar que las posteriores son independientes: \\[p(\\theta_1,\\theta_2,\\theta_3, \\theta_4|k_1,k_2,k_3,k_4) = p(\\theta_4|k_1)p(\\theta_4|k_2)p(\\theta_4|k_3)p(\\theta_4|k_4)\\] De forma que podemos trabajar individualmente con cada muestra. Calculamos los parámetros de las posteriores individuales: datos <- datos %>% mutate(a_post = gusto + 2, b_post = n - gusto + 1) datos ## # A tibble: 4 × 6 ## sabor n gusto prop_gust a_post b_post ## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 fresa 50 36 0.72 38 15 ## 2 limón 45 35 0.778 37 11 ## 3 mango 51 42 0.824 44 10 ## 4 guanábana 50 29 0.58 31 22 Ahora nos preguntamos, ¿cuál es la probabilidad posterior de que mango sea el sabor más preferido de la población? Conocemos la posterior para cada parámetro, y sabemos que los parámetros son independientes para la posterior. Eso quiere decir que podemos simular de cada parámetro independientemente para obtener simulaciones de la conjunta posterior. simular_conjunta <- function(rep, datos){ datos %>% mutate(valor_sim = map2_dbl(a_post, b_post, ~ rbeta(1, .x, .y))) %>% select(sabor, valor_sim) } simular_conjunta(1, datos) ## # A tibble: 4 × 2 ## sabor valor_sim ## <chr> <dbl> ## 1 fresa 0.755 ## 2 limón 0.783 ## 3 mango 0.819 ## 4 guanábana 0.569 # esta no es una manera muy rápida, podríamos calcular todas las # simulaciones de cada parámetro de manera vectorizada sims_posterior <- tibble(rep = 1:5000) %>% mutate(sims = map(rep, ~ simular_conjunta(.x, datos))) %>% unnest(cols = sims) sims_posterior ## # A tibble: 20,000 × 3 ## rep sabor valor_sim ## <int> <chr> <dbl> ## 1 1 fresa 0.732 ## 2 1 limón 0.831 ## 3 1 mango 0.850 ## 4 1 guanábana 0.397 ## 5 2 fresa 0.670 ## 6 2 limón 0.839 ## 7 2 mango 0.664 ## 8 2 guanábana 0.558 ## 9 3 fresa 0.671 ## 10 3 limón 0.758 ## # ℹ 19,990 more rows Y ahora podemos aproximar fácilmente la probabilidad de interés: sims_posterior %>% group_by(rep) %>% mutate(sabor = sabor[which.max(valor_sim)]) %>% group_by(sabor) %>% count() %>% ungroup() %>% mutate(prop = n / sum(n)) ## # A tibble: 4 × 3 ## sabor n prop ## <chr> <int> <dbl> ## 1 fresa 1264 0.0632 ## 2 guanábana 8 0.0004 ## 3 limón 5396 0.270 ## 4 mango 13332 0.667 Y vemos que los mejores sabores son mango y limón. La probabilidad posterior de que mango sea el sabor preferido por la población es de 66%. La integral correspondiente no es trivial. ¿Cuáles son las probabilidades a priori de que cada sabor sea el preferido por la población? ¿Cuál es la integral correspondiente a las probabilidades que acabamos de calcular? ¿Qué tan fácil es hacer esta integral de manera analítica? Calcula la probabilidad de que mango sea preferido a limón? ¿Qué conclusión práctica sacas de estos resultados? Simulando de la posterior Hemos establecido que podemos contestar varias preguntas de inferencia usando simulación Monte Carlo, y que este enfoque es potencialmente escalable (en contraste con métodos de integración numérica por cuadrícula). Ahora el problema que necesitamos resolver es el siguiente: Conocemos \\(p(\\theta |x)\\) módulo una constante de integración. En general, \\(p(\\theta|x)\\) no tiene una forma reconocible que corresponda a un simulador estándar. ¿Cómo simulamos de esta posterior cuando sólo sabemos calcular \\(p(x|\\theta)p(\\theta)\\)? Hay varias maneras de hacer esto. Presentaremos los algoritmos en términos de una distribución cualquiera \\(p(\\theta) = K f(\\theta)\\), donde sólo conocemos la función \\(f(\\theta)\\). 12.1 Ejemplo de islas Comenzamos revisando el ejemplo de las islas en Kruschke (2015) (7.2) para tener más intuición de cómo funciona este algoritmo. ¿Por qué funciona Metrópolis? Supongamos que un vendedor de Yakult trabaja a lo largo de una cadena de islas: Constantemente viaja entre las islas ofreciendo sus productos; Al final de un día de trabajo decide si permanece en la misma isla o se transporta a una de las \\(2\\) islas vecinas; El vendedor ignora la distribución de la población en las islas y el número total de islas; sin embargo, una vez que se encuentra en una isla puede investigar la población de la misma y también de la isla a la que se propone viajar después. El objetivo del vendedor es visitar las islas de manera proporcional a la población de cada una. Con esto en mente el vendedor utiliza el siguiente proceso: Lanza un volado, si el resultado es águila se propone ir a la isla del lado izquierdo de su ubicación actual y si es sol a la del lado derecho. Si la isla propuesta en el paso anterior tiene población mayor a la población de la isla actual, el vendedor decide viajar a ella. Si la isla vecina tiene población menor, entonces visita la isla propuesta con una probabilidad que depende de la población de las islas. Sea \\(P^*\\) la población de la isla propuesta y \\(P_{t}\\) la población de la isla actual. Entonces el vendedor cambia de isla con probabilidad \\[q_{mover}=P^*/P_{t}\\] A la larga, si el vendedor sigue la heurística anterior la probabilidad de que el vendedor este en alguna de las islas coincide con la población relativa de la isla. islas <- tibble(islas = 1:10, pob = 1:10) camina_isla <- function(i){ # i: isla actual u <- runif(1) # volado v <- ifelse(u < 0.5, i - 1, i + 1) # isla vecina (índice) if (v < 1 | v > 10) { # si estás en los extremos y el volado indica salir return(i) } p_move = ifelse(islas$pob[v] > islas$pob[i], 1, islas$pob[v] / islas$pob[i]) u2 <- runif(1) if (p_move > u2) { return(v) # isla destino } else { return(i) # me quedo en la misma isla } } pasos <- 100000 iteraciones <- numeric(pasos) iteraciones[1] <- sample(1:10, 1) # isla inicial for (j in 2:pasos) { iteraciones[j] <- camina_isla(iteraciones[j - 1]) } caminata <- tibble(pasos = 1:pasos, isla = iteraciones) plot_caminata <- ggplot(caminata[1:1000, ], aes(x = pasos, y = isla)) + geom_point(size = 0.8) + geom_path(alpha = 0.5) + coord_flip() + labs(title = "Caminata aleatoria") + scale_y_continuous(expression(theta), breaks = 1:10) + scale_x_continuous("Tiempo") plot_dist <- ggplot(caminata, aes(x = isla)) + geom_histogram() + scale_x_continuous(expression(theta), breaks = 1:10) + labs(title = "Distribución objetivo", y = expression(P(theta))) plot_caminata / plot_dist Entonces: Para aproximar la distribución objetivo debemos permitir que el vendedor recorra las islas durante una sucesión larga de pasos y registramos sus visitas. Nuestra aproximación de la distribución es justamente el registro de sus visitas. Más aún, debemos tener cuidado y excluir la porción de las visitas que se encuentran bajo la influencia de la posición inicial. Esto es, debemos excluir el periodo de calentamiento. Una vez que tenemos un registro largo de los viajes del vendedor (excluyendo el calentamiento) podemos aproximar la distribución objetivo simplemente contando el número relativo de veces que el vendedor visitó dicha isla. t <- c(1:10, 20, 50, 100, 200, 1000, 5000) plots_list <- map(t, function(i){ ggplot(caminata[1:i, ], aes(x = isla)) + geom_histogram() + labs(y = "", x = "", title = paste("t = ", i, sep = "")) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) }) wrap_plots(plots_list) Escribamos el algoritmo, para esto indexamos las islas por el valor \\(\\theta\\), es así que la isla del extremo oeste corresponde a \\(\\theta=1\\) y la población relativa de cada isla es \\(P(\\theta)\\): El vendedor se ubica en \\(\\theta^{(i)}\\) y propone moverse a la izquierda o derecha con probabilidad \\(0.5\\). El rango de los posibles valores para moverse, y la probabilidad de proponer cada uno se conoce como distribución propuesta, en nuestro ejemplo sólo toma dos valores cada uno con probabilidad \\(0.5\\). Una vez que se propone un movimiento, decidimos si aceptarlo. La decisión de aceptar se basa en el valor de la distribución objetivo en la posición propuesta, relativo al valor de la distribución objetivo en la posición actual: \\[\\alpha=\\min\\bigg\\{\\frac{P(\\theta^*)}{P(\\theta^{(i)})},1\\bigg\\},\\] donde \\(\\alpha\\) denota la probabilidad de hacer el cambio de isla. Notemos que la distribución objetivo \\(P(\\theta)\\) no necesita estar normalizada, esto es porque lo que nos interesa es el cociente \\(P(\\theta^*)/P(\\theta^{(i)})\\). Una vez que propusimos un movimiento y calculamos la probabilidad de aceptar el movimiento aceptamos o rechazamos el movimiento generando un valor de una distribución uniforme, si dicho valor es menor a la probabilidad de cambio, \\(\\alpha,\\) entonces hacemos el movimiento. Entonces, para utilizar el algoritmo necesitamos ser capaces de: Generar un valor de la distribución propuesta, que hemos denotado por \\(q,\\) (para crear \\(\\theta^*\\)). Evaluar la distribución objetivo en cualquier valor propuesto (para calcular \\(P(\\theta^*)/P(\\theta^{(i)})\\)). Generar un valor uniforme (para movernos con probabilidad \\(\\alpha\\)). Las \\(3\\) puntos anteriores nos permiten generar muestras aleatorias de la distribución objetivo, sin importar si esta está normalizada. Esta técnica es particularmente útil cuando cuando la distribución objetivo es una posterior proporcional a \\(p(x|\\theta)p(\\theta)\\). Para entender porque funciona el algoritmo de Metrópolis hace falta entender \\(2\\) puntos, primero que la distribución objetivo es estable: si la probabilidad actual de ubicarse en una posición coincide con la probabilidad en la distribución objetivo, entonces el algoritmo preserva las probabilidades. library(expm) transMat <- function(P){ # recibe vector de probabilidades (o población) T <- matrix(0, 10, 10) n <- length(P - 1) # número de estados for (j in 2:n - 1) { # llenamos por fila T[j, j - 1] <- 0.5 * min(P[j - 1] / P[j], 1) T[j, j] <- 0.5 * (1 - min(P[j - 1] / P[j], 1)) + 0.5 * (1 - min(P[j + 1] / P[j], 1)) T[j, j + 1] <- 0.5 * min(P[j + 1] / P[j], 1) } # faltan los casos j = 1 y j = n T[1, 1] <- 0.5 + 0.5 * (1 - min(P[2] / P[1], 1)) T[1, 2] <- 0.5 * min(P[2] / P[1], 1) T[n, n] <- 0.5 + 0.5 * (1 - min(P[n - 1] / P[n], 1)) T[n, n - 1] <- 0.5 * min(P[n - 1] / P[n], 1) T } T <- transMat(islas$pob) w <- c(0, 1, rep(0, 8)) t <- c(1:10, 20, 50, 100, 200, 1000, 5000) expT <- map_df(t, ~data.frame(t = ., w %*% (T %^% .))) expT_long <- expT %>% gather(theta, P, -t) %>% mutate(theta = parse_number(theta)) ggplot(expT_long, aes(x = theta, y = P)) + geom_bar(stat = "identity", fill = "darkgray") + facet_wrap(~ t) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) El segundo punto es que el proceso converge a la distribución objetivo. Podemos ver, (en nuestro ejemplo sencillo) que sin importar el punto de inicio se alcanza la distribución objetivo. inicio_p <- function(i){ w <- rep(0, 10) w[i] <- 1 t <- c(1, 10, 50, 100) exp_t <- map_df(t, ~ data.frame(t = .x, inicio = i, w %*% (T %^% .))) %>% gather(theta, P, -t, -inicio) %>% mutate(theta = parse_number(theta)) exp_t } exp_t <- map_df(c(1, 3, 5, 9), inicio_p) ggplot(exp_t, aes(x = as.numeric(theta), y = P)) + geom_bar(stat = "identity", fill = "darkgray") + facet_grid(inicio ~ t) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) Método de Metrópolis En el método de Metrópolis, uno de los más antiguos, comenzamos con un valor inicial de los parámetros \\(\\theta^{(0)}\\) en el soporte de \\(p(\\theta)\\), es decir \\(p(\\theta^{(0)})>0.\\) Para \\(i=1, \\ldots, M\\), hacemos: Partiendo de \\(\\theta^{(i)}\\), hacemos un salto corto en una dirección al azar para obtener una propuesta \\(\\theta^* \\sim q(\\theta \\, |\\, \\theta^{(i)}).\\) Aceptamos or rechazamos el salto: Si \\(\\alpha = \\frac{f(\\theta^*)}{f(\\theta^{(i)})} \\geq 1\\), aceptamos el salto y ponemos \\(\\theta^{(i+1)}=\\theta^*\\). Regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1.\\) Si \\(\\alpha = \\frac{f(\\theta^*)}{f(\\theta^{(i)})} < 1\\), entonces aceptamos con probabilidad \\(\\alpha\\) el salto, ponemos \\(\\theta^{(i+1)}=\\theta^*\\) y regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1\\). Si rechazamos el salto, ponemos entonces \\(\\theta^{(i+1)}=\\theta^{(i)}\\) y regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1.\\) Requerimos también que la función que propone los saltos sea simétrica: es decir, \\(q(\\theta^*|\\theta^{(i)})\\) debe ser igual a \\(q(\\theta^{(i)}|\\theta^*)\\). Se puede modificar el algoritmo para tratar con una propuesta que no sea simétrica. Una elección común es escoger \\(q(\\theta^* |\\theta^{(i)})\\) como una \\(\\mathsf{N}(\\theta^{(i)}, \\sigma_{salto})\\). En este curso, escribiremos varios métodos de cadenas de Markov para estimación Monte Carlo (Markov Chain Monte Carlo, MCMC) desde cero para entender los básicos de cómo funciona. Sin embargo, en la práctica no hacemos esto, sino que usamos software estándar (Stan, JAGS, BUGS, etc.) para hacer este trabajo. Expertos en MCMC, métodos numéricos, y estadística a veces escriben partes de sus rutinas de simulación, y pueden lograr mejoras de desempeño considerables. Excepto para modelos simples, esto no es trivial de hacer garantizando resultados correctos. En resumen, todo el código de esta sección es de carácter ilustrativo. Utiliza implementaciones establecidas en las aplicaciones. Abajo implementamos el algoritmo con un salto de tipo normal: crear_metropolis <- function(fun_log, sigma_salto = 0.1){ # la entrada es la log posterior iterar_metropolis <- function(theta_inicial, n){ p <- length(theta_inicial) nombres <- names(theta_inicial) iteraciones <- matrix(0, nrow = n, ncol = p) colnames(iteraciones) <- nombres iteraciones[1,] <- theta_inicial for(i in 2:n){ theta <- iteraciones[i - 1, ] theta_prop <- theta + rnorm(p, 0, sigma_salto) # exp(log(p) - log(q)) = p/q cociente <- exp(fun_log(theta_prop) - fun_log(theta)) if(cociente >= 1 || runif(1,0,1) < cociente){ iteraciones[i, ] <- theta_prop } else { iteraciones[i, ] <- theta } } iteraciones_tbl <- iteraciones %>% as_tibble() %>% mutate(iter_num = row_number()) %>% select(iter_num, everything()) iteraciones_tbl } iterar_metropolis } E intentamos simular de una exponencial no normalizada: exp_no_norm <- function(x) { z <- ifelse(x > 0, exp(-0.5 * x), 0) log(z) } iterador_metro <- crear_metropolis(exp_no_norm, sigma_salto = 0.25) sims_tbl <- iterador_metro(c(theta = 0.5), 50000) ggplot(sims_tbl, aes(x = theta)) + geom_histogram() Ahora probemos con una \\(\\mathsf{Beta}(3, 2):\\) beta_no_norm <- function(x) { z <- ifelse(x > 0 && x < 1, (x^2)*(1-x), 0) log(z) } iterador_metro <- crear_metropolis(beta_no_norm, sigma_salto = 0.04) sims_metro_tbl <- iterador_metro(c(theta = 0.5), 50000) sims_indep_tbl <- tibble(iter_num = 1:30000, theta = rbeta(30000, 3, 2)) g_1 <- ggplot(sims_metro_tbl, aes(x = theta)) + geom_histogram() + labs(subtitle = "Metrópolis") g_2 <- ggplot(sims_indep_tbl, aes(x = theta)) + geom_histogram() + labs(subtitle = "rbeta") g_1 + g_2 Y vemos que esto funciona. Nótese sin embargo un aspecto de estas simulaciones que no habíamos encontrado en el curso. Aunque la distribución final de las simulaciones es muy cercana a la de la distribución que queremos simular, lo cual era nuestro propósito, las simulaciones no son extracciones independientes de esa distribución. La construcción del algoritmo muestra eso, pero podemos también graficar las simulaciones: g_metropolis <- sims_metro_tbl %>% filter(iter_num < 500) %>% ggplot(aes(x = iter_num, y = theta)) + geom_line() + labs(subtitle = "Metrópolis") g_indep <- sims_indep_tbl %>% filter(iter_num < 500) %>% ggplot(aes(x = iter_num, y = theta)) + geom_line() + labs(subtitle = "Independientes") g_metropolis + g_indep Donde vemos claramente que las simulaciones de metropolis están autocorrelacionadas: la siguiente simulación depende de la anterior. Esto define una cadena de Markov. En cualquiera de los dos casos, como vimos en los histogramas de arriba, las simulaciones “visitan” cada parte [0,1] de manera proporcional a la densidad, de manera que podemos usar ambos tipos de simulaciones para aproximar la integral o cantidad que nos interesa. Por ejemplo, la media posterior es: media_1 <- sims_metro_tbl %>% summarise(media_post = mean(theta)) %>% pull(media_post) media_2 <- sims_indep_tbl %>% summarise(media_post = mean(theta)) %>% pull(media_post) media_exacta <- 3/(3 + 2) tibble(metodo = c("sim Metrópolis", "sim Independiente", "exacto"), media_post = c(media_1, media_2, media_exacta)) ## # A tibble: 3 × 2 ## metodo media_post ## <chr> <dbl> ## 1 sim Metrópolis 0.605 ## 2 sim Independiente 0.602 ## 3 exacto 0.6 Supongamos que queremos simular de una distribución \\(p(\\theta)\\), pero sólo conocemos \\(p(\\theta)\\) módulo una constante. Bajo ciertas condiciones de regularidad: El algoritmo Metrópolis para la distribución \\(p(\\theta)\\) define una cadena de Markov cuya distribución a largo plazo es \\(p(\\theta)\\). Esto implica que si \\(\\theta^{(1)},\\theta^{(2)}, \\ldots, \\theta^{(M)}\\) es una simulación de esta cadena, y \\(M\\) es suficientemente grande La distribución de las \\(\\theta^{(i)}\\) es aproximadamente \\(p(\\theta)\\), Tenemos que \\[ \\frac1M \\sum_{m = 1}^M h(\\theta^{(m)}) \\to \\int h(\\theta)p(\\theta)\\, d\\theta\\] cuando \\(M\\to \\infty\\) Observaciones: Aunque hay distintas condiciones de regularidad que pueden funcionar, generalmente el supuesto es que la cadena de Markov construída es ergódica, y hay varias condiciones que garantizan esta propiedad. Una condición simple, por ejemplo, es que el soporte de la distribución \\(p(\\theta)\\) es un conjunto conexo del espacio de parámetros. Más crucialmente, este resultado no dice qué tan grande debe ser \\(M\\) para que la aproximación sea buena. Esto depende de cómo es \\(p(\\theta)\\), y de la distribución que se utiliza para obtener los saltos propuestos. Dependiendo de estos dos factores, la convergencia puede ser rápida (exponencial) o tan lenta que es infactible usarla. Más adelante veremos diagnósticos para descartar los peores casos de falta de convergencia. Ajustando el tamaño de salto En el algoritmo Metrópolis, generalmente es importante escoger la dispersión de la distribución que genera propuestas con cuidado. Si la dispersión de la propuesta es demasiado grande, tenderemos a rechazar mucho, y la convergencia será lenta. Si la dispersión de la propuesta es demasiado chica, tardaremos mucho tiempo en explorar las distintas partes de la distribución objetivo. Ejemplo Supongamos que queremos simular usando metróplis de una distribución \\(\\textsf{Gamma}(20, 100)\\). Abajo vemos la forma de esta distribución: sim_indep <- tibble(theta = rgamma(10000, 20, 100)) ggplot(sim_indep, aes(x = theta)) + geom_histogram() # logaritmo de densidad no normalizada log_f_dist <- function(x) 210 + dgamma(x, 20, 100, log = TRUE) # iterar iterador_metro_chico <- crear_metropolis(log_f_dist, sigma_salto = 0.001) sims_chico_tbl <- iterador_metro_chico(c(theta = 0.02), 50000) g_sim <- ggplot(sims_chico_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) dist_bplot <- ggplot(tibble(x = rgamma(10000, 20, 100)), aes(y = x, x = "a")) + geom_violin() + ylab("") + ylim(0, 0.5) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) Nótese que después de 5 mil iteraciones estamos muy lejos de tener una muestra que se aproxime a la distribución objetivo. Empezamos en un lugar bajo, y la cadena sólo ha ido lentamente hacia las zonas de alta densidad. Cualquier resumen con esta cadena estaría fuertemente sesgado al valor donde iniciamos la iteración. Decimos que la cadena todavía no mezcla en las primeras 5 mil iteraciones. Ahora vemos qué pasa si ponemos el tamaño de salto demasiado grande: set.seed(831) iterador_metro_grande <- crear_metropolis(log_f_dist, sigma_salto = 20) sims_grande_tbl <- iterador_metro_grande(c(theta = 0.02), 50000) g_sim <- ggplot(sims_grande_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) En este caso, la cadena se atora muchas veces, pues las propuestas tienen probabilidad muy baja, y tendemos a tener una tasa de rechazos muy alta. Esto quiere decir que la información que tenemos acerca de la posterior es relativamente poca, pues muchos datos son repeticiones del mismo valor. Cualquier resumen con esta cadena podría estar muy lejos del verdadero valor, pues su varianza es alta - otra corrida se “atoraría” en otros valores distintos. Nótese que cualquiera de estas cadenas, si la corremos suficientemente tiempo, nos daría resultados buenos. Sin embargo, el número de simulaciones puede ser infactible. Un valor intermedio nos dará mucho mejores resultados: set.seed(831) iterador_metro_apropiada <- crear_metropolis(log_f_dist, sigma_salto = 0.1) sims_tbl <-iterador_metro_apropiada(c(theta = 0.02), 50000) g_sim <- ggplot(sims_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) Donde vemos que esta cadena parece mezclar bien (está explorando la totalidad de la distribución objetivo), y también parece estar en un estado estable. Comparemos cómo saldría por ejemplo la media posterior aproximada según los tres métodos: estimaciones_media <- map_dfr( list(sims_chico_tbl, sims_grande_tbl, sims_tbl), ~ filter(.x, iter_num < 3000) %>% summarise(media = mean(theta))) %>% mutate(tipo = c("salto chico", "salto grande", "salto apropiado")) estimaciones_media %>% bind_rows(tibble(tipo = "exacta", media = 20/100)) %>% select(tipo, media) ## # A tibble: 4 × 2 ## tipo media ## <chr> <dbl> ## 1 salto chico 0.128 ## 2 salto grande 0.190 ## 3 salto apropiado 0.203 ## 4 exacta 0.2 Veamos otra corrida: set.seed(6222131) sims_chica_tbl <- iterador_metro_chico(c(theta = 0.02), 5000) sims_grande_tbl <- iterador_metro_grande(c(theta = 0.02), 5000) estimaciones_media <- map_dfr( list(sims_chica_tbl, sims_grande_tbl, sims_tbl), ~ filter(.x, iter_num < 3000) %>% summarise(media = mean(theta))) %>% mutate(tipo = c("salto chico", "salto grande", "salto apropiado")) estimaciones_media %>% bind_rows(tibble(tipo = "exacta", media = 20/100)) %>% select(tipo, media) ## # A tibble: 4 × 2 ## tipo media ## <chr> <dbl> ## 1 salto chico 0.124 ## 2 salto grande 0.229 ## 3 salto apropiado 0.203 ## 4 exacta 0.2 Repite este proceso varias veces. Verifica que: Si el tamaño de paso es muy chico, las estimaciones de la media tienen sesgo alto. Si el tamaño de paso es muy grande, las estimaciones tienen varianza alta. Si el tamaño de paso es adecuado, obtenemos buena precisión en la estimación de la media posterior. Explica estos tres casos en términos de la convergencia de las realizaciones de la cadena de Markov. Explica cómo afecta a cada caso el valor inicial de las simulaciones de Metrópolis. Repite para otra estadística, como la desviación estándar o el rangon intercuartil. Metrópolis con varios parámetros Ahora aplicaremos el algoritmo Metrópolis cuando tenemos varios parámetros. La idea es la misma, pero nuestra distribución de salto debe ser multivariada. Una selección usual es usando saltos normales independientes para cada parámetro, es decir, la normal multivariada con matriz de varianza y covarianza diagonal. Ejemplo: el modelo normal Veremos cómo simular con Metrópolis para el problema de los cantantes. Sabemos como calcular la posterior: crear_log_posterior_norm <- function(x = datos, m_0, n_0, a, b){ # calcula log_posterior log_posterior <- function(mu, sigma){ log_verosim <- sum(dnorm(x, mu, sigma, log = TRUE)) tau <- 1 / sigma^2 log_inicial <- dgamma(tau, a, b, log = TRUE) + dnorm(mu, mu_0, sigma/sqrt(n_0), log = TRUE) log_p <- log_verosim + log_inicial log_p } log_posterior } # parametros de inicial y datos a <- 3 b <- 140 mu_0 <- 175 n_0 <- 5 set.seed(3413) cantantes <- lattice::singer %>% mutate(estatura_cm = round(2.54 * height)) %>% filter(str_detect(voice.part, "Tenor")) %>% sample_n(20) Vemos cómo se ven las primeras iteraciones de nuestra cadena de Markov: log_p <- crear_log_posterior_norm(cantantes$estatura_cm, mu_0, n_0, a, b) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(823) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 172, sigma = 3), 50000) ggplot(sim_tbl %>% filter(iter_num < 100), aes(x = mu, y = sigma)) + geom_path() + geom_point() Y ahora vemos todas las simulaciones: g_normal <- ggplot(sim_tbl, aes(x = mu, y = sigma)) + geom_point(alpha = 0.05)+ coord_equal() + ylim(c(0, 14)) g_normal Y las medias posteriores son: sim_tbl %>% summarise(across(is_double, mean)) ## # A tibble: 1 × 2 ## mu sigma ## <dbl> <dbl> ## 1 176. 6.80 Ejemplo: observaciones normales, no conjugado Arriba repetimos el análisis conjugado usando Metrópolis. Aunque ya no es necesario usar el modelo conjugado, y podemos poner iniciales que sean más intuitivas y acorde con nuestro conocimiento existente. Por ejemplo, podemos poner \\(p(\\mu, \\sigma) = p(\\mu)p(\\sigma)\\), donde la densidad de \\(\\mu \\sim \\mathsf{N}(175, 2)\\) y \\(\\sigma \\sim \\mathsf{U}[2, 20].\\) Igual que antes, la verosimilitud \\(p(x|\\mu, \\sigma)\\) es normal con media \\(\\mu\\) y desviación estándar \\(\\sigma.\\) Escribimos la posterior: crear_log_posterior <- function(x, m_0, sigma_0, inf, sup){ # calcula log_posterior log_posterior <- function(mu, sigma){ log_verosim <- sum(dnorm(x, mu, sigma, log = TRUE)) log_inicial <- dunif(sigma, inf, sup, log = TRUE) + dnorm(mu, mu_0, sigma_0, log = TRUE) log_p <- log_verosim + log_inicial log_p } log_posterior } log_p <- crear_log_posterior(cantantes$estatura_cm, 175, 3, 2, 20) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(8231) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 172, sigma = 5), 50000) g_normal_2 <- ggplot(sim_tbl, aes(x = mu, y = sigma)) + geom_point(alpha = 0.05) + coord_equal() + ylim(c(0, 14)) g_normal + g_normal_2 Los resultados son similares, pero en nuestras estimaciones bajo el segundo modelo, la \\(\\sigma\\) está concentrada en valores un poco más bajos que el modelo normal-gamma inversa. Las medias posteriores son: sim_tbl %>% summarise(across(is.numeric, mean)) ## # A tibble: 1 × 3 ## iter_num mu sigma ## <dbl> <dbl> <dbl> ## 1 25000. 176. 6.54 Nótese que la inicial para el modelo normal-gamma inversa pone muy poca probabilidad para valores bajos de \\(\\sigma\\), mientras que el segundo modelo hay un 10% de probabilidad de que la \\(\\sigma\\) sea menor que 4. tau <- rgamma(5000, 3, 150) sigma <- 1/sqrt(tau) quantile(sigma, c(0.01,0.1, 0.9, 0.99)) ## 1% 10% 90% 99% ## 4.219278 5.276228 11.579358 19.038529 quantile(runif(5000, 2, 25), c(0.01,0.1, 0.9, 0.99)) ## 1% 10% 90% 99% ## 2.261297 4.254128 22.691760 24.719630 Ejemplo: exámenes Recordamos un ejemplo que vimos en la sección de máxima verosimilitud. Supongamos que en una población de estudiantes tenemos dos tipos: unos llenaron un examen de opción múltiple al azar (1 de 5), y otros contestaron las preguntas intentando sacar una buena calificación. Suponemos que una vez que conocemos el tipo de estudiante, todas las preguntas tienen la misma probabilidad de ser contestadas correctamente, de manera independiente. El modelo teórico está representado por la siguiente simulación: sim_formas <- function(p_azar, p_corr){ tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } Y una muestra se ve como sigue: set.seed(12) muestra <- map_dbl(1:200, ~ sim_formas(0.35, 0.5)) qplot(muestra) Supongamos que no conocemos la probabildad de contestar correctamente ni la proporción de estudiantes que contestó al azar. ¿Como estimamos estas dos cantidades? La verosimilitud la escribimos en el ejercicio anterior en la sección de máxima verosimilitud, está dada, para las repuestas de un estudiante, por: \\[p(X = k|\\theta_{azar}, \\theta_{corr}) \\propto \\theta_{azar}(1/5)^k(4/5)^{10-k} + (1-\\theta_{azar})\\theta_{corr}^k(1-\\theta_{corr})^{10-k}\\] Suponiendo que todas las preguntas tienen la misma dificultad, y que los estudiantes que estudiaron son homogéneos (podemos discutir qué haríamos para introducir heterogeneidad que típicamente observaríamos). Creemos que la mayoría de los estudiantes no contesta al azar, así que pondremos como inicial \\[\\theta_{azar} \\sim \\mathsf{Beta}(1, 5)\\] qbeta(c(0.1, 0.9), 1, 5) %>% round(2) ## [1] 0.02 0.37 Ahora tenemos que pensar en la probabilidad \\(\\theta_{corr}\\) para los estudiantes que sí estudiaron. Imaginemos que lo probamos con un estudiante que sabemos que sí estudió, y obtuvo un porcentaje de correctos de 7/10, Podríamos poner entonces (vimos 10 intentos, con 3 fracasos y 7 éxitos): \\[\\theta_{corr} \\sim \\mathsf{Beta}(7, 3)\\] Finalmente, necesitamos la conjunta inicial. Pondremos \\[p(\\theta_{azar},\\theta_{corr}) = p(\\theta_{azar})p(\\theta_{corr})\\] con lo que expresamos que inicialmente no creemos que estos dos parámetros estén relacionados. Si pensáramos, por ejemplo, que cuando hacemos exámenes difíciles menos estudiantes estudian, entonces deberíamos intentar otra conjunta. Escribimos el producto de la verosimilitud con la inicial: crear_log_posterior <- function(x){ log_posterior <- function(theta_azar, theta_corr){ log_verosim <- sum(log(theta_azar * dbinom(x, 10, 1/5) + (1 - theta_azar) * dbinom(x, 10, theta_corr))) log_inicial <- dbeta(theta_azar, 1, 5, log = TRUE) + dbeta(theta_corr, 7, 3, log = TRUE) log_post <- log_verosim + log_inicial log_post } log_posterior } Creamos la función de verosimilitud con los datos log_p <- crear_log_posterior(muestra) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(8231) metro_examenes <- crear_metropolis(log_post, sigma_salto = 0.02) sim_tbl <- metro_examenes(c(theta_azar = 0.5, theta_corr = 0.5), 20000) g_1 <- ggplot(sim_tbl, aes(x = theta_azar, y = theta_corr)) + geom_point(alpha = 0.05) + coord_equal() g_1 Nótese que hay cierta correlación entre las dos proporciones, y esto produce intervalos posteriores relativamente amplios. Esto es de esperarse, pues los datos son consistentes con una proporción relativamente chica de estudiantes que contestan al azar, y tasas de correctos más altas entre los que sí estudian, y una proporción más grande de respuestas al azar con tasas de correctos más altas. f <- c(0.05, 0.5, 0.95) sim_tbl %>% pivot_longer(-iter_num, names_to = "parametro", values_to = "valor") %>% group_by(parametro) %>% summarise(cuantil = quantile(valor, f), f = f) %>% mutate(cuantil = round(cuantil, 2)) %>% pivot_wider(names_from = f, values_from = cuantil) ## # A tibble: 2 × 4 ## # Groups: parametro [2] ## parametro `0.05` `0.5` `0.95` ## <chr> <dbl> <dbl> <dbl> ## 1 theta_azar 0.3 0.38 0.45 ## 2 theta_corr 0.5 0.52 0.56 Muestreador de Gibbs El algoritmo de Metrópolis es muy general y se puede aplicar a una gran variedad de problemas. Sin embargo, afinar los parámetros de la distribución propuesta para que el algoritmo funcione correctamente puede ser complicado. El muestredor de Gibbs no necesita de una distribución propuesta y por lo tanto no requiere afinar estos parámetros. Para implementar un muestreador de Gibbs se necesita ser capaz de generar muestras de la distribución posterior condicional a cada uno de los parámetros individuales. Esto es, el muestreador de Gibbs permite generar muestras de la posterior: \\[p(\\theta_1,...,\\theta_p|x)\\] siempre y cuando podamos generar valores de todas las distribuciones condicionales: \\[\\theta_k \\sim p(\\theta_k|\\theta_1,...,\\theta_{k-1},\\theta_{k+1},...,\\theta_p,x).\\] El proceso del muestreador de Gibbs es una caminata aleatoria a lo largo del espacio de parámetros. La caminata inicia en un punto arbitrario y en cada tiempo el siguiente paso depende únicamente de la posición actual. Por tanto el muestredor de Gibbs es un proceso cadena de Markov vía Monte Carlo. La diferencia entre Gibbs y Metrópolis radica en como se deciden los pasos. Muestreador Gibbs En cada punto de la caminata se selecciona uno de los componentes del vector de parámetros (típicamente se cicla en orden): Supongamos que se selecciona el parámetro \\(k\\)-ésimo después de haber modificado los \\(k-1\\) anteriores, entonces obtenemos un nuevo valor para este parámetro generando una simulación de la distribución condicional \\[\\theta_k^{(i+1)} \\sim p(\\theta_k|\\theta_1^{(i+1)},\\ldots,\\theta_{k-1}^{(i+1)},\\theta_{k+1}^{(i)},\\ldots,\\theta_p^{(i)},x)\\] El nuevo valor \\(\\theta_k^{(i+1)}\\) junto con los valores \\(\\theta_1^{(i+1)},\\ldots,\\theta_{k-1}^{(i+1)},\\theta_{k+1}^{(i)},\\ldots,\\theta_p^{(i)}\\) constituyen la nueva posición en la caminata aleatoria. Seleccionamos una nueva componente \\(\\theta_{k+1}^{(i+1)}\\) y repetimos el proceso. El muestreador de Gibbs es útil cuando no podemos determinar de manera analítica la distribución conjunta y no se puede simular directamente de ella, pero sí podemos determinar todas las distribuciones condicionales y simular de ellas. Ejemplo: dos proporciones Supongamos que queremos evaluar el balanceo de dos dados de 20 lados que produce una fábrica. En particular, evaluar la probabilidad de tirar un 20, y quizá escoger el dado que nos de mayor probabilidad de tirar un 20. Tiramos cada dado \\(n\\) veces, y denotamos por \\(X_1\\) y \\(X_2\\) el número de 20’s que tiramos en cada ocasión. El modelo de datos está dado por \\[p(x_1, x_2|\\theta_1, \\theta_2)\\propto \\theta_1^{x_1}(1-\\theta_1)^{n - x_1}\\theta_2^{x_2}(1-\\theta_2)^{n - x_2},\\] que es el producto de dos densidades binomiales, pues suponemos que las tiradas son independientes cuando conocemos los parámetros \\(\\theta_1\\) y \\(\\theta_2\\). Ahora ponemos una inicial \\[p(\\theta_i)\\sim \\mathsf{Beta}(100, 1900)\\] y aquí están las razones de nuestra elección: media <- 1/20 k <- 2000 a <- media * k b <- (1 - media) * k c(a,b) ## [1] 100 1900 qbeta(c(0.05, 0.95), a, b) %>% round(3) ## [1] 0.042 0.058 y suponemos que \\[p(\\theta_1,\\theta_2) = p (\\theta_1)p(\\theta_2)\\] es decir, apriori saber el desempeño de un dado no nos da información adicional del otro (esto podría no ser cierto, por ejemplo, si el defecto es provocado por la impresión del número 20). Por lo tanto, la posterior es \\[p(\\theta_1,\\theta_2|x_1, x_2)\\propto \\theta_1^{x_1+100-1}(1-\\theta_1)^{n - x_1 + 1900-1}\\theta_2^{x_2+100 -1}(1-\\theta_2)^{n - x_2 + 1900-1}\\] Ahora consideramoso qué pasa cuando conocemos \\(\\theta_2\\) y los datos. Pensamos en todo lo que no sea \\(\\theta_1\\) como constante de modo que nos queda: \\[p(\\theta_1 | \\theta_2, x) \\propto \\theta_1^{x_1+100 -1}(1-\\theta_1)^{n - x_1 + 1900 -1}\\] que es \\(\\mathsf{Beta}(x_1 + 100, n - x_1 + 1900)\\), y por la misma razón, \\[p(\\theta_2 | \\theta_1, x) \\propto \\theta_2^{x_2+100-1}(1-\\theta_2)^{n - x_2 + 1900-1}\\] que también es es \\(\\mathsf{Beta}(x_1 + 100, n - x_1 + 1900)\\) De hecho, estas condicionales son fáciles de deducir de otra manera: en realidad estamos haciendo dos experimentos separados (pues suponemos que las iniciales son independientes y las pruebas también), así que podriamos usar el análisis Beta-Binomial para cada uno de ellos. En realidad no es necesario usar MCMC para este ejemplo. Usaremos esta función para hacer nuestras iteraciones de Gibbs: iterar_gibbs <- function(pasos, n, x_1, x_2){ iteraciones <- matrix(0, nrow = pasos + 1, ncol = 2) # vector guardará las simulaciones iteraciones[1, 1] <- 0.5 # valor inicial media colnames(iteraciones) <- c("theta_1", "theta_2") # Generamos la caminata aleatoria for (j in seq(2, pasos, 2)) { # theta_1 a <- x_2 + 100 - 1 b <- n - x_2 + 1900 - 1 iteraciones[j, "theta_2"] <- rbeta(1, a, b) # Actualizar theta_1 iteraciones[j, "theta_1"] <- iteraciones[j-1, "theta_1"] # theta_2 a <- x_1 + 100 - 1 b <- n - x_1 + 1900 - 1 iteraciones[j + 1, "theta_1"] <- rbeta(1, a, b) # Actualizar theta_1 iteraciones[j + 1, "theta_2"] <- iteraciones[j, "theta_2"] } iteraciones } Y supongamos que estamos comparando los dados de dos compañías: Chessex y GameScience. Tiramos cada dado 10 mil veces, y obtenemos: # Datos de https://www.awesomedice.com/blogs/news/d20-dice-randomness-test-chessex-vs-gamescience n <- 10000 x_1 <- 408 # Chessex, alrededor de 0.85 dólares por dado x_2 <- 474 # GameScience, alrededor 1.60 dólares por dado E iteramos: iteraciones <- iterar_gibbs(20000, n, x_1, x_2) %>% as_tibble() %>% mutate(iter_num = row_number()) head(iteraciones) ## # A tibble: 6 × 3 ## theta_1 theta_2 iter_num ## <dbl> <dbl> <int> ## 1 0.5 0 1 ## 2 0.5 0.0479 2 ## 3 0.0442 0.0479 3 ## 4 0.0442 0.0452 4 ## 5 0.0411 0.0452 5 ## 6 0.0411 0.0505 6 ggplot(filter(iteraciones, iter_num > 1000, iter_num< 1050), aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() g_1 <- ggplot(iteraciones, aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() g_2 <- ggplot(iteraciones %>% filter(iter_num > 10), aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() + geom_abline(colour = "red") + geom_point(data= tibble(theta_1=1/20, theta_2=1/20), colour = "red", size = 5) g_1 + g_2 Notamos el dado de Cheesex no es consistente con 1/20 de tiros de 20s, pero el dado de GameScience sí lo es. De este gráfica vemos que Cheesex está sesgado hacia abajo, así que deberíamos escoger el dado de GameScience Podemos ver directamente cómo se distribuye la diferencia \\(\\theta_1 - \\theta_2\\). Cualquier estadística es fácil de evaluar, pues simplemente la calculamos para cada simulación y después resumimos: iteraciones <- iteraciones %>% mutate(dif = theta_1 - theta_2) ggplot(iteraciones %>% filter(iter_num > 10), aes(x = dif)) + geom_histogram(bins = 100) + geom_vline(xintercept = 0, colour = "red") Y vemos que es altamente probable que el dado de Cheesex produce más 20’s que el dado de GameScience. iteraciones %>% mutate(theta_1_mayor = dif > 0) %>% summarise(prob_theta_1_mayor = mean(theta_1_mayor)) ## # A tibble: 1 × 1 ## prob_theta_1_mayor ## <dbl> ## 1 0.0215 Finalmente, verificamos nuestro modelo y cuánto aprendimos. Podemos hacerlo simulando de la inicial y comparando con la posterior: inicial_tbl <- tibble(theta_1 = rbeta(20000, 100, 1900), theta_2 = rbeta(20000, 100, 1900), dist = "inicial") posterior_tbl <- iteraciones %>% filter(iter_num > 10) %>% mutate(dist = "posterior") sims_tbl <- bind_rows(inicial_tbl, posterior_tbl) ggplot(sims_tbl, aes(x = theta_1, y = theta_2, colour = dist)) + geom_point(alpha = 0.2) donde vemos que el resultado que obtuvimos es razonablemente consistente con nuestra información inicial, y las 10 mil tiradas de dado fueron altamente informativas. ¿Qué crees que pasaría si sólo hubieramos tirado 40 veces cada dado? ¿Qué tanto habríamos aprendido? Puedes usar datos simulados y repetir este ejercicio. Puedes examinar los resultados para cada cara con los datos originales. Un modelo apropiado es el Dirichlet-Multinomial. Ejemplo: Modelo normal no conjugado Retomemos el caso de observaciones normales, supongamos que tenemos una muestra \\(X_1,...,X_n\\) de observaciones independientes e identicamente distribuidas, con \\(X_i \\sim \\mathsf{N}(\\mu, \\sigma^2)\\). Usaremos iniciales distintas al modelo anterior: \\[p(\\mu, \\sigma^2) = p(\\sigma^2)p(\\mu)\\] con \\(\\mu\\) \\(\\mathsf{N}(\\mu_0, \\sigma_0)\\) y \\(\\tau = 1/\\sigma^2\\) con distribución \\(\\mathsf{Gamma}(a,b)\\). Esto no nos da el modelo conjugado que vimos antes (nota la diferencia de la especificación de la inicial conjunta). Comenzamos por escribir \\[p(\\mu, \\sigma^2|x) \\propto \\frac{1}{{\\sigma^{n/2}}} \\exp(-\\sum\\frac{(x_i-\\mu)²}{2\\sigma^2}) \\exp(- \\frac{(\\mu - \\mu_0)^2}{2\\sigma_0^2}) \\frac{1}{(\\sigma^2)^{a + 1}}\\exp (-\\beta/\\sigma^2 )\\] Comenzamos analizando \\(p(\\mu|\\sigma^2, x)\\). Por la ecuación de arriba, e ignorando los términos que no dependen de \\(\\mu\\): \\[p(\\mu|\\sigma^2, x) \\propto \\exp [ - \\sum_i (\\frac{(\\mu - x_i)^2}{2\\sigma^2} - \\frac{(\\mu - \\mu_0)^2}{2n\\sigma_0^2})]\\] que es una distribución normal (completa cuadrados): \\[\\mu|\\sigma^2,x \\sim \\mathsf{N}\\bigg(\\frac{\\sigma^2}{\\sigma^2 + n\\sigma_0^2}\\mu_0 + \\frac{n\\sigma_0^2}{\\sigma^2 + n \\sigma_0^2}\\bar{x}, \\frac{\\sigma \\sigma_0}{\\sqrt{\\sigma^2 + n\\sigma_0^2}}\\bigg)\\] Ahora consideramos \\(p(\\sigma^2|mu,x)\\). Ignoramos en \\(p(\\mu,\\sigma^2|x)\\) los términos que *no** dependen de \\(\\sigma^2\\): \\[p(\\sigma^2|\\mu, x) \\propto \\frac{1}{\\sigma^{n/2}} \\exp(-\\sum\\frac{(x_i-\\mu)²}{2\\sigma^2}) \\frac{1}{(\\sigma^2)^{a + 1}}\\exp (-\\beta/\\sigma^2)\\] que simplificando da \\[ = \\frac{1}{\\sigma^{n/2 + a + 1}}\\exp( -\\frac{\\beta +\\frac{1}{2}\\sum(x_i - \\mu)^2}{\\sigma^2} )\\] de modo que \\[\\sigma^2|\\mu, x \\sim \\mathsf{GI}(a +n/2, b + \\frac{1}{2}\\sum(x_i -\\mu)^2)\\] Ejemplo Usaremos este muestreador para el problema de la estaturas de los tenores. Comenzamos definiendo las distribuciones iniciales: \\(\\mu \\sim \\mathsf{N}(175, 3)\\) \\(\\tau = 1/\\sigma^2 \\sim \\mathsf{GI}(3, 150)\\), esto es \\(a = 3\\) y \\(b = 150\\). Escribimos el muestreador de Gibbs. n <- 20 x <- cantantes$estatura_cm m <- 175; sigma_0 <- 3; alpha <- 3; beta <- 150 # parámetros de iniciales pasos <- 20000 iteraciones <- matrix(0, nrow = pasos + 1, ncol = 2) # vector guardará las simulaciones iteraciones[1, 1] <- 0 # valor inicial media colnames(iteraciones) <- c("mu", "sigma") # Generamos la caminata aleatoria for (j in seq(2, pasos, 2)) { # sigma^2 mu <- iteraciones[j - 1, "mu"] a <- n / 2 + alpha b <- sum((x - mu) ^ 2) / 2 + beta iteraciones[j, "sigma"] <- sqrt(1/rgamma(1, a, b)) # Actualizar sigma iteraciones[j, "mu"] <- iteraciones[j-1, "mu"] # mu sigma <- iteraciones[j, "sigma"] media <- (n * sigma_0^2 * mean(x) + sigma^2 * m) / (n * sigma_0^2 + sigma^2) varianza <- sigma^2 * sigma_0^2 / (n * sigma_0^2 + sigma^2) iteraciones[j+1, "mu"] <- rnorm(1, media, sd = sqrt(varianza)) # actualizar mu iteraciones[j+1, "sigma"] <- iteraciones[j, "sigma"] } caminata <- data.frame(pasos = 1:pasos, mu = iteraciones[1:pasos, "mu"], sigma = iteraciones[1:pasos, "sigma"]) caminata_g <- caminata %>% gather(parametro, val, mu, sigma) %>% arrange(pasos) Veamos primero algunos pasos: ggplot(filter(caminata, pasos > 1000, pasos< 1010), aes(x = mu, y = sigma)) + geom_path(alpha = 0.3) + geom_point() Donde vemos cómo en cada iteración se actualiza un solo parámetro. Una alternativa es conservar únicamente ciclos completos de la caminata u esto es lo que hacen varios programas que implementan Gibbs, sin embargo ambas cadenas (cadenas completas y conservando únicamente ciclos completos) convergen a la misma distribución posterior. Si tomamos iteraciones completas: ggplot(filter(caminata, pasos > 1000, pasos< 1020, pasos %% 2 == 0), aes(x = mu, y = sigma)) + geom_path(alpha = 0.3) + geom_point() Y ahora vemos cómo se ven las simulaciones: ggplot(filter(caminata, pasos > 1000, pasos< 10000, pasos %% 2 == 0), aes(x = mu, y = sigma)) + geom_point(alpha = 0.1) Y el diagnóstico de cada cadena: ggplot(filter(caminata_g, pasos > 15000), aes(x = pasos, y = val)) + geom_path(alpha = 0.3) + facet_wrap(~parametro, ncol = 1, scales = "free") + scale_y_continuous("") Estas cadenas parecen estar mezclando bien. Podemos resumirlas: ggplot(filter(caminata_g, pasos > 5000), aes(x = val)) + geom_histogram(fill = "gray") + facet_wrap(~parametro, ncol = 1, scales = "free") caminata_g %>% filter(pasos > 1000) %>% # eliminamos la etapa de calentamiento group_by(parametro) %>% summarise( mean(val), sd(val), median(val) ) %>% mutate(across(is_double, round, 2)) ## # A tibble: 2 × 4 ## parametro `mean(val)` `sd(val)` `median(val)` ## <chr> <dbl> <dbl> <dbl> ## 1 mu 176. 1.32 176. ## 2 sigma 6.54 0.95 6.44 Y obtenemos un resultado similar a los anteriores. Conclusiones y observaciones Metrópolis y Gibbs Una generalización del algoritmo de Metrópolis es Metrópolis-Hastings. El algoritmo de Metrópolis es como sigue: Generamos un punto inicial tal que \\(p(\\theta)>0\\). Para \\(i = 1,2,...\\) Se propone un nuevo valor \\(\\theta^*\\) con una distribución propuesta \\(g(\\theta^*|\\theta^{(i)})\\) es común que \\(g(\\theta^*|\\theta^{(i)})\\) sea una normal centrada en \\(\\theta^{(i)}\\). Calculamos la probabilidad de aceptación \\[\\alpha=\\min\\bigg\\{\\frac{p(\\theta^*)}{p(\\theta^{(i)})},1\\bigg\\},\\] y aceptamos \\(\\theta^*\\) con probabilidad \\(p_{mover}\\). Es así que el algorito requiere que podamos calcular el cociente en \\(p_{mover}\\) para todo \\(\\theta^{(i)}\\) y \\(\\theta^*\\), así como simular de la distribución propuesta \\(g(\\theta^*|\\theta^{(i)})\\), adicionalmente debemos poder generar valores uniformes para decidir si aceptar/rechazar. En el caso de Metrópolis un requerimiento adicional es que la distribución propuesta \\(g(\\theta_{a}|\\theta_b)\\) debe ser simétrica, es decir \\(g(\\theta_{a}|\\theta_b) = g(\\theta_{b}|\\theta_a)\\) para todo \\(\\theta_{a}\\), \\(\\theta_{b}\\). Metrópolis-Hastings generaliza Metrópolis, eliminando la restricción de simetría en la distribución propuesta \\(g(\\theta_{a}|\\theta_b)\\), sin embargo para corregir por esta asimetría debemos calcular \\(\\alpha\\) como sigue: \\[\\alpha=\\min\\bigg\\{ \\frac{p(\\theta^*)}{g(\\theta^*|\\theta^{(i)})} \\cdot \\frac{g(\\theta^{(i)}|\\theta^*)}{p(\\theta^{(i)})},1\\bigg\\}\\] La generalización de Metrópolis-Hastings puede resultar en algoritmos más veloces. Se puede ver Gibbs como una generalización de Metrópolis-Hastings, cuando estamos actualizando un componente de los parámetros, la distribución propuesta es la distribución posterior para ese parámetro, por tanto siempre es aceptado. Comparado con Metrópolis, Gibbs tiene la ventaja de que no se necesita afinar los parámetros de una distribución propuesta (o seleccionar siquiera una distribución propuesta). Además que no hay pérdida de simulaciones debido a rechazo. Por su parte, la desventaja debemos conocer las distribuciones condicionales y poder simular de ellas. En el caso de modelos complicados se utilizan combinaciones de Gibbs y Metrópolis. Cuando se consideran estos dos algoritmos Gibbs es un método más simple y es la primera opción para modelos condicionalmente conjugados. Sí solo podemos simular de un subconjunto de las distribuciones condicionales posteriores, entonces podemos usar Gibbs siempre que se pueda y Metrópolis unidimensional para el resto, o de manera más general separamos en bloques, un bloque se actualiza con Gibbs y otro con Metrópolis. El algoritmo de Gibbs puede atorarse cuando hay correlación alta entre los parámetros, reparametrizar puede ayudar, o se pueden usar otros algoritmos. JAGS (Just Another Gibbs Sampler), WinBUGS y OpenBUGS son programas que implementan métodos MCMC para generar simulaciones de distribuciones posteriores. Los paquetes rjags y R2jags permiten ajustar modelos en JAGS desde R. Es muy fácil utilizar estos programas pues uno simplemente debe especificar las distribuciones iniciales, la verosimilitud y los datos observados. Para aprender a usar JAGS se puede revisar la sección correspondiente en las notas de 2018, ahora nos concentraremos en el uso de Stan. HMC y Stan It appears to be quite a general principle that, whenever there is a randomized way of doing something, then there is a nonrandomized way that delivers better performance but requires more thought. -E.T. Jaynes Stan es un programa para generar muestras de una distribución posterior de los parámetros de un modelo, el nombre del programa hace referencia a Stanislaw Ulam (1904-1984) que fue pionero en los métodos de Monte Carlo. A diferencia de JAGS y BUGS, los pasos de la cadena de Markov se generan con un método llamado Monte Carlo Hamiltoniano (HMC). HMC es computacionalmente más costoso que Metrópolis o Gibbs, sin embargo, sus propuestas suelen ser más eficientes, y por consiguiente no necesita muestras tan grandes. En particular cuando se ajustan modelos grandes y complejos (por ejemplo, con variables con correlación alta) HMC supera a otros. Diagnósticos generales para MCMC Cuando generamos una muestra de la distribución posterior usando MCMC, sin importar el método (Metrópolis, Gibbs, HMC), buscamos que: Los valores simulados sean representativos de la distribución posterior. Esto implica que no deben estar influenciados por el valor inicial (arbitrario) y deben explorar todo el rango de la posterior, con suficientes retornos para evaluar cuánta masa hay en cada región. Debemos tener suficientes simulaciones de tal manera que las estimaciones sean precisas y estables. Queremos tener un método eficiente para generar las simulaciones. En la práctica intentamos cumplir lo más posible estos objetivos, pues aunque en principio los métodos MCMC garantizan que una cadena infinitamente larga logrará una representación perfecta, siempre debemos tener un criterio para cortar la cadena y evaluar la calidad de las simulaciones. Representatividad Burn-in e iteraciones iniciales- En primer lugar, en muchas ocasiones las condiciones iniciales de las cadenas están en partes del espacio de parámetros que son “atípicos” en términos de la posterior. Así que es común quitar algunas observaciones iniciales (iteraciones de burn-in) para minimizar su efecto en resúmenes posteriores. Por ejemplo, para el ejemplo de los cantantes, podemos ver que las iteraciones iniciales tienen como función principal llegar a las regiones de probabilidad posterior alta: log_p <- crear_log_posterior_norm(cantantes$estatura_cm, mu_0, n_0, a, b) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(823) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 162, sigma = 1), 5000) ggplot(sim_tbl %>% filter(iter_num < 500), aes(x = mu, y = sigma)) + geom_path(alpha = 0.5) + geom_point(aes(colour = iter_num)) De modo que puede ser buena idea eliminar las primeras iteraciones. En teoría, no es necesario hacer esto si hacemos suficientes iteraciones, pues la cadena va a terminar en su estado estable explorando la posterior. En la práctica, y con pocas iteraciones, puede ayudar un poco a mejorar la precisión numérica de las cantidades que queramos calcular. sim_g <- sim_tbl %>% pivot_longer(-iter_num, names_to = "parametro", values_to = "valor") todas <- ggplot(sim_g, aes(x = iter_num, y = valor)) + geom_line(alpha = 0.5) + facet_wrap(~ parametro, ncol = 1, scales = "free_y") + labs(subtitle = "Todas las simulaciones") sin_burnin <- sim_g %>% filter(iter_num > 200) %>% ggplot(aes(x = iter_num, y = valor)) + geom_line(alpha = 0.5) + facet_wrap(~ parametro, ncol = 1, scales = "free_y") + labs(subtitle = "Quitando 200 de burn-in") todas + sin_burnin Convergencia a estado límite. Para determinar la convergencia es conveniente realizar más de una cadena: buscamos ver si realmente se ha olvidado el estado inicial, si las distribuciones de cada cadena son consistentes unas con otras, y revisar que algunas cadenas no hayan quedado atoradas en regiones inusuales del espacio de parámetros. Inicializamos las cadenas con valores al azar en rangos razonables (por ejemplo simulando de la inicial): set.seed(8513) valores_iniciales <- tibble(mu_0 = rnorm(4, 160, 20), sigma_0 = runif(4, 0, 20), cadena = 1:4) sims_tbl <- valores_iniciales %>% mutate(sims = map2(mu_0, sigma_0, ~ metro_normal(c(mu = .x, sigma = .y), 300) )) %>% unnest(sims) ggplot(sims_tbl, aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() Y este es un ejemplo donde claramente las cadenas no han alcanzado un estado estable: tienen muy distintas medias y varianzas. Por ejemplo: set.seed(83243) sims_tbl <- valores_iniciales %>% mutate(sims = map2(mu_0, sigma_0, ~ metro_normal(c(mu = .x, sigma = .y), 20000) )) %>% unnest(sims) ggplot(sims_tbl, aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() Y este resultado se ve mejor. La parte transición hacia las zonas de alta probabilidad pasa antes de unas 1000 iteraciones. Podemos hacer más simulaciones, o eliminar como burn-in las primiras iteraciones: media_g <- ggplot(sims_tbl %>% filter(iter_num > 2000), aes(x = iter_num, y = mu, colour = factor(cadena))) + geom_line() sigma_g <- ggplot(sims_tbl %>% filter(iter_num > 2000), aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() media_g / sigma_g Las gráficas anteriores nos ayudan a determinar si elegimos un periodo de calentamiento adecuado o si alguna cadena está alejada del resto. Una vez que las cadenas están en estado estable, podemos usar todas las simulaciones juntas para resumir: head(sims_tbl) ## # A tibble: 6 × 6 ## mu_0 sigma_0 cadena iter_num mu sigma ## <dbl> <dbl> <int> <int> <dbl> <dbl> ## 1 155. 3.16 1 1 155. 3.16 ## 2 155. 3.16 1 2 155. 3.16 ## 3 155. 3.16 1 3 155. 3.16 ## 4 155. 3.16 1 4 155. 3.16 ## 5 155. 3.16 1 5 155. 3.50 ## 6 155. 3.16 1 6 155. 3.81 # medias posteriores sims_tbl %>% summarise(mu = mean(mu), sigma = mean(sigma)) ## # A tibble: 1 × 2 ## mu sigma ## <dbl> <dbl> ## 1 176. 6.77 Además de realizar gráficas podemos usar la medida de convergencia \\(\\hat{R}\\). La medida \\(\\hat{R}\\) se conoce como el factor de reducción potencial de escala o diagnóstico de convergencia de Gelman-Rubin, esta es una estimación de la posible reducción en la longitud de un intervalo de confianza si las simulaciones continuaran infinitamente. \\(\\hat{R}\\) es aproximadamente la raíz cuadrada de la varianza de todas las cadenas juntas dividida entre la varianza dentro de cada cadena. Si \\(\\hat{R}\\) es mucho mayor a 1 esto indica que las cadenas no se han mezclado bien. Una regla usual es iterar hasta alcanzar un valor \\(\\hat{R} \\leq 1.1\\) para todos los parámetros. \\[\\hat{R} \\approx \\sqrt{\\frac{\\hat{V}}{W}}\\] donde \\(B\\) es la varianza entre las cadenas, \\(W\\) es la varianza dentro de las cadenas \\[B = \\frac{N}{M-1}\\sum_m (\\hat{\\theta}_m - \\hat{\\theta})^2\\] \\[W = \\frac{1}{M}\\sum_m \\hat{\\sigma}_m^2\\] Y \\(\\hat{V}\\) es una estimación del varianza de posterior de \\(\\theta\\): \\[\\hat{V} = \\frac{N-1}{N}W + \\frac{M+1}{MN}B\\] #### Ejemplo {-} En nuestro ejemplo anterior, tenemos sims_tbl %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(media = mean(valor), num = n(), sigma2 = var(valor)) %>% summarise(N = first(num), M = n_distinct(cadena), B = N * var(media), W = mean(sigma2), V_hat = ((N - 1) / N) * W + (M + 1)/(M * N) * B, R_hat = sqrt(V_hat / W)) ## # A tibble: 2 × 7 ## parametro N M B W V_hat R_hat ## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> ## 1 mu 20000 4 1281. 4.29 4.37 1.01 ## 2 sigma 20000 4 121. 1.31 1.32 1.00 Y verificamos que los valores de \\(\\hat{R}\\) son cercanos a uno, lo cual indica que este diagnóstico es aceptable. Si hubiéramos trabajado con las primeras 300 iteraciones sims_tbl %>% filter(iter_num < 300) %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(media = mean(valor), num = n(), sigma2 = var(valor)) %>% summarise(N = first(num), M = n_distinct(cadena), B = N * var(media), W = mean(sigma2), V_hat = ((N - 1) / N) * W + (M + 1)/(M * N) * B, R_hat = sqrt(V_hat / W)) ## # A tibble: 2 × 7 ## parametro N M B W V_hat R_hat ## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> ## 1 mu 299 4 32334. 40.4 175. 2.08 ## 2 sigma 299 4 7394. 11.9 42.8 1.89 Y estos valores indican problemas en la convergencia de las cadenas. Es necesario diagnosticar el problema, que en este caso resolvemos incrementando el número de iteraciones. Precisión Una vez que tenemos una muestra representativa de la distribución posterior, nuestro objetivo es asegurarnos de que la muestra es lo suficientemente grande para producir estimaciones estables y precisas de la distribución. Para ello usaremos el tamaño efectivo de muestra, Si las simulaciones fueran independientes \\(N_{eff}\\) sería el número total de simulaciones; sin embargo, las simulaciones de MCMC suelen estar correlacionadas, de modo que cada iteración de MCMC es menos informativa que si fueran independientes. Ejemplo: Si graficaramos simulaciones independientes, esperaríamos valores de autocorrelación chicos: acf(rgamma(1000,1,1)) Sin embargo, los valores que simulamos tienen el siguiente perfil de autocorrelación: sigma_metro_sims <- sims_tbl %>% filter(cadena==4) %>% pull(mu) acf(sigma_metro_sims) El tamaño efectivo de muestra nos dice qué tamaño de muestra de observaciones independientes nos daría la misma información que las simulaciones de la cadena. Una manera de manera relativamente simple de estimarlo es: \\[N_{eff} = \\frac{N}{1+2\\sum_{k=1}^\\infty ACF(k)} \\] Usualmente nos gustaría obtener un tamaño efectivo de al menos \\(100\\) (para cálculo de medias y varianzas posteriores). Esta cantidad usualmente se reporta en el software (con mejores estimaciones que la de la fórmula de arriba), y es necesario checarlo. En nuestro ejemplo hacemos una aproximación como sigue: calc_acf <- function(x){ valores_acf <- acf(x, lag.max = 1000, plot = FALSE)$acf %>% as.numeric() valores_acf[-1] } acf_tbl <- sims_tbl %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(N = n_distinct(iter_num), k = 1:1000, acf = calc_acf(valor)) %>% summarise(N = first(N), N_eff = N / (1 + 2 * sum(acf))) acf_tbl ## # A tibble: 8 × 4 ## # Groups: parametro [2] ## parametro cadena N N_eff ## <chr> <int> <int> <dbl> ## 1 mu 1 20000 251. ## 2 mu 2 20000 700. ## 3 mu 3 20000 104. ## 4 mu 4 20000 394. ## 5 sigma 1 20000 421. ## 6 sigma 2 20000 411. ## 7 sigma 3 20000 93.9 ## 8 sigma 4 20000 724. Nótese que algunas cadenas tienen un tamaño efectivo de muestra relativamente bajo para el número de iteraciones que hicimos. De cualquier forma, el agregado sobre todas las cadenas es suficientemente grande para calcular resúmenes básicos: acf_tbl %>% group_by(parametro) %>% summarise(N = sum(N), N_eff = sum(N_eff)) ## # A tibble: 2 × 3 ## parametro N N_eff ## <chr> <int> <dbl> ## 1 mu 80000 1450. ## 2 sigma 80000 1650. Sin embargo, podemos hacer más simulaciones si es necesario, por ejemplo para aproximar de manera apropiada percentiles en las colas. Eficiencia Hay varias maneras para mejorar la eficiencia de un proceso MCMC: Paralelizar, no disminuimos el número de pasos en las simulaciones pero podemos disminuir el tiempo que tarda en correr. Cambiar la parametrización del modelo o transformar los datos. Adelgazar la muestra cuando tenemos problemas de uso de memoria, consiste en guardar únicamente los \\(k\\)-ésimos pasos de la cadena y resulta en cadenas con menos autocorrelación . Recomendaciones generales Gelman and Hill (2006) recomienda los siguientes pasos cuando uno esta simulando de la posterior: Cuando definimos un modelo por primera vez establecemos un valor bajo para el número de iteraciones. La razón es que la mayor parte de las veces los modelos no funcionan a la primera por lo que sería pérdida de tiempo dejarlo correr mucho tiempo antes de descubrir el problema. Si las simulaciones no han alcanzado convergencia aumentamos las iteraciones a \\(500\\) ó \\(1000\\) de tal forma que las corridas tarden segundos o unos cuantos minutos. Si tarda más que unos cuantos minutos (para problemas del tamaño que veremos en la clase) y aún así no alcanza convergencia entonces juega un poco con el modelo (por ejemplo intenta transformaciones lineales), para JAGS Gelman sugiere más técnicas para acelerar la convergencia en el capitulo \\(19\\) del libro Data Analysis Using Regression and Multilevel/Hierarchical models. En el caso de Stan veremos ejemplos de reparametrización, y se puede leer más en la guía. Otra técnica conveniente cuando se trabaja con bases de datos grandes (sobre todo en la parte exploratoria) es trabajar con un subconjunto de los datos, quizá la mitad o una quinta parte. Referencias "],["apéndice-principios-de-visualizacion.html", "Apéndice: Principios de visualizacion Introducción Visualización popular de datos Teoría de visualización de datos Ejemplo: gráfica de Minard", " Apéndice: Principios de visualizacion “The simple graph has brought more information to the data analyst’s mind than any other device.” — John Tukey El cuarteto de Anscombe En 1971 un estadístico llamado Frank Anscombe (fundador del departamento de Estadística de la Universidad de Yale) publicó cuatro conjuntos de dato. Cada uno consiste de 11 observaciones. La peculariedad de estos conjuntos es que tienen las mismas propiedades estadísticas. Sin embargo, cuando analizamos los datos de manera gráfica en un histograma encontramos rápidamente que los conjuntos de datos son muy distintos. Media de \\(x\\): 9 Varianza muestral de \\(x\\): 11 Media de \\(y\\): 7.50 Varianza muestral de \\(y\\): 4.12 Correlación entre \\(x\\) y \\(y\\): 0.816 Línea de regresión lineal: \\(y = 3.00 + 0.500x\\) En la gráfica del primer conjunto de datos, se ve clara una relación lineal simple con un modelo que cumple los supuestos de normalidad. La segunda gráfica (arriba a la derecha) muestra unos datos que tienen una asociación pero definitivamente no es lineal. En la tercera gráfica (abajo a la izquierda) están puntos alineados perfectamente en una línea recta, excepto por uno de ellos. En la última gráfica podemos ver un ejemplo en el cual basta tener una observación atípica para que se produzca un coeficiente de correlación alto aún cuando en realidad no existe una asociación lineal entre las dos variables. El cuarteto de Ascombe inspiró una técnica reciente para crear datos que comparten las mismas propiedades estadísticas al igual que en el cuarteto, pero que producen gráficas muy distintas (Matejka, Fitzmaurice). Introducción La visualización de datos no trata de hacer gráficas “bonitas” o “divertidas”, ni de simplificar lo complejo o ayudar a una persona “que no entiende mucho” a entender ideas complejas. Más bien, trata de aprovechar nuestra gran capacidad de procesamiento visual para exhibir de manera clara aspectos importantes de los datos. El siguiente ejemplo de (Tufte 2006), ilustra claramente la diferencia entre estos dos enfoques. A la izquierda están gráficas (más o menos típicas de Powerpoint) basadas en la filosofía de simplificar, de intentar no “ahogar” al lector con datos. El resultado es una colección incoherente, de bajo contenido, que no tiene mucho qué decir y que es, “indeferente al contenido y la evidencia”. A la derecha está una variación del rediseño de Tufte en forma de tabla, que en este caso particular es una manera eficiente de mostrar claramente los patrones que hay en este conjunto simple de datos. ¿Qué principios son los que soportan la efectividad de esta tabla sobre la gráfica de la derecha? Veremos que hay dos conjuntos de principios importantes: unos relacionados con el diseño y otros con la naturaleza del análisis de datos, independientemente del método de visualización. Visualización popular de datos Publicaciones populares (periódicos, revistas, sitios internet) muchas veces incluyen visualización de datos como parte de sus artículos o reportajes. En general siguen el mismo patrón que en la visión tradicionalista de la estadística: sirven más para divertir que para explicar, tienden a explicar ideas simples y conjuntos chicos de datos, y se consideran como una “ayuda” para los “lectores menos sofisticados”. Casi siempre se trata de gráficas triviales (muchas veces con errores graves) que no aportan mucho a artículos que tienen un nivel de complejidad mucho mayor (es la filosofía: lo escrito para el adulto, lo graficado para el niño). Teoría de visualización de datos Existe teoría fundamentada acerca de la visualización. Después del trabajo pionero de Tukey, los principios e indicadores de Tufte se basan en un estudio de la historia de la graficación y ejercicios de muestreo de la práctica gráfica a lo largo de varias disciplinas (¿cuáles son las mejores gráficas? ¿por qué?) El trabajo de Cleveland es orientado a la práctica del análisis de datos (¿cuáles gráficas nos han ayudado a mostrar claramente los resultados del análisis?), por una parte, y a algunos estudios de percepción visual. En resumen, hablaremos de las siguientes guías: Principios generales del diseño analítico Aplicables a una presentación o análisis completos, y como guía para construir nuevas visualizaciones (Tufte 2006). Principio 1. Muestra comparaciones, contrastes, diferencias. Principio 2. Muestra causalidad, mecanismo, explicación, estructura sistemática. Principio 3. Muestra datos multivariados, es decir, más de una o dos variables. Principio 4. Integra palabras, números, imágenes y diagramas. Principio 5. Describe la totalidad de la evidencia. Muestra fuentes usadas y problemas relevantes. Principio 6. Las presentaciones analíticas, a fin de cuentas, se sostienen o caen dependiendo de la calidad, relevancia e integridad de su contenido. Técnicas de visualización Esta categoría incluye técnicas específicas que dependen de la forma de nuestros datos y el tipo de pregunta que queremos investigar (Tukey (1977), William S. Cleveland (1993), W. S. Cleveland (1994), Tufte (2006)). Tipos de gráficas: cuantiles, histogramas, caja y brazos, gráficas de dispersión, puntos/barras/ líneas, series de tiempo. Técnicas para mejorar gráficas: Transformación de datos, transparencia, vibración, banking 45, suavizamiento y bandas de confianza. Pequeños múltiplos Indicadores de calidad gráfica Aplicables a cualquier gráfica en particular. Estas son guías concretas y relativamente objetivas para evaluar la calidad de una gráfica (Tufte 1986). Integridad Gráfica. El factor de engaño, es decir, la distorsión gráfica de las cantidades representadas, debe ser mínimo. Chartjunk. Minimizar el uso de decoración gráfica que interfiera con la interpretación de los datos: 3D, rejillas, rellenos con patrones. Tinta de datos. Maximizar la proporción de tinta de datos vs. tinta total de la gráfica. For non-data- ink, less is more. For data-ink, less is a bore. Densidad de datos. Las mejores gráficas tienen mayor densidad de datos, que es la razón entre el tamaño del conjunto de datos y el área de la gráfica. Las gráficas se pueden encoger mucho. Percepción visual. Algunas tareas son más fáciles para el ojo humano que otras (W. S. Cleveland 1994). Factor de engaño y Chartjunk El factor de engaño es el cociente entre el efecto mostrado en una gráfica y el efecto correspondiente en los datos. Idealmente, el factor de engaño debe ser 1 (ninguna distorsión). El chartjunk son aquellos elementos gráficos que no corresponden a variación de datos, o que entorpecen la interpretación de una gráfica. Estos son los indicadores de calidad más fáciles de entender y aplicar, y afortunadamente cada vez son menos comunes. Un diseño popular que califica como chartjunk y además introduce factores de engaño es el pie de 3D. En la gráfica de la derecha, podemos ver como la rebanada C se ve más grande que la rebanada A, aunque claramente ese no es el caso (factor de engaño). La razón es la variación en la perspectiva que no corresponde a variación en los datos (chartjunk). Crítica gráfica: Gráfica de pie Todavía elementos que pueden mejorar la comprensión de nuestra gráfica de pie: se trata de la decodificiación que hay que hacer categoría - color - cuantificación. Podemos agregar las etiquetas como se muestra en la serie de la derecha, pero entonces: ¿por qué no mostrar simplemente la tabla de datos? ¿qué agrega el pie a la interpretación? La deficiencias en el pie se pueden ver claramente al intentar graficar más categorías (13) . En el primer pie no podemos distinguir realmente cuáles son las categorías grandes y cuáles las chicas, y es muy difícil tener una imagen mental clara de estos datos. Agregar los porcentajes ayuda, pero entonces, otra vez, preguntamos cuál es el propósito del pie. La tabla de la izquierda hace todo el trabajo (una vez que ordenamos las categrías de la más grande a la más chica). Es posible hacer una gráfica de barras como la de abajo a la izquierda. Hay otros tipos de chartjunk comunes: uno es la textura de barras, por ejemplo. El efecto es la producción de un efecto moiré que es desagradable y quita la atención de los datos, como en la gráfica de barras de abajo. Otro común son las rejillas, como mostramos en las gráficas de la izquierda. Nótese como en estos casos hay efectos ópticos no planeados que degradan la percepción de los patrones en los datos. Pequeños múltiplos y densidad gráfica La densidad de una gráfica es el tamaño del conjunto de datos que se grafica comparado con el área total de la gráfica. En el siguiente ejemplo, graficamos en logaritmo-10 de millones de cabezas de ganado en Francia (cerdos, res, ovejas y caballos). La gráfica de la izquierda es pobre en densidad pues sólo representa 4 datos. La manera más fácil de mejorar la densidad es hacer más chica la gráfica: La razón de este encogimiento es una que tiene qué ver con las oportunidades perdidas de una gráfica grande. Si repetimos este mismo patrón (misma escala, mismos tipos de ganado) para distintos países obtenemos la siguiente gráfica: Esta es una gráfica de puntos. Es útil como sustituto de una gráfica de barras, y es superior en el sentido de que una mayor proporción de la tinta que se usa es tinta de datos. Otra vez, mayor proporción de tinta de datos representa más oportunidades que se pueden capitalizar. Más pequeños múltiplos Los pequeños múltiplos presentan oportunidades para mostrar más acerca de nuestro problema de interés. Consideramos por ejemplo la relación de radiación solar y niveles de ozono: En el ejemplo anterior incluyendo una variable adicional (velocidad del viento) podemos entender más acerca de la relación de radiación solar y niveles de ozono: Tinta de datos Maximizar la proporción de tinta de datos en nuestras gráficas tiene beneficios inmediatos. La regla es: si hay tinta que no representa variación en los datos, o la eliminación de esa tinta no representa pérdidas de significado, esa tinta debe ser eliminada. El ejemplo más claro es el de las rejillas en gráficas y tablas: ¿Por qué usar grises en lugar de negros? La respuesta tiene qué ver con el principio de tinta de datos: si marcamos las diferencias sutil pero claramente, tenemos más oportunidades abiertas para hacer énfasis en lo que nos interesa: a una gráfica o tabla saturada no se le puede hacer más - es difícil agregar elementos adicionales que ayuden a la comprensión. Si comenzamos marcando con sutileza, entonces se puede hacer más. Los mapas geográficos son un buen ejemplo de este principio. El espacio en blanco es suficientemente bueno para indicar las fronteras en una tabla, y facilita la lectura: Para un ejemplo del proceso de rediseño de una tabla, ver aquí. Finalmente, podemos ver un ejemplo que intenta incorporar los elementos del diseño analítico, incluyendo pequeños múltiplos: Decoración Percepción de escala Entre la percepción visual y la interpretación de una gráfica están implícitas tareas visuales específicas que las personas debemos realizar para ver correctamente la gráfica. En la década de los ochenta, William S. Cleveland y Robert McGill realizaron algunos experimentos identificando y clasificando estas tareas para diferentes tipos de gráficos (William S. Cleveland and McGill 1984). En estos, se le pregunta a la persona que compare dos valores dentro de una gráfica, por ejemplo, en dos barras en una gráfica de barras, o dos rebanadas de una gráfica de pie. Los resultados de Cleveland y McGill fueron replicados por Heer y Bostock en 2010 y los resultados se muestran en las gráficas de la derecha: Ejemplo: gráfica de Minard Concluimos esta sección con una gráfica que, aunque poco común, ejemplifica los principios de una buena gráfica, y es reconocida como una de las mejores visualizaciones de la historia. Una gráfica excelente, presenta datos interesantes de forma bien diseñada: es una cuestión de fondo, de diseño, y estadística… [Se] compone de ideas complejas comunicadas con claridad, precisión y eficiencia. … [Es] lo que da al espectador la mayor cantidad de ideas, en el menor tiempo, con la menor cantidad de tinta, y en el espacio más pequeño. … Es casi siempre multivariado. … Una excelente gráfica debe decir la verdad acerca de los datos. (Tufte, 1983) La famosa visualización de Charles Joseph Minard de la marcha de Napoleón sobre Moscú, ilustra los principios de una buena gráfica. Tufte señala que esta imagen “bien podría ser el mejor gráfico estadístico jamás dibujado”, y sostiene que “cuenta una historia rica y coherente con sus datos multivariados, mucho más esclarecedora que un solo número que rebota en el tiempo”. Se representan seis variables: el tamaño del ejército, su ubicación en una superficie bidimensional, la dirección del movimiento del ejército y la temperatura en varias fechas durante la retirada de Moscú”. Hoy en día Minard es reconocido como uno de los principales contribuyentes a la teoría de análisis de datos y creación de infografías con un fundamento estadístico. Se grafican 6 variables: el número de tropas de Napoleón, la distancia, la temperatura, la latitud y la longitud, la dirección en que viajaban las tropas y la localización relativa a fechas específicas. La gráfica de Minard, como la describe E.J. Marey, parece “desafiar la pluma del historiador con su brutal elocuencia”, la combinación de datos del mapa, y la serie de tiempo, dibujados en 1869, “retratan una secuencia de pérdidas devastadoras que sufrieron las tropas de Napoleón en 1812”. Comienza en la izquierda, en la frontera de Polonia y Rusia, cerca del río Niemen. La línea gruesa dorada muestra el tamaño de la Gran Armada (422,000) en el momento en que invadía Rusia en junio de 1812. El ancho de esta banda indica el tamaño de la armada en cada punto del mapa. En septiembre, la armada llegó a Moscú, que ya había sido saqueada y dejada desértica, con sólo 100,000 hombres. El camino del retiro de Napoleón desde Moscú está representado por la línea oscura (gris) que está en la parte inferior, que está relacionada a su vez con la temperatura y las fechas en el diagrama de abajo. Fue un invierno muy frío, y muchos se congelaron en su salida de Rusia. Como se muestra en el mapa, cruzar el río Berezina fue un desastre, y el ejército de Napoleón logró regresar a Polonia con tan sólo 10,000 hombres. También se muestran los movimientos de las tropas auxiliaries, que buscaban proteger por atrás y por la delantera mientras la armada avanzaba hacia Moscú. La gráfica de Minard cuenta una historia rica y cohesiva, coherente con datos multivariados y con los hechos históricos, y que puede ser más ilustrativa que tan sólo representar un número rebotando a lo largo del tiempo. Referencias "],["apéndice-transformaciones.html", "Apéndice: Transformaciones", " Apéndice: Transformaciones En ocasiones es conveniente transformar los datos para el análisis, el objetivo de los ajustes es simplificar la interpretación y el análisis al eliminar fuentes de variación conocidas, también es común realizan transformaciones para simplificar los patrones. Algunos ejemplos donde eliminamos efectos conocidos: Cuando analizamos el precio de venta de las casas podemos eliminar la variación debida al tamaño de las casas al pasar de precio de venta a precio de venta por metro cuadrado. De manera similar al analizar las propinas puede convenir considerar la propina como porcentaje de la cuenta. En series de tiempo cuando los datos están relacionados con el tamaño de la población podemos ajustar a mediciones per capita (en series de tiempo PIB). También es común ajustar por inflación, o poner cantidades monetarias en valor presente. mex_dat <- global_economy |> filter(Code == "MEX") pib <- ggplot(mex_dat, aes(x = Year, y = GDP / 1e6)) + geom_line() pib_pc <- ggplot(mex_dat, aes(x = Year, y = GDP / Population)) + geom_line() pib / pib_pc Adicionalmente podemos recurrir a otras transformaciones matemáticas (e.g. logaritmo, raíz cuadrada) que simplifiquen el patrón en los datos y la interpretación. Veamos un ejemplo donde es apropiado la transformación logaritmo. Usamos los datos Animals con información de peso corporal promedio y peso cerebral promedio para 28 especies. Buscamos entender la relación entre estas dos variables, e inspeccionar que especies se desvían (residuales) del esperado. Comenzamos con un diagrama de dispersión usando las unidades originales animals_tbl <- as_tibble(Animals, rownames = "animal") p1 <- ggplot(animals_tbl, aes(x = body, y = brain, label = animal)) + geom_point() + labs(subtitle = "Unidades originales") p2 <- ggplot(animals_tbl, aes(x = body, y = brain, label = animal)) + geom_point() + xlim(0, 500) + ylim(0, 1500) + geom_text_repel() + labs(subtitle = "Unidades originales, eliminando 'grandes'") (p1 + p2) Incluso cuando nos limitamos a especies de menos de 500 kg de masa corporal, la relación no es fácil de descrubir.En la suguiente gráfica hacemos la transformación logaritmo y obtenemos una gráfica más fácil de leer, además los datos se modelarán con más facilidad. p3 <- ggplot(animals_tbl, aes(x = log(body), y = log(brain), label = animal)) + geom_smooth(method = "lm", se = FALSE, color = "red") + geom_point() + geom_text_repel() + stat_poly_eq(use_label(c("eq"))) p3 ## `geom_smooth()` using formula = 'y ~ x' La transformación logaritmo tiene también ventajas en interpretación, para diferencias chicas en escala log, las diferencias corresponden a diferencias porcentuales en la escala original, por ejempo consideremos la diferencia entre el peso en escala log de humano y borrego: 4.13 - 4.02 = 0.11. Confirmamos que el humano es aproximadamente 11% más pesado que el borrego en la escala original: 62/55.5 - 1 = 0.12 animals_tbl <- animals_tbl |> mutate(log_body = log(body), log_brain = log(brain)) animals_tbl |> filter(animal == "Human" | animal == "Sheep") |> arrange(body) |> gt::gt() |> gt::fmt_number() #ufmafyhycy table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #ufmafyhycy thead, #ufmafyhycy tbody, #ufmafyhycy tfoot, #ufmafyhycy tr, #ufmafyhycy td, #ufmafyhycy th { border-style: none; } #ufmafyhycy p { margin: 0; padding: 0; } #ufmafyhycy .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #ufmafyhycy .gt_caption { padding-top: 4px; padding-bottom: 4px; } #ufmafyhycy .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #ufmafyhycy .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #ufmafyhycy .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #ufmafyhycy .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ufmafyhycy .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #ufmafyhycy .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #ufmafyhycy .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #ufmafyhycy .gt_column_spanner_outer:first-child { padding-left: 0; } #ufmafyhycy .gt_column_spanner_outer:last-child { padding-right: 0; } #ufmafyhycy .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #ufmafyhycy .gt_spanner_row { border-bottom-style: hidden; } #ufmafyhycy .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #ufmafyhycy .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #ufmafyhycy .gt_from_md > :first-child { margin-top: 0; } #ufmafyhycy .gt_from_md > :last-child { margin-bottom: 0; } #ufmafyhycy .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #ufmafyhycy .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #ufmafyhycy .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #ufmafyhycy .gt_row_group_first td { border-top-width: 2px; } #ufmafyhycy .gt_row_group_first th { border-top-width: 2px; } #ufmafyhycy .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #ufmafyhycy .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #ufmafyhycy .gt_first_summary_row.thick { border-top-width: 2px; } #ufmafyhycy .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ufmafyhycy .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #ufmafyhycy .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #ufmafyhycy .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #ufmafyhycy .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #ufmafyhycy .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ufmafyhycy .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #ufmafyhycy .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #ufmafyhycy .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #ufmafyhycy .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #ufmafyhycy .gt_left { text-align: left; } #ufmafyhycy .gt_center { text-align: center; } #ufmafyhycy .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #ufmafyhycy .gt_font_normal { font-weight: normal; } #ufmafyhycy .gt_font_bold { font-weight: bold; } #ufmafyhycy .gt_font_italic { font-style: italic; } #ufmafyhycy .gt_super { font-size: 65%; } #ufmafyhycy .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #ufmafyhycy .gt_asterisk { font-size: 100%; vertical-align: 0; } #ufmafyhycy .gt_indent_1 { text-indent: 5px; } #ufmafyhycy .gt_indent_2 { text-indent: 10px; } #ufmafyhycy .gt_indent_3 { text-indent: 15px; } #ufmafyhycy .gt_indent_4 { text-indent: 20px; } #ufmafyhycy .gt_indent_5 { text-indent: 25px; } #ufmafyhycy .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #ufmafyhycy div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } animal body brain log_body log_brain Sheep 55.50 175.00 4.02 5.16 Human 62.00 1,320.00 4.13 7.19 Y podemos usarlo también para interpretar la recta de referencia \\(y = 2.55 + 0.5 x\\) , para cambios chicos: Un incremento de 10% en masa total corresponde en un incremento de 5% en masa cerebral. El coeficiente de la regresión log-log, en nuestro ejemplo 0.5, es la elasticidad y es un concepto común en economía. Justificación Para entender la interpretación como cambio porcentual recordemos primero que la representación con series de Taylor de la función exponencial es: \\[e^x = \\sum_{n=0}^\\infty \\frac{x^n}{n!}\\] Más aún podemos tener una aproximación usando polinomios de Taylor, en el caso de la exponencial el \\(k\\)-ésimo polinomio de Taylor está dado por: \\[e^\\delta \\approx 1 + \\delta + \\frac{1}{2!}\\delta^2 + \\dots + \\frac{1}{k!}\\delta^k\\] y si \\(\\delta\\) es chica (digamos menor a 0.15), entonces la aproximación de primer grado es razonable y tenemos: \\[Ae^{\\delta} \\approx A(1+\\delta)\\] dat <- tibble(delta = seq(0, 1, 0.01), exp_delta = exp(delta), uno_mas_delta = 1 + delta) ggplot(dat, aes(x = uno_mas_delta, y = exp_delta)) + geom_line() + geom_abline(color = "red") + annotate("text", x = 1.20, y = 1.18, label = "y = x", color = "red", size = 6) "],["referencias.html", "Referencias", " Referencias "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]]
+[["index.html", "Fundamentos de Estadística con Remuestreo Información del curso", " Fundamentos de Estadística con Remuestreo Teresa Ortiz, Felipe González, Alfredo Garbuno Información del curso Notas del curso Fundamentos de Estadística con Remuestreo, este curso busca explicar los principios básicos de la estadística y su papel en el análisis de datos. Nuestro punto de vista es uno de fundamentos, con menos énfasis en recetas o técnicas particulares. Ligas Notas: https://tereom.github.io/fundamentos-2024/ Repositorio con material: https://github.com/tereom/fundamentos-2024 Correo: teresa.ortiz.mancera@gmail.com Zoom clase (miércoles 4:00-7:00 pm): https://itam.zoom.us/j/92745909276 Zoom sesiones de dudas (lunes de 5:30-6:30 pm): https://itam.zoom.us/j/92518922348 Canvas: https://itam.instructure.com/courses/13328 x Este trabajo está bajo una Licencia Creative Commons Atribución 4.0 Internacional. "],["temario.html", "Temario Plan semanal Evaluación", " Temario Plan semanal Datos y análisis exploratorio Referencias: (W. S. Cleveland 1994), (Chihara and Hesterberg 2018) Visualización1 Análisis exploratorio Tipos de datos o estudios Muestras diseñadas y muestras naturales Experimentos y datos observacionales Introducción a Pruebas de Hipótesis Referencias: (Chihara and Hesterberg 2018) Introducción a pruebas de hipótesis. Pruebas de permutaciones Muestras pareadas y otros ejemplos Estimación y distribución de muestreo Referencias: (Chihara and Hesterberg 2018), (Tim C. Hesterberg 2015b) Estimadores y su distribución de muestreo Repaso de probabilidad y Teorema del límite central Introducción a estimación por intervalos Referencias: (Chihara and Hesterberg 2018), (Efron and Tibshirani 1993), (Tim C. Hesterberg 2015b) El método plugin y el boostrap Bootstrap e Intervalos de confianza. Ejemplos. Estimación Referencias: (Chihara and Hesterberg 2018), (Wasserman 2013) Estimación por máxima verosimilitud Ejemplos de estimación por máxima verosimilitud y Bootstrap paramétrico Propiedades de estimadores de máxima verosimilitud Más de pruebas de hipótesis Referencias: (Chihara and Hesterberg 2018), (Wasserman 2013) Pruebas de hipótesis para medias y proporciones: una y dos poblaciones. Introducción a inferencia bayesiana Referencias: (Kruschke 2015) Introducción a inferencia bayesiana Ejemplos de distribuciones conjugadas Introducción a métodos computacionales básicos: Muestreadores Metrópolis y Gibbs Ejemplos de inferencia bayesiana en Stan Evaluación Se evaluará mediante tareas semanales y dos exámenes: Tareas semanales (20%) Examen parcial en clase y a casa (40%) Examen final a casa (40%) Referencias "],["análisis-exploratorio.html", "Sección 1 Análisis exploratorio El papel de la exploración en el análisis de datos Preguntas y datos Algunos conceptos básicos Ejemplos Suavizamiento loess Caso de estudio: nacimientos en México", " Sección 1 Análisis exploratorio “Exploratory data analysis can never be the whole story, but nothing else can serve as the foundation stone –as the first step.” — John Tukey El papel de la exploración en el análisis de datos El estándar científico para contestar preguntas o tomar decisiones es uno que se basa en el análisis de datos. Es decir, en primer lugar se deben reunir todos los datos que puedan contener o sugerir alguna guía para entender mejor la pregunta o la decisión a la que nos enfrentamos. Esta recopilación de datos —que pueden ser cualitativos, cuantitativos, o una mezcla de los dos— debe entonces ser analizada para extraer información relevante para nuestro problema. En análisis de datos existen dos distintos tipos de trabajo: El trabajo exploratorio o de detective: ¿cuáles son los aspectos importantes de estos datos? ¿qué indicaciones generales muestran los datos? ¿qué tareas de análisis debemos empezar haciendo? ¿cuáles son los caminos generales para formular con precisión y contestar algunas preguntas que nos interesen? El trabajo inferencial, confirmatorio, o de juez: ¿cómo evaluar el peso de la evidencia de los descubrimientos del paso anterior? ¿qué tan bien soportadas están las respuestas y conclusiones por nuestro conjunto de datos? Preguntas y datos Cuando observamos un conjunto de datos, independientemente de su tamaño, el paso inicial más importante es entender bajo qué proceso se generan los datos. A grandes rasgos, cuanto más sepamos de este proceso, mejor podemos contestar preguntas de interés. En muchos casos, tendremos que hacer algunos supuestos de cómo se generan estos datos para dar respuestas (condicionales a esos supuestos). Algunos conceptos básicos Empezamos explicando algunas ideas que no serán útiles más adelante. El primer concepto se refiere a entender cómo se distribuyen los datos a los largo de su escala de medición. Comenzamos con un ejemplo: los siguientes datos fueron registrados en un restaurante durante cuatro días consecutivos. library(tidyverse) library(patchwork) # organizar gráficas library(gt) # formatear tablas source("R/funciones_auxiliares.R") # usamos los datos tips del paquete reshape2 propinas <- read_csv("./data/propinas.csv") Y vemos una muestra slice_sample(propinas, n = 10) |> gt() #qcaxfnkqcl table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #qcaxfnkqcl thead, #qcaxfnkqcl tbody, #qcaxfnkqcl tfoot, #qcaxfnkqcl tr, #qcaxfnkqcl td, #qcaxfnkqcl th { border-style: none; } #qcaxfnkqcl p { margin: 0; padding: 0; } #qcaxfnkqcl .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #qcaxfnkqcl .gt_caption { padding-top: 4px; padding-bottom: 4px; } #qcaxfnkqcl .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #qcaxfnkqcl .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #qcaxfnkqcl .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #qcaxfnkqcl .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #qcaxfnkqcl .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #qcaxfnkqcl .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #qcaxfnkqcl .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #qcaxfnkqcl .gt_column_spanner_outer:first-child { padding-left: 0; } #qcaxfnkqcl .gt_column_spanner_outer:last-child { padding-right: 0; } #qcaxfnkqcl .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #qcaxfnkqcl .gt_spanner_row { border-bottom-style: hidden; } #qcaxfnkqcl .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #qcaxfnkqcl .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #qcaxfnkqcl .gt_from_md > :first-child { margin-top: 0; } #qcaxfnkqcl .gt_from_md > :last-child { margin-bottom: 0; } #qcaxfnkqcl .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #qcaxfnkqcl .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #qcaxfnkqcl .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #qcaxfnkqcl .gt_row_group_first td { border-top-width: 2px; } #qcaxfnkqcl .gt_row_group_first th { border-top-width: 2px; } #qcaxfnkqcl .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #qcaxfnkqcl .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #qcaxfnkqcl .gt_first_summary_row.thick { border-top-width: 2px; } #qcaxfnkqcl .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #qcaxfnkqcl .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #qcaxfnkqcl .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #qcaxfnkqcl .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #qcaxfnkqcl .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #qcaxfnkqcl .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #qcaxfnkqcl .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #qcaxfnkqcl .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #qcaxfnkqcl .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #qcaxfnkqcl .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #qcaxfnkqcl .gt_left { text-align: left; } #qcaxfnkqcl .gt_center { text-align: center; } #qcaxfnkqcl .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #qcaxfnkqcl .gt_font_normal { font-weight: normal; } #qcaxfnkqcl .gt_font_bold { font-weight: bold; } #qcaxfnkqcl .gt_font_italic { font-style: italic; } #qcaxfnkqcl .gt_super { font-size: 65%; } #qcaxfnkqcl .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #qcaxfnkqcl .gt_asterisk { font-size: 100%; vertical-align: 0; } #qcaxfnkqcl .gt_indent_1 { text-indent: 5px; } #qcaxfnkqcl .gt_indent_2 { text-indent: 10px; } #qcaxfnkqcl .gt_indent_3 { text-indent: 15px; } #qcaxfnkqcl .gt_indent_4 { text-indent: 20px; } #qcaxfnkqcl .gt_indent_5 { text-indent: 25px; } #qcaxfnkqcl .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #qcaxfnkqcl div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } cuenta_total propina fumador dia momento num_personas 15.81 3.16 Si Sab Cena 2 16.47 3.23 Si Jue Comida 3 38.01 3.00 Si Sab Cena 4 3.07 1.00 Si Sab Cena 1 12.46 1.50 No Vie Cena 2 8.52 1.48 No Jue Comida 2 11.61 3.39 No Sab Cena 2 50.81 10.00 Si Sab Cena 3 38.07 4.00 No Dom Cena 3 15.06 3.00 No Sab Cena 2 Aquí la unidad de observación es una cuenta particular. Tenemos tres mediciones numéricas de cada cuenta: cúanto fue la cuenta total, la propina, y el número de personas asociadas a la cuenta. Los datos están separados según se fumó o no en la mesa, y temporalmente en dos partes: el día (Jueves, Viernes, Sábado o Domingo), cada uno separado por Cena y Comida. Denotamos por \\(x\\) el valor de medición de una unidad de observación. Usualmente utilizamos sub-índices para identificar entre diferentes puntos de datos (observaciones), por ejemplo, \\(x_n\\) para la \\(n-\\)ésima observación. De tal forma que una colección de \\(N\\) observaciones la escribimos como \\[\\begin{align} \\{x_1, \\ldots, x_N\\}. \\end{align}\\] El primer tipo de comparaciones que nos interesa hacer es para una medición: ¿Varían mucho o poco los datos de un tipo de medición? ¿Cuáles son valores típicos o centrales? ¿Existen valores atípicos? Supongamos entonces que consideramos simplemente la variable de cuenta_total. Podemos comenzar por ordenar los datos, y ver cuáles datos están en los extremos y cuáles están en los lugares centrales: propinas <- propinas |> mutate(orden_cuenta = rank(cuenta_total, ties.method = "first"), f = (orden_cuenta - 0.5) / n()) cuenta <- propinas |> select(orden_cuenta, f, cuenta_total) |> arrange(f) bind_rows(head(cuenta), tail(cuenta)) |> gt() |> fmt_number(columns = f, decimals = 3) #phufidpmfh table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #phufidpmfh thead, #phufidpmfh tbody, #phufidpmfh tfoot, #phufidpmfh tr, #phufidpmfh td, #phufidpmfh th { border-style: none; } #phufidpmfh p { margin: 0; padding: 0; } #phufidpmfh .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #phufidpmfh .gt_caption { padding-top: 4px; padding-bottom: 4px; } #phufidpmfh .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #phufidpmfh .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #phufidpmfh .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #phufidpmfh .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #phufidpmfh .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #phufidpmfh .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #phufidpmfh .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #phufidpmfh .gt_column_spanner_outer:first-child { padding-left: 0; } #phufidpmfh .gt_column_spanner_outer:last-child { padding-right: 0; } #phufidpmfh .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #phufidpmfh .gt_spanner_row { border-bottom-style: hidden; } #phufidpmfh .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #phufidpmfh .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #phufidpmfh .gt_from_md > :first-child { margin-top: 0; } #phufidpmfh .gt_from_md > :last-child { margin-bottom: 0; } #phufidpmfh .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #phufidpmfh .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #phufidpmfh .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #phufidpmfh .gt_row_group_first td { border-top-width: 2px; } #phufidpmfh .gt_row_group_first th { border-top-width: 2px; } #phufidpmfh .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #phufidpmfh .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #phufidpmfh .gt_first_summary_row.thick { border-top-width: 2px; } #phufidpmfh .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #phufidpmfh .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #phufidpmfh .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #phufidpmfh .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #phufidpmfh .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #phufidpmfh .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #phufidpmfh .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #phufidpmfh .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #phufidpmfh .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #phufidpmfh .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #phufidpmfh .gt_left { text-align: left; } #phufidpmfh .gt_center { text-align: center; } #phufidpmfh .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #phufidpmfh .gt_font_normal { font-weight: normal; } #phufidpmfh .gt_font_bold { font-weight: bold; } #phufidpmfh .gt_font_italic { font-style: italic; } #phufidpmfh .gt_super { font-size: 65%; } #phufidpmfh .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #phufidpmfh .gt_asterisk { font-size: 100%; vertical-align: 0; } #phufidpmfh .gt_indent_1 { text-indent: 5px; } #phufidpmfh .gt_indent_2 { text-indent: 10px; } #phufidpmfh .gt_indent_3 { text-indent: 15px; } #phufidpmfh .gt_indent_4 { text-indent: 20px; } #phufidpmfh .gt_indent_5 { text-indent: 25px; } #phufidpmfh .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #phufidpmfh div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } orden_cuenta f cuenta_total 1 0.002 3.07 2 0.006 5.75 3 0.010 7.25 4 0.014 7.25 5 0.018 7.51 6 0.023 7.56 239 0.977 44.30 240 0.982 45.35 241 0.986 48.17 242 0.990 48.27 243 0.994 48.33 244 0.998 50.81 También podemos graficar los datos en orden, interpolando valores consecutivos. A esta función le llamamos la función de cuantiles para la variable cuenta_total. Nos sirve para comparar directamente los distintos valores que observamos los datos según el orden que ocupan. En particular, podemos estudiar la dispersión y valores centrales de los datos observados: El rango de datos va de unos 3 dólares hasta 50 dólares Los valores centrales, por ejemplo el 50% de los valores más centrales, están entre unos 13 y 25 dólares. El valor que divide en dos mitades iguales a los datos es de alrededor de 18 dólares. El cuantil \\(f\\), que denotamos por \\(q(f)\\) es valor a lo largo de la escala de medición de los datos tal que aproximadamente una fracción \\(f\\) de los datos son menores o iguales a \\(q(f)\\). Al cuantil \\(f=0.5\\) le llamamos la mediana. A los cuantiles \\(f=0.25\\) y \\(f=0.75\\) les llamamos cuartiles inferior y superior. En nuestro ejemplo: Los valores centrales —del cuantil 0.25 al 0.75, por decir un ejemplo— están entre unos 13 y 25 dólares. Estos dos cuantiles se llaman cuartil inferior y cuartil superior respectivamente El cuantil 0.5 (o también conocido como mediana) está alrededor de 18 dólares. Éste último puede ser utilizado para dar un valor central de la distribución de valores para cuenta_total. Asimismo podemos dar resúmenes más refinados si es necesario. Por ejemplo, podemos reportar que: El cuantil 0.95 es de unos 35 dólares — sólo 5% de las cuentas son de más de 35 dólares El cuantil 0.05 es de unos 8 dólares — sólo 5% de las cuentas son de 8 dólares o menos. Finalmente, la forma de la gráfica se interpreta usando su pendiente (tasa de cambio) haciendo comparaciones en diferentes partes de la gráfica: La distribución de valores tiene asimetría: el 10% de las cuentas más altas tiene considerablemente más dispersión que el 10% de las cuentas más bajas. Entre los cuantiles 0.2 y 0.7 es donde existe mayor densidad de datos: la pendiente (tasa de cambio) es baja, lo que significa que al avanzar en los valores observados, los cuantiles (el porcentaje de casos) aumenta rápidamente. Cuando la pendiente alta, quiere decir que los datos tienen más dispersión local o están más separados. Observación: Hay varias maneras de definir los cuantiles (ver (William S. Cleveland 1993)): Supongamos que queremos definir \\(q(f)\\), y denotamos los datos ordenados como \\(x_{(1)}, x_{(2)}, \\ldots, x_{(N)}\\), de forma que \\(x_{(1)}\\) es el dato más chico y \\(x_{(N)}\\) es el dato más grande. Para cada \\(x_{(i)}\\) definimos \\[f_i = i / N\\] entonces definimos el cuantil \\(q(f_i)=x_{(i)}\\). Para cualquier \\(f\\) entre 0 y 1, podemos definir \\(q(f)\\) como sigue: si \\(f\\) está entre \\(f_i\\) y \\(f_{i+1}\\) interpolamos linealmente los valores correspondientes \\(x_{(i)}\\) y \\(x_{(i+1)}\\). En la práctica, es más conveniente usar \\(f_i= \\frac{i - 0.5}{N}\\). La gráfica de cuantiles no cambia mucho comparado con la difinición anterior, y esto nos permitirá comparar de mejor manera con distribuciones teóricas que no tienen definido su cuantil 0 y el 1, pues tienen soporte en los números reales (como la distribución normal, por ejemplo). Asociada a la función de cuantiles \\(q\\) tenemos la distribución acumulada empírica de los datos, que es aproximadamente inversa de la función de cuantiles, y se define como: \\[\\hat{F}(x) = i/N\\] si \\(x_{(i)} \\leq x < x_{(i+1)}\\). Nótese que \\(\\hat{F}(q(f_i)) = i/N = f_i\\) (demuéstralo). acum_cuenta <- ecdf(cuenta$cuenta_total) cuenta <- cuenta |> mutate(dea_cuenta_total = acum_cuenta(cuenta_total)) g_acum <- ggplot(cuenta, aes(x = cuenta_total, y = dea_cuenta_total)) + geom_point() + labs(subtitle = "Distribución acum empírica de cuenta total", x = "") g_cuantiles + g_acum La función de distribución acumulada empírica es otra forma de graficar la dispersión de los datos. En su gráfica vemos que proporción de los datos que son iguales o están por debajo de cada valor en el eje horizontal. Nota: En análisis de datos, es más frecuente utilizar la función de cuantiles pues existen versiones más generales que son útiles, por ejemplo, para evaluar ajuste de modelos probabilísticos En la teoría, generalmente es más común utilizar la fda empírica, que tiene una única definición que veremos coincide con definiciones teóricas. Histogramas En algunos casos, es más natural hacer un histograma, donde dividimos el rango de la variable en cubetas o intervalos (en este caso de igual longitud), y graficamos por medio de barras cuántos datos caen en cada cubeta: Es una gráfica más popular, pero perdemos cierto nivel de detalle, y distintas particiones resaltan distintos aspectos de los datos. ¿Cómo se ve la gráfica de cuantiles de las propinas? ¿Cómo crees que esta gráfica se compara con distintos histogramas? g_1 <- ggplot(propinas, aes(sample = propina)) + geom_qq(distribution = stats::qunif) + labs(x = "f", y = "propina") g_1 Finalmente, una gráfica más compacta que resume la gráfica de cuantiles o el histograma es el diagrama de caja y brazos. Mostramos dos versiones, la clásica de Tukey (T) y otra versión menos común de Spear/Tufte (ST): library(ggthemes) cuartiles <- quantile(cuenta$cuenta_total) cuartiles |> round(2) ## 0% 25% 50% 75% 100% ## 3.07 13.35 17.80 24.13 50.81 g_1 <- ggplot(cuenta, aes(x = f, y = cuenta_total)) + labs(subtitle = "Gráfica de cuantiles: Cuenta total") + geom_hline(yintercept = cuartiles[2:4], colour = "gray") + geom_point(alpha = 0.5) + geom_line() g_2 <- ggplot(cuenta, aes(x = factor("ST", levels = "ST"), y = cuenta_total)) + geom_tufteboxplot() + labs(subtitle = "", x = "", y = "") g_3 <- ggplot(cuenta, aes(x = factor("T"), y = cuenta_total)) + geom_boxplot() + labs(subtitle = "", x = "", y = "") g_4 <- ggplot(cuenta, aes(x = factor("P"), y = cuenta_total)) + geom_jitter(height = 0, width =0.2, alpha = 0.5) + labs(subtitle = "", x = "", y = "") g_5 <- ggplot(cuenta, aes(x = factor("V"), y = cuenta_total)) + geom_violin() + labs(subtitle = "", x = "", y = "") g_1 + g_2 + g_3 + g_4 + plot_layout(widths = c(8, 2, 2, 2)) El diagrama de abajo explica los elementos de la versión típica del diagrama de caja y brazos (boxplot). RIC se refiere al Rango Intercuantílico, definido por la diferencia entre los cuantiles 25% y 75%. Figura: Jumanbar / CC BY-SA Ventajas en el análisis inicial En un principio del análisis, estos resúmenes (cuantiles) pueden ser más útiles que utilizar medias y varianzas, por ejemplo. La razón es que los cuantiles: Son cantidades más fácilmente interpretables Los cuantiles centrales son más resistentes a valores atípicos que medias o varianzas Permiten identificar valores extremos Es fácil comparar cuantiles de distintos bonches de datos en la misma escala Nota: Existen diferentes definiciones para calcular cuantiles de una muestra de datos, puedes leer más en este artículo. Media y desviación estándar Las medidas más comunes de localización y dispersión para un conjunto de datos son la media muestral y la desviación estándar muestral. En general, no son muy apropiadas para iniciar el análisis exploratorio, pues: Son medidas más difíciles de interpretar y explicar que los cuantiles. En este sentido, son medidas especializadas. Por ejemplo, compara una explicación intuitiva de la mediana contra una explicación intuitiva de la media. No son resistentes a valores atípicos. Su falta de resistencia los vuelve poco útiles en las primeras etapas de limpieza y descripción y en resúmenes deficientes para distribuciones irregulares (con colas largas por ejemplo). La media, o promedio, se denota por \\(\\bar x\\) y se define como \\[\\begin{align} \\bar x = \\frac1N \\sum_{n = 1}^N x_n. \\end{align}\\] La desviación estándar muestral se define como \\[\\begin{align} \\text{std}(x) = \\sqrt{\\frac1{N-1} \\sum_{n = 1}^N (x_n - \\bar x)^2}. \\end{align}\\] Observación: Si \\(N\\) no es muy chica, no importa mucho si dividimos por \\(N\\) o por \\(N-1\\) en la fórmula de la desviación estándar. La razón de que típicamente se usa \\(N-1\\) la veremos más adelante, en la parte de estimación. Por otro lado, ventajas de estas medidas de centralidad y dispersión son: La media y desviación estándar son computacionalmente convenientes. Por lo tanto regresaremos a estas medidas una vez que estudiemos modelos de probabilidad básicos. En muchas ocasiones conviene usar estas medidas pues permite hacer comparaciones históricas o tradicionales —pues análisis anteriores pudieran estar basados en éstas. Considera el caso de tener \\(N\\) observaciones y asume que ya tienes calculado el promedio para dichas observaciones. Este promedio lo denotaremos por \\(\\bar x_N\\). Ahora, considera que has obtenido \\(M\\) observaciones más. Escribe una fórmula recursiva para la media del conjunto total de datos \\(\\bar x_{N+M}\\) en función de lo que ya tenías precalculado \\(\\bar x_N.\\) ¿En qué situaciones esta propiedad puede ser conveniente? Ejemplos Precios de casas En este ejemplo consideremos los datos de precios de ventas de la ciudad de Ames, Iowa. En particular nos interesa entender la variación del precio de las casas. Por este motivo calculamos los cuantiles que corresponden al 25%, 50% y 75% (cuartiles), así como el mínimo y máximo de los precios de las casas: quantile(casas |> pull(precio_miles)) ## 0% 25% 50% 75% 100% ## 37.9 132.0 165.0 215.0 755.0 Comprueba que el mínimo y máximo están asociados a los cuantiles 0% y 100%, respectivamente. Una posible comparación es considerar los precios y sus variación en función de zona de la ciudad en que se encuentra una vivienda. Podemos usar diagramas de caja y brazos para hacer una comparación burda de los precios en distintas zonas de la ciudad: ggplot(casas, aes(x = nombre_zona, y = precio_miles)) + geom_boxplot() + coord_flip() La primera pregunta que nos hacemos es cómo pueden variar las características de las casas dentro de cada zona. Para esto, podemos considerar el área de las casas. En lugar de graficar el precio, graficamos el precio por metro cuadrado, por ejemplo: ggplot(casas, aes(x = nombre_zona, y = precio_m2)) + geom_boxplot() + coord_flip() Podemos cuantificar la variación que observamos de zona a zona y la variación que hay dentro de cada una de las zonas. Una primera aproximación es observar las variación del precio al calcular la mediana dentro de cada zona, y después cuantificar por medio de cuantiles cómo varía la mediana entre zonas: casas |> group_by(nombre_zona) |> summarise(mediana_zona = median(precio_m2), .groups = "drop") |> arrange(mediana_zona) |> pull(mediana_zona) |> quantile() |> round() ## 0% 25% 50% 75% 100% ## 963 1219 1298 1420 1725 Por otro lado, las variaciones con respecto a las medianas dentro de cada zona, por grupo, se resume como: quantile(casas |> group_by(nombre_zona) |> mutate(residual = precio_m2 - median(precio_m2)) |> pull(residual)) |> round() ## 0% 25% 50% 75% 100% ## -765 -166 0 172 1314 Nótese que este último paso tiene sentido pues la variación dentro de las zonas, en términos de precio por metro cuadrado, es similar. Esto no lo podríamos haber hecho de manera efectiva si se hubiera utilizado el precio de las casas sin ajustar por su tamaño. Podemos resumir este primer análisis con un par de gráficas de cuantiles (William S. Cleveland (1993)): mediana <- median(casas$precio_m2) resumen <- casas |> select(nombre_zona, precio_m2) |> group_by(nombre_zona) |> mutate(mediana_zona = median(precio_m2)) |> mutate(residual = precio_m2 - mediana_zona) |> ungroup() |> mutate(mediana_zona = mediana_zona - mediana) |> select(nombre_zona, mediana_zona, residual) |> pivot_longer(mediana_zona:residual, names_to = "tipo", values_to = "valor") ggplot(resumen, aes(sample = valor)) + geom_qq(distribution = stats::qunif) + facet_wrap(~ tipo) + ylab("Precio por m2") + xlab("f") + labs(subtitle = "Precio por m2 por zona", caption = paste0("Mediana total de ", round(mediana))) Vemos que la mayor parte de la variación del precio por metro cuadrado ocurre dentro de cada zona, una vez que controlamos por el tamaño de las casas. La variación dentro de cada zona es aproximadamente simétrica, aunque la cola derecha es ligeramente más larga con algunos valores extremos. Podemos seguir con otro indicador importante: la calificación de calidad de los terminados de las casas. Como primer intento podríamos hacer: Lo que indica que las calificaciones de calidad están distribuidas de manera muy distinta a lo largo de las zonas, y que probablemente no va ser simple desentrañar qué variación del precio se debe a la zona y cuál se debe a la calidad. Prueba Enlace Consideremos la prueba Enlace (2011) de matemáticas para primarias. Una primera pregunta que alguien podría hacerse es: ¿cuáles escuelas son mejores en este rubro, las privadas o las públicas? enlace_tbl <- enlace |> group_by(tipo) |> summarise(n_escuelas = n(), cuantiles = list(cuantil(mate_6, c(0.05, 0.25, 0.5, 0.75, 0.95)))) |> unnest(cols = cuantiles) |> mutate(valor = round(valor)) enlace_tbl |> spread(cuantil, valor) |> gt() #sykxxonvyi table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #sykxxonvyi thead, #sykxxonvyi tbody, #sykxxonvyi tfoot, #sykxxonvyi tr, #sykxxonvyi td, #sykxxonvyi th { border-style: none; } #sykxxonvyi p { margin: 0; padding: 0; } #sykxxonvyi .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #sykxxonvyi .gt_caption { padding-top: 4px; padding-bottom: 4px; } #sykxxonvyi .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #sykxxonvyi .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #sykxxonvyi .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #sykxxonvyi .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #sykxxonvyi .gt_column_spanner_outer:first-child { padding-left: 0; } #sykxxonvyi .gt_column_spanner_outer:last-child { padding-right: 0; } #sykxxonvyi .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #sykxxonvyi .gt_spanner_row { border-bottom-style: hidden; } #sykxxonvyi .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #sykxxonvyi .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #sykxxonvyi .gt_from_md > :first-child { margin-top: 0; } #sykxxonvyi .gt_from_md > :last-child { margin-bottom: 0; } #sykxxonvyi .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #sykxxonvyi .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #sykxxonvyi .gt_row_group_first td { border-top-width: 2px; } #sykxxonvyi .gt_row_group_first th { border-top-width: 2px; } #sykxxonvyi .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #sykxxonvyi .gt_first_summary_row.thick { border-top-width: 2px; } #sykxxonvyi .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #sykxxonvyi .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #sykxxonvyi .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sykxxonvyi .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sykxxonvyi .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sykxxonvyi .gt_left { text-align: left; } #sykxxonvyi .gt_center { text-align: center; } #sykxxonvyi .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #sykxxonvyi .gt_font_normal { font-weight: normal; } #sykxxonvyi .gt_font_bold { font-weight: bold; } #sykxxonvyi .gt_font_italic { font-style: italic; } #sykxxonvyi .gt_super { font-size: 65%; } #sykxxonvyi .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #sykxxonvyi .gt_asterisk { font-size: 100%; vertical-align: 0; } #sykxxonvyi .gt_indent_1 { text-indent: 5px; } #sykxxonvyi .gt_indent_2 { text-indent: 10px; } #sykxxonvyi .gt_indent_3 { text-indent: 15px; } #sykxxonvyi .gt_indent_4 { text-indent: 20px; } #sykxxonvyi .gt_indent_5 { text-indent: 25px; } #sykxxonvyi .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #sykxxonvyi div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } tipo n_escuelas 0.05 0.25 0.5 0.75 0.95 Indígena/Conafe 13599 304 358 412 478 588 General 60166 380 454 502 548 631 Particular 6816 479 551 593 634 703 Para un análisis exploratorio podemos utilizar distintas gráficas. Por ejemplo, podemos utilizar nuevamente las gráficas de caja y brazos, así como graficar los percentiles. Nótese que en la gráfica 1 se utilizan los cuantiles 0.05, 0.25, 0.5, 0.75 y 0.95: ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0. ## ℹ Please use `linewidth` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. Se puede discutir qué tan apropiada es cada gráfica con el objetivo de realizar comparaciones. Sin duda, graficar más cuantiles es más útil para hacer comparaciones. Por ejemplo, en la Gráfica 1 podemos ver que la mediana de las escuelas generales está cercana al cuantil 5% de las escuelas particulares. Por otro lado, el diagrama de caja y brazos muestra también valores “atípicos”. Antes de contestar prematuramente la pregunta: ¿cuáles son las mejores escuelas? busquemos mejorar la interpretabilidad de nuestras comparaciones. Podemos comenzar por agregar, por ejemplo, el nivel del marginación del municipio donde se encuentra la escuela. Para este objetivo, podemos usar páneles (pequeños múltiplos útiles para hacer comparaciones) y graficar: Esta gráfica pone en contexto la pregunta inicial, y permite evidenciar la dificultad de contestarla. En particular: Señala que la pregunta no sólo debe concentarse en el tipo de “sistema”: pública, privada, etc. Por ejemplo, las escuelas públicas en zonas de marginación baja no tienen una distribución de calificaciones muy distinta a las privadas en zonas de marginación alta. El contexto de la escuela es importante. Debemos de pensar qué factores –por ejemplo, el entorno familiar de los estudiantes– puede resultar en comparaciones que favorecen a las escuelas privadas. Un ejemplo de esto es considerar si los estudiantes tienen que trabajar o no. A su vez, esto puede o no ser reflejo de la calidad del sistema educativo. Si esto es cierto, entonces la pregunta inicial es demasiado vaga y mal planteada. Quizá deberíamos intentar entender cuánto “aporta” cada escuela a cada estudiante, como medida de qué tan buena es cada escuela. Estados y calificaciones en SAT ¿Cómo se relaciona el gasto por alumno, a nivel estatal, con sus resultados académicos? Hay trabajo considerable en definir estos términos, pero supongamos que tenemos el siguiente conjunto de datos (Guber 1999), que son datos oficiales agregados por estado de Estados Unidos. Consideremos el subconjunto de variables sat, que es la calificación promedio de los alumnos en cada estado (para 1997) y expend, que es el gasto en miles de dólares por estudiante en (1994-1995). sat <- read_csv("data/sat.csv") sat_tbl <- sat |> select(state, expend, sat) |> gather(variable, valor, expend:sat) |> group_by(variable) |> summarise(cuantiles = list(cuantil(valor))) |> unnest(cols = c(cuantiles)) |> mutate(valor = round(valor, 1)) |> spread(cuantil, valor) sat_tbl |> gt() #trvhlcrcph table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #trvhlcrcph thead, #trvhlcrcph tbody, #trvhlcrcph tfoot, #trvhlcrcph tr, #trvhlcrcph td, #trvhlcrcph th { border-style: none; } #trvhlcrcph p { margin: 0; padding: 0; } #trvhlcrcph .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #trvhlcrcph .gt_caption { padding-top: 4px; padding-bottom: 4px; } #trvhlcrcph .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #trvhlcrcph .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #trvhlcrcph .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #trvhlcrcph .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #trvhlcrcph .gt_column_spanner_outer:first-child { padding-left: 0; } #trvhlcrcph .gt_column_spanner_outer:last-child { padding-right: 0; } #trvhlcrcph .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #trvhlcrcph .gt_spanner_row { border-bottom-style: hidden; } #trvhlcrcph .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #trvhlcrcph .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #trvhlcrcph .gt_from_md > :first-child { margin-top: 0; } #trvhlcrcph .gt_from_md > :last-child { margin-bottom: 0; } #trvhlcrcph .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #trvhlcrcph .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #trvhlcrcph .gt_row_group_first td { border-top-width: 2px; } #trvhlcrcph .gt_row_group_first th { border-top-width: 2px; } #trvhlcrcph .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #trvhlcrcph .gt_first_summary_row.thick { border-top-width: 2px; } #trvhlcrcph .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #trvhlcrcph .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #trvhlcrcph .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #trvhlcrcph .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #trvhlcrcph .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #trvhlcrcph .gt_left { text-align: left; } #trvhlcrcph .gt_center { text-align: center; } #trvhlcrcph .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #trvhlcrcph .gt_font_normal { font-weight: normal; } #trvhlcrcph .gt_font_bold { font-weight: bold; } #trvhlcrcph .gt_font_italic { font-style: italic; } #trvhlcrcph .gt_super { font-size: 65%; } #trvhlcrcph .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #trvhlcrcph .gt_asterisk { font-size: 100%; vertical-align: 0; } #trvhlcrcph .gt_indent_1 { text-indent: 5px; } #trvhlcrcph .gt_indent_2 { text-indent: 10px; } #trvhlcrcph .gt_indent_3 { text-indent: 15px; } #trvhlcrcph .gt_indent_4 { text-indent: 20px; } #trvhlcrcph .gt_indent_5 { text-indent: 25px; } #trvhlcrcph .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #trvhlcrcph div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } variable 0 0.25 0.5 0.75 1 expend 3.7 4.9 5.8 6.4 9.8 sat 844.0 897.2 945.5 1032.0 1107.0 Esta variación es considerable para promedios del SAT: el percentil 75 es alrededor de 1050 puntos, mientras que el percentil 25 corresponde a alrededor de 800. Igualmente, hay diferencias considerables de gasto por alumno (miles de dólares) a lo largo de los estados. Ahora hacemos nuestro primer ejercico de comparación: ¿Cómo se ven las calificaciones para estados en distintos niveles de gasto? Podemos usar una gráfica de dispersión: library(ggrepel) ggplot(sat, aes(x = expend, y = sat, label = state)) + geom_point(colour = "red", size = 2) + geom_text_repel(colour = "gray50") + xlab("Gasto por alumno (miles de dólares)") + ylab("Calificación promedio en SAT") Estas comparaciones no son de alta calidad, solo estamos usando 2 variables —que son muy pocas— y no hay mucho que podamos decir en cuanto explicación. Sin duda nos hace falta una imagen más completa. Necesitaríamos entender la correlación que existe entre las demás características de nuestras unidades de estudio. Las unidades que estamos comparando pueden diferir fuertemente en otras propiedades importantes (o dimensiones), lo cual no permite interpretar la gráfica de manera sencilla. Una variable que tenemos es el porcentaje de alumnos de cada estado que toma el SAT. Podemos agregar como sigue: ggplot(sat, aes(x = expend, y = math, label=state, colour = frac)) + geom_point() + geom_text_repel() + xlab("Gasto por alumno (miles de dólares)") + ylab("Calificación promedio en SAT") Esto nos permite entender por qué nuestra comparación inicial es relativamente pobre. Los estados con mejores resultados promedio en el SAT son aquellos donde una fracción relativamente baja de los estudiantes toma el examen. La diferencia es considerable. En este punto podemos hacer varias cosas. Una primera idea es intentar comparar estados más similares en cuanto a la población de alumnos que asiste. Podríamos hacer grupos como sigue: set.seed(991) k_medias_sat <- kmeans(sat |> select(frac), centers = 4, nstart = 100, iter.max = 100) sat$clase <- k_medias_sat$cluster sat <- sat |> group_by(clase) |> mutate(clase_media = round(mean(frac))) |> ungroup() |> mutate(clase_media = factor(clase_media)) sat <- sat |> mutate(rank_p = rank(frac, ties= "first") / length(frac)) ggplot(sat, aes(x = rank_p, y = frac, label = state, colour = clase_media)) + geom_point(size = 2) Estos resultados indican que es más probable que buenos alumnos decidan hacer el SAT. Lo interesante es que esto ocurre de manera diferente en cada estado. Por ejemplo, en algunos estados era más común otro examen: el ACT. Si hacemos clusters de estados según el % de alumnos, empezamos a ver otra historia. Para esto, ajustemos rectas de mínimos cuadrados como referencia: Esto da una imagen muy diferente a la que originalmente planteamos. Nota que dependiendo de cómo categorizamos, esta gráfica puede variar (puedes intentar con más o menos grupos, por ejemplo). Tablas de conteos Consideremos los siguientes datos de tomadores de té (del paquete FactoMineR (Lê et al. 2008)): tea <- read_csv("data/tea.csv") # nombres y códigos te <- tea |> select(how, price, sugar) |> rename(presentacion = how, precio = price, azucar = sugar) |> mutate( presentacion = fct_recode(presentacion, suelto = "unpackaged", bolsas = "tea bag", mixto = "tea bag+unpackaged"), precio = fct_recode(precio, marca = "p_branded", variable = "p_variable", barato = "p_cheap", marca_propia = "p_private label", desconocido = "p_unknown", fino = "p_upscale"), azucar = fct_recode(azucar, sin_azúcar = "No.sugar", con_azúcar = "sugar")) sample_n(te, 10) ## # A tibble: 10 × 3 ## presentacion precio azucar ## <fct> <fct> <fct> ## 1 bolsas marca sin_azúcar ## 2 bolsas variable sin_azúcar ## 3 bolsas marca con_azúcar ## 4 bolsas fino con_azúcar ## 5 mixto variable con_azúcar ## 6 mixto fino con_azúcar ## 7 bolsas marca sin_azúcar ## 8 bolsas fino sin_azúcar ## 9 mixto variable con_azúcar ## 10 mixto variable sin_azúcar Nos interesa ver qué personas compran té suelto, y de qué tipo. Empezamos por ver las proporciones que compran té según su empaque (en bolsita o suelto): precio <- te |> count(precio) |> mutate(prop = round(100 * n / sum(n))) |> select(-n) tipo <- te |> count(presentacion) |> mutate(pct = round(100 * n / sum(n))) tipo |> gt() #wiljiluquk table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #wiljiluquk thead, #wiljiluquk tbody, #wiljiluquk tfoot, #wiljiluquk tr, #wiljiluquk td, #wiljiluquk th { border-style: none; } #wiljiluquk p { margin: 0; padding: 0; } #wiljiluquk .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #wiljiluquk .gt_caption { padding-top: 4px; padding-bottom: 4px; } #wiljiluquk .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #wiljiluquk .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #wiljiluquk .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #wiljiluquk .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #wiljiluquk .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #wiljiluquk .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #wiljiluquk .gt_column_spanner_outer:first-child { padding-left: 0; } #wiljiluquk .gt_column_spanner_outer:last-child { padding-right: 0; } #wiljiluquk .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #wiljiluquk .gt_spanner_row { border-bottom-style: hidden; } #wiljiluquk .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #wiljiluquk .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #wiljiluquk .gt_from_md > :first-child { margin-top: 0; } #wiljiluquk .gt_from_md > :last-child { margin-bottom: 0; } #wiljiluquk .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #wiljiluquk .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #wiljiluquk .gt_row_group_first td { border-top-width: 2px; } #wiljiluquk .gt_row_group_first th { border-top-width: 2px; } #wiljiluquk .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #wiljiluquk .gt_first_summary_row.thick { border-top-width: 2px; } #wiljiluquk .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #wiljiluquk .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #wiljiluquk .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #wiljiluquk .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #wiljiluquk .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #wiljiluquk .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #wiljiluquk .gt_left { text-align: left; } #wiljiluquk .gt_center { text-align: center; } #wiljiluquk .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #wiljiluquk .gt_font_normal { font-weight: normal; } #wiljiluquk .gt_font_bold { font-weight: bold; } #wiljiluquk .gt_font_italic { font-style: italic; } #wiljiluquk .gt_super { font-size: 65%; } #wiljiluquk .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #wiljiluquk .gt_asterisk { font-size: 100%; vertical-align: 0; } #wiljiluquk .gt_indent_1 { text-indent: 5px; } #wiljiluquk .gt_indent_2 { text-indent: 10px; } #wiljiluquk .gt_indent_3 { text-indent: 15px; } #wiljiluquk .gt_indent_4 { text-indent: 20px; } #wiljiluquk .gt_indent_5 { text-indent: 25px; } #wiljiluquk .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #wiljiluquk div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } presentacion n pct bolsas 170 57 mixto 94 31 suelto 36 12 La mayor parte de las personas toma té en bolsas. Sin embargo, el tipo de té (en términos de precio o marca) que compran es muy distinto dependiendo de la presentación: tipo <- tipo |> select(presentacion, prop_presentacion = pct) tabla_cruzada <- te |> count(presentacion, precio) |> # porcentajes por presentación group_by(presentacion) |> mutate(prop = round(100 * n / sum(n))) |> select(-n) tabla_cruzada |> pivot_wider(names_from = presentacion, values_from = prop, values_fill = list(prop = 0)) |> gt() #sxkvcchtyg table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #sxkvcchtyg thead, #sxkvcchtyg tbody, #sxkvcchtyg tfoot, #sxkvcchtyg tr, #sxkvcchtyg td, #sxkvcchtyg th { border-style: none; } #sxkvcchtyg p { margin: 0; padding: 0; } #sxkvcchtyg .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #sxkvcchtyg .gt_caption { padding-top: 4px; padding-bottom: 4px; } #sxkvcchtyg .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #sxkvcchtyg .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #sxkvcchtyg .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #sxkvcchtyg .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #sxkvcchtyg .gt_column_spanner_outer:first-child { padding-left: 0; } #sxkvcchtyg .gt_column_spanner_outer:last-child { padding-right: 0; } #sxkvcchtyg .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #sxkvcchtyg .gt_spanner_row { border-bottom-style: hidden; } #sxkvcchtyg .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #sxkvcchtyg .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #sxkvcchtyg .gt_from_md > :first-child { margin-top: 0; } #sxkvcchtyg .gt_from_md > :last-child { margin-bottom: 0; } #sxkvcchtyg .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #sxkvcchtyg .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #sxkvcchtyg .gt_row_group_first td { border-top-width: 2px; } #sxkvcchtyg .gt_row_group_first th { border-top-width: 2px; } #sxkvcchtyg .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #sxkvcchtyg .gt_first_summary_row.thick { border-top-width: 2px; } #sxkvcchtyg .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #sxkvcchtyg .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #sxkvcchtyg .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #sxkvcchtyg .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #sxkvcchtyg .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #sxkvcchtyg .gt_left { text-align: left; } #sxkvcchtyg .gt_center { text-align: center; } #sxkvcchtyg .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #sxkvcchtyg .gt_font_normal { font-weight: normal; } #sxkvcchtyg .gt_font_bold { font-weight: bold; } #sxkvcchtyg .gt_font_italic { font-style: italic; } #sxkvcchtyg .gt_super { font-size: 65%; } #sxkvcchtyg .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #sxkvcchtyg .gt_asterisk { font-size: 100%; vertical-align: 0; } #sxkvcchtyg .gt_indent_1 { text-indent: 5px; } #sxkvcchtyg .gt_indent_2 { text-indent: 10px; } #sxkvcchtyg .gt_indent_3 { text-indent: 15px; } #sxkvcchtyg .gt_indent_4 { text-indent: 20px; } #sxkvcchtyg .gt_indent_5 { text-indent: 25px; } #sxkvcchtyg .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #sxkvcchtyg div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } precio bolsas mixto suelto marca 41 21 14 barato 3 1 3 marca_propia 9 4 3 desconocido 6 1 0 fino 8 20 56 variable 32 52 25 Estos datos podemos examinarlos un rato y llegar a conclusiones, pero esta tabla no necesariamente es la mejor manera de mostrar patrones en los datos. Tampoco son muy útiles gráficas como la siguiente: ggplot(tabla_cruzada |> ungroup() |> mutate(price = fct_reorder(precio, prop)), aes(x = precio, y = prop, group = presentacion, colour = presentacion)) + geom_point() + coord_flip() + geom_line() En lugar de eso, calcularemos perfiles columna. Esto es, comparamos cada una de las columnas con la columna marginal (en la tabla de tipo de estilo de té): num_grupos <- n_distinct(te |> select(presentacion)) tabla <- te |> count(presentacion, precio) |> group_by(presentacion) |> mutate(prop_precio = (100 * n / sum(n))) |> group_by(precio) |> mutate(prom_prop = sum(prop_precio)/num_grupos) |> mutate(perfil = 100 * (prop_precio / prom_prop - 1)) tabla ## # A tibble: 17 × 6 ## # Groups: precio [6] ## presentacion precio n prop_precio prom_prop perfil ## <fct> <fct> <int> <dbl> <dbl> <dbl> ## 1 bolsas marca 70 41.2 25.4 61.8 ## 2 bolsas barato 5 2.94 2.26 30.1 ## 3 bolsas marca_propia 16 9.41 5.48 71.7 ## 4 bolsas desconocido 11 6.47 2.51 158. ## 5 bolsas fino 14 8.24 28.0 -70.6 ## 6 bolsas variable 54 31.8 36.3 -12.5 ## 7 mixto marca 20 21.3 25.4 -16.4 ## 8 mixto barato 1 1.06 2.26 -52.9 ## 9 mixto marca_propia 4 4.26 5.48 -22.4 ## 10 mixto desconocido 1 1.06 2.51 -57.6 ## 11 mixto fino 19 20.2 28.0 -27.8 ## 12 mixto variable 49 52.1 36.3 43.6 ## 13 suelto marca 5 13.9 25.4 -45.4 ## 14 suelto barato 1 2.78 2.26 22.9 ## 15 suelto marca_propia 1 2.78 5.48 -49.3 ## 16 suelto fino 20 55.6 28.0 98.4 ## 17 suelto variable 9 25 36.3 -31.1 tabla_perfil <- tabla |> select(presentacion, precio, perfil, pct = prom_prop) |> pivot_wider(names_from = presentacion, values_from = perfil, values_fill = list(perfil = -100.0)) if_profile <- function(x){ any(x < 0) & any(x > 0) } marcar <- marcar_tabla_fun(25, "red", "black") tab_out <- tabla_perfil |> arrange(desc(bolsas)) |> select(-pct, everything()) |> mutate(across(where(is.numeric), \\(x) round(x, 0))) |> mutate(across(where(if_profile), \\(x) marcar(x))) |> knitr::kable(format_table_salida(), escape = FALSE, digits = 0, booktabs = T) |> kableExtra::kable_styling(latex_options = c("striped", "scale_down"), bootstrap_options = c( "hover", "condensed"), full_width = FALSE) tab_out precio bolsas mixto suelto pct desconocido 158 -58 -100 3 marca_propia 72 -22 -49 5 marca 62 -16 -45 25 barato 30 -53 23 2 variable -12 44 -31 36 fino -71 -28 98 28 Leemos esta tabla como sigue: por ejemplo, los compradores de té suelto compran té fino a una tasa casi el doble (98%) que el promedio. También podemos graficar como: tabla_graf <- tabla_perfil |> ungroup() |> mutate(precio = fct_reorder(precio, bolsas)) |> select(-pct) |> pivot_longer(cols = -precio, names_to = "presentacion", values_to = "perfil") g_perfil <- ggplot(tabla_graf, aes(x = precio, xend = precio, y = perfil, yend = 0, group = presentacion)) + geom_point() + geom_segment() + facet_wrap(~presentacion) + geom_hline(yintercept = 0 , colour = "gray")+ coord_flip() g_perfil Observación: hay dos maneras de construir la columna promedio: tomando los porcentajes sobre todos los datos, o promediando los porcentajes de las columnas. Si los grupos de las columnas están desbalanceados, estos promedios son diferentes. Cuando usamos porcentajes sobre la población, perfiles columna y renglón dan el mismo resultado Sin embargo, cuando hay un grupo considerablemente más grande que otros, las comparaciones se vuelven vs este grupo particular. No siempre queremos hacer esto. Interpretación En el último ejemplo de tomadores de té utilizamos una muestra de personas, no toda la población de tomadores de té. Eso quiere decir que tenemos cierta incertidumbre de cómo se generalizan o no los resultados que obtuvimos en nuestro análisis a la población general. Nuestra respuesta depende de cómo se extrajo la muestra que estamos considerando. Si el mecanismo de extracción incluye algún proceso probabilístico, entonces es posible en principio entender qué tan bien generalizan los resultados de nuestro análisis a la población general, y entender esto depende de entender qué tanta variación hay de muestra a muestra, de todas las posibles muestras que pudimos haber extraido. En las siguientes secciones discutiremos estos aspectos, en los cuales pasamos del trabajo de “detective” al trabajo de “juez” en nuestro trabajo analítico. Suavizamiento loess Las gráficas de dispersión son la herramienta básica para describir la relación entre dos variables cuantitativas, y como vimos en ejemplo anteriores, muchas veces podemos apreciar mejor la relación entre ellas si agregamos una curva loess. Veamos un ejemplo, los siguientes datos muestran los premios ofrecidos y las ventas totales de una lotería a lo largo de 53 sorteos (las unidades son cantidades de dinero indexadas). Graficamos en escalas logarítmicas y agregamos una curva loess. # cargamos los datos load(here::here("data", "ventas_sorteo.Rdata")) ggplot(ventas.sorteo, aes(x = premio, y = ventas.tot.1)) + geom_point() + geom_smooth(method = "loess", span = 0.6, method.args = list(degree = 1), se = FALSE) + scale_x_log10(breaks = c(20000, 40000, 80000)) + scale_y_log10(breaks = c(10000, 15000, 22000, 33000)) El patrón no era difícil de ver en los datos originales, sin embargo, la curva lo hace más claro, el logaritmo de las ventas tiene una relación no lineal con el logaritmo del premio: para premios no muy grandes no parece haber gran diferencia, pero cuando los premios empiezan a crecer por encima de 20,000, las ventas crecen más rápidamente que para premios menores. Este efecto se conoce como bola de nieve, y es frecuente en este tipo de loterías. Antes de adentrarnos a los modelos loess comenzamos explicando cómo se ajustan familias paramétricas de curvas a conjuntos de datos dados. El modelo de regresion lineal ajusta una recta a un conjunto de datos. Por ejemplo, consideremos la familia \\[f_{a,b}(x) = a x + b,\\] para un conjunto de datos bivariados \\(\\{ (x_1, y_1), \\ldots, (x_N, y_N)\\}\\). Buscamos encontrar \\(a\\) y \\(b\\) tales que \\(f_{a,b}\\) de un ajuste óptimo a los datos. Para esto, se minimiza la suma de errores cuadráticos \\[\\frac1N \\sum_{n = 1}^N ( y_n - a x_n - b)^2.\\] En este caso, las constantes \\(a\\) y \\(b\\) se pueden encontrar diferenciando la función de mínimos cuadrados. Nótese que podemos repetir el argumento con otras familias de funciones (por ejemplo cuadráticas). ggplot(ventas.sorteo, aes(x = premio, y = ventas.tot.1)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + scale_x_log10(breaks = c(20000, 40000, 80000)) + scale_y_log10(breaks = c(10000, 15000, 22000, 33000)) Si observamos la gráfica notamos que este modelo lineal (en los logaritmos) no resumen adecuadamente estos datos. Podríamos experimentar con otras familias (por ejemplo, una cuadrática o cúbica, potencias, exponenciales, etc.); sin embargo, en la etapa exploratoria es mejor tomar una ruta de ajuste más flexible y robusta. Regresión local nos provee de un método con estas características: Curvas loess (regresión local): Una manera de mejorar la flexibilidad de los modelos lineales es considerar rectas de manera local. Es decir, en cada \\(x\\) posible consideramos cuál es la recta que mejor ajusta a los datos, considerando solamente valores de \\(x_n\\) que están cercanos a \\(x\\). La siguiente gráfica muestra qué recta se ajusta alrededor de cada punto, y cómo queda el suavizador completo, con distintos valores de suavizamiento. El tono de los puntos indican en cada paso que ventana de datos es considerada: Escogiendo de los parámetros. El parámetro de suavizamiento se encuentra por ensayo y error. La idea general es que debemos encontrar una curva que explique patrones importantes en los datos (que ajuste los datos) pero que no muestre variaciones a escalas más chicas difíciles de explicar (que pueden ser el resultado de influencias de otras variables, variación muestral, ruido o errores de redondeo, por ejemplo). En el proceso de prueba y error iteramos el ajuste y en cada paso hacemos análisis de residuales, con el fin de seleccionar un suavizamiento adecuado. En lugar de usar ajustes locales lineales, podemos usar ajustes locales cuadráticos que nos permiten capturar formas locales cuadráticas sin tener que suavizar demasiado poco: Opcional: cálculo del suavizador La idea es producir ajustes locales de rectas o funciones lineales o cuadráticas. Consideremos especificar dos parámetros: Parámetro de suavizamiento \\(\\alpha\\): toma valores en \\((0,1)\\), cuando \\(\\alpha\\) es más grande, la curva ajustada es más suave. Grado de los polinomios locales que ajustamos \\(\\lambda\\): generalmente se toma \\(\\lambda=1,2\\). Entonces, supongamos que los datos están dados por \\((x_1,y_1), \\ldots, (x_N, y_N)\\), y sean \\(\\alpha\\) un parámetro de suavizamiento fijo, y \\(\\lambda=1\\). Denotamos como \\(\\hat{g}(x)\\) la curva loess ajustada, y como \\(w_n(x)\\) a una función de peso (que depende de x) para la observación \\((x_n, y_n)\\). Para poder calcular \\(w_n(x)\\) debemos comenzar calculando \\(q=\\lfloor{N\\alpha}\\rfloor\\) que suponemos mayor que uno, esta \\(q\\) es el número de puntos que se utilizan en cada ajuste local. Ahora definimos la función tricubo: \\[\\begin{align} T(u)=\\begin{cases} (1-|u|^3)^3, & \\text{para $|u| < 1$}.\\\\ 0, & \\text{en otro caso}. \\end{cases} \\end{align}\\] entonces, para el punto \\(x\\) definimos el peso correspondiente al dato \\((x_n,y_n)\\), denotado por \\(w_n(x)\\) como: \\[w_n(x)=T\\bigg(\\frac{|x-x_n|}{d_q(x)}\\bigg)\\] donde \\(d_q(x)\\) es el valor de la \\(q\\)-ésima distancia más chica (la más grande entre las \\(q\\) más chicas) entre los valores \\(|x-x_j|\\), \\(j=1,\\ldots,N\\). De esta forma, las observaciones \\(x_n\\) reciben más peso cuanto más cerca estén de \\(x\\). En palabras, de \\(x_1,...,x_N\\) tomamos los \\(q\\) datos más cercanos a \\(x\\), que denotamos \\(x_{i_1}(x) \\leq x_{i_2}(x) \\leq \\cdots \\leq x_{i_q}(x)\\). Los re-escalamos a \\([0,1]\\) haciendo corresponder \\(x\\) a \\(0\\) y el punto más alejado de \\(x\\) (que es \\(x_{i_q}\\)) a 1. Aplicamos el tricubo (gráfica de abajo), para encontrar los pesos de cada punto. Los puntos que están a una distancia mayor a \\(d_q(x)\\) reciben un peso de cero, y los más cercanos un peso que depende de que tan cercanos están a \\(x\\). Nótese que \\(x\\) es el punto ancla en dónde estamos ajustando la regresión local. tricubo <- function(x) { ifelse(abs(x) < 1, (1 - abs(x) ^ 3) ^ 3, 0) } curve(tricubo, from = -1.5, to = 1.5) Finalmente, para cada valor de \\(x_k\\) que está en el conjunto de datos \\(\\{x_1,...,x_n\\}\\), ajustamos una recta de mínimos cuadrados ponderados por los pesos \\(w_n(x)\\), es decir, minimizamos (en el caso lineal): \\[\\sum_{i=1}^nw_n(x_k)(y_i-ax_n-b)^2.\\] Observaciones: Cualquier función (continua y quizás diferenciable) con la forma de flan del tricubo que se desvanece fuera de \\((-1,1),\\) es creciente en \\((-1,0)\\) y decreciente en \\((0, 1)\\) es un buen candidato para usarse en lugar del tricubo. La razón por la que escogemos precisamente esta forma algebráica no tiene que ver con el análisis exploratorio, sino con las ventajas teóricas adicionales que tiene en la inferencia. El caso \\(\\lambda=2\\) es similar. La única diferencia es en el paso de ajuste, donde usamos funciones cuadráticas, y obtendríamos entonces tres familias de parámetros \\(a(x_k), b_1(x_k), b_2(x_k),\\) para cada \\(k \\in \\{1, \\ldots, N\\}\\). Caso de estudio: nacimientos en México Podemos usar el suavizamiento loess para entender y describir el comportamiento de series de tiempo, en las cuáles intentamos entender la dependencia de una serie de mediciones indexadas por el tiempo. Típicamente es necesario utilizar distintas componentes para describir exitosamente una serie de tiempo, y para esto usamos distintos tipos de suavizamientos. Veremos que distintas componentes varían en distintas escalas de tiempo (unas muy lentas, como la tendencia, otras más rapidamente, como variación quincenal, etc.). Este caso de estudio esta basado en un análisis propuesto por A. Vehtari y A. Gelman, junto con un análisis de serie de tiempo de William S. Cleveland (1993). En nuestro caso, usaremos los datos de nacimientos registrados por día en México desde 1999. Los usaremos para contestar las preguntas: ¿cuáles son los cumpleaños más frecuentes? y ¿en qué mes del año hay más nacimientos? Podríamos utilizar una gráfica popular (ver por ejemplo esta visualización) como: Sin embargo, ¿cómo criticarías este análisis desde el punto de vista de los tres primeros principios del diseño analítico? ¿Las comparaciones son útiles? ¿Hay aspectos multivariados? ¿Qué tan bien explica o sugiere estructura, mecanismos o causalidad? Datos de natalidad para México library(lubridate) library(ggthemes) theme_set(theme_minimal(base_size = 14)) natalidad <- read_rds("./data/nacimientos/natalidad.rds") |> mutate(dia_semana = weekdays(fecha)) |> mutate(dia_año = yday(fecha)) |> mutate(año = year(fecha)) |> mutate(mes = month(fecha)) |> ungroup() |> mutate(dia_semana = recode(dia_semana, Monday = "Lunes", Tuesday = "Martes", Wednesday = "Miércoles", Thursday = "Jueves", Friday = "Viernes", Saturday = "Sábado", Sunday = "Domingo")) |> #necesario pues el LOCALE puede cambiar mutate(dia_semana = recode(dia_semana, lunes = "Lunes", martes = "Martes", miércoles = "Miércoles", jueves = "Jueves", viernes = "Viernes", sábado = "Sábado", domingo = "Domingo")) |> mutate(dia_semana = fct_relevel(dia_semana, c("Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Domingo"))) Consideremos los datos agregados del número de nacimientos (registrados) por día desde 1999 hasta 2016. Un primer intento podría ser hacer una gráfica de la serie de tiempo. Sin embargo, vemos que no es muy útil: Hay varias características que notamos. Primero, parece haber una tendencia ligeramente decreciente del número de nacimientos a lo largo de los años. Segundo, la gráfica sugiere un patrón anual. Y por último, encontramos que hay dispersión producida por los días de la semana. Sólo estas características hacen que la comparación entre días sea difícil de realizar. Supongamos que comparamos el número de nacimientos de dos miércoles dados. Esa comparación será diferente dependiendo: del año donde ocurrieron, el mes donde ocurrieron, si semana santa ocurrió en algunos de los miércoles, y así sucesivamente. Como en nuestros ejemplos anteriores, la idea del siguiente análisis es aislar las componentes que observamos en la serie de tiempo: extraemos componentes ajustadas, y luego examinamos los residuales. En este caso particular, asumiremos una descomposición aditiva de la serie de tiempo (William S. Cleveland 1993). En el estudio de series de tiempo una estructura común es considerar el efecto de diversos factores como tendencia, estacionalidad, ciclicidad e irregularidades de manera aditiva. Esto es, consideramos la descomposición \\[\\begin{align} y(t) = f_{t}(t) + f_{e}(t) + f_{c}(t) + \\varepsilon. \\end{align}\\] Una estrategia de ajuste, como veremos más adelante, es proceder de manera modular. Es decir, se ajustan los componentes de manera secuencial considerando los residuales de los anteriores. Tendencia Comenzamos por extraer la tendencia, haciendo promedios loess (William S. Cleveland 1979) con vecindades relativamente grandes. Quizá preferiríamos suavizar menos para capturar más variación lenta, pero si hacemos esto en este punto empezamos a absorber parte de la componente anual: mod_1 <- loess(n ~ as.numeric(fecha), data = natalidad, span = 0.2, degree = 1) datos_dia <- natalidad |> mutate(ajuste_1 = fitted(mod_1)) |> mutate(res_1 = n - ajuste_1) Notemos que a principios de 2000 el suavizador está en niveles de alrededor de 7000 nacimientos diarios, hacia 2015 ese número es más cercano a unos 6000. Componente anual Al obtener la tendencia podemos aislar el efecto a largo plazo y proceder a realizar mejores comparaciones (por ejemplo, comparar un día de 2000 y de 2015 tendria más sentido). Ahora, ajustamos los residuales del suavizado anterior, pero con menos suavizamiento. Así evitamos capturar tendencia: mod_anual <- loess(res_1 ~ as.numeric(fecha), data = datos_dia, degree = 2, span = 0.005) datos_dia <- datos_dia |> mutate(ajuste_2 = fitted(mod_anual)) |> mutate(res_2 = res_1 - ajuste_2) Día de la semana Hasta ahora, hemos aislado los efectos por plazos largos de tiempo (tendencia) y hemos incorporado las variaciones estacionales (componente anual) de nuestra serie de tiempo. Ahora, veremos cómo capturar el efecto por día de la semana. En este caso, podemos hacer suavizamiento loess para cada serie de manera independiente datos_dia <- datos_dia |> group_by(dia_semana) |> nest() |> mutate(ajuste_mod = map(data, ~ loess(res_2 ~ as.numeric(fecha), data = .x, span = 0.1, degree = 1))) |> mutate(ajuste_3 = map(ajuste_mod, fitted)) |> select(-ajuste_mod) |> unnest(cols = c(data, ajuste_3)) |> mutate(res_3 = res_2 - ajuste_3) |> ungroup() Residuales Por último, examinamos los residuales finales quitando los efectos ajustados: ## `geom_smooth()` using formula = 'y ~ x' Observación: nótese que la distribución de estos residuales presenta irregularidades interesantes. La distribución es de colas largas, y no se debe a unos cuantos datos atípicos. Esto generalmente es indicación que hay factores importantes que hay que examinar mas a detalle en los residuales: Reestimación Cuando hacemos este proceso secuencial de llevar el ajuste a los residual, a veces conviene iterarlo. La razón es que en una segunda o tercera pasada podemos hacer mejores estimaciones de cada componente, y es posible suavizar menos sin capturar componentes de más alta frecuencia. Así que podemos regresar a la serie original para hacer mejores estimaciones, más suavizadas: # Quitamos componente anual y efecto de día de la semana datos_dia <- datos_dia |> mutate(n_1 = n - ajuste_2 - ajuste_3) # Reajustamos mod_1 <- loess(n_1 ~ as.numeric(fecha), data = datos_dia, span = 0.02, degree = 2, family = "symmetric") Y ahora repetimos con la componente de día de la semana: Análisis de componentes Ahora comparamos las componentes estimadas y los residuales en una misma gráfica. Por definición, la suma de todas estas componentes da los datos originales. Este último paso nos permite diversas comparaciones que explican la variación que vimos en los datos. Una gran parte de los residuales está entre \\(\\pm 250\\) nacimientos por día. Sin embargo, vemos que las colas tienen una dispersión mucho mayor: quantile(datos_dia$res_6, c(00, .01,0.05, 0.10, 0.90, 0.95, 0.99, 1)) |> round() ## 0% 1% 5% 10% 90% 95% 99% 100% ## -2238 -1134 -315 -202 188 268 516 2521 ¿A qué se deben estas colas tan largas? Viernes 13? Podemos empezar con una curosidad. Los días Viernes o Martes 13, ¿nacen menos niños? Nótese que fue útil agregar el indicador de Semana santa por el Viernes 13 de Semana Santa que se ve como un atípico en el panel de los viernes 13. Residuales: antes y después de 2006 Veamos primero una agregación sobre los años de los residuales. Lo primero es observar un cambio que sucedió repentinamente en 2006: La razón es un cambio en la ley acerca de cuándo pueden entrar los niños a la primaria. Antes era por edad y había poco margen. Ese exceso de nacimientos son reportes falsos para que los niños no tuvieran que esperar un año completo por haber nacido unos cuantos días después de la fecha límite. Otras características que debemos investigar: Efectos de Año Nuevo, Navidad, Septiembre 16 y otros días feriados como Febrero 14. Semana santa: como la fecha cambia, vemos que los residuales negativos tienden a ocurrir dispersos alrededor del día 100 del año. Otros días especiales: más de residuales Ahora promediamos residuales (es posible agregar barras para indicar dispersión a lo largo de los años) para cada día del año. Podemos identificar ahora los residuales más grandes: se deben, por ejemplo, a días feriados, con consecuencias adicionales que tienen en días ajuntos (excesos de nacimientos): Semana santa Para Semana Santa tenemos que hacer unos cálculos. Si alineamos los datos por días antes de Domingo de Pascua, obtenemos un patrón de caída fuerte de nacimientos el Viernes de Semana Santa, y la característica forma de “valle con hombros” en días anteriores y posteriores estos Viernes. ¿Por qué ocurre este patrón? Nótese un defecto de nuestro modelo: el patrón de “hombros” alrededor del Viernes Santo no es suficientemente fuerte para equilibrar los nacimientos faltantes. ¿Cómo podríamos mejorar nuestra descomposición? Referencias "],["tipos-de-estudio-y-experimentos.html", "Sección 2 Tipos de estudio y experimentos Muestreo aleatorio Pero si no podemos hacer muestreo aleatorio? El estimador estándar Experimentos tradicionales Bloqueo Variables desconocidas Aleatorizando el tratamiento Selección de unidades y tratamiento Asignación natural del tratamiento", " Sección 2 Tipos de estudio y experimentos Motivación Pregunta de entrevista de Google (Chihara and Hesterberg 2018) Imagina que eres consultor y te preguntan lo siguiente (ver siguiente figura): Estoy haciendo una comparación de antes y después donde la hipótesis alternativa es pre.media.error > post.media.error. La distribución de ambas muestras es sesgada a la derecha. ¿Qué prueba me recomiendas para ésta situación? Figure 2.1: Error CPR, gráfica de densidad. Far better an approximate answer to the right question, which is often vague, than an exact answer to the wrong question, which can always be made precise. — John Tukey La siguiente imagen Roger Peng representa una situación común a la que se enfrenta el analista de datos, y se desarrolló en el contexto de preguntas vagas. En el esquema hay tres caminos: uno es uno ideal que pocas veces sucede, otro produce respuestas poco útiles pero es fácil, y otro es tortuoso pero que caracteriza el mejor trabajo de análisis de datos: Figure 2.2: Adaptado de R. Peng: Tukey, design thinking and better questions. Ejemplos: Alguien nos pregunta cuáles son las tiendas que mas venden de una cadena. Podríamos consultar bases de datos, hacer extracciones, definir periodos, etc. y reportar el promedio de ventas en el último mes, esta respuesta probablemente es poco útil. Nos damos cuenta, por ejemplo, porque la peor tienda es una que abrió hace relativamente poco, y la mejor es una de las tiendas más grandes que está en una zona de tráfico de alto costo. Una pregunta más interesante es, ¿qué equipos de ventas tienen mejor desempeño? ¿Cuánto aporta tener una cafetería dentro de la tienda en términos de ventas?, etc. Proceso Generador de Datos Entre las preguntas que se debe hacer el analista de datos una fundamental es entender el proceso generador de datos, pues esto determinará que otras preguntas son relevantes, y que análisis son adecuados, tanto en términos prácticos como estadísticos. La inferencia estadística busca hacer afirmaciones, cuantificadas de manera probabilista, acerca de datos que no tenemos, usando regularidades y conocimiento de datos que sí tenemos disponibles y métodos cuantitativos. Para hacer afirmaciones inferenciales eficientes y bien calibradas (con garantías estadísticas de calibración) a preguntas donde queremos generalizar de muestra a población, se requiere conocer con precisión el proceso que genera los datos muestrales. Esto incluye saber con detalle cómo se seleccionaron los datos a partir de los que se quiere hacer inferencia. En este caso, eficiente quiere decir que aprovechamos toda la información que está en los datos observados de manera que nuestros rangos de incertidumbre son lo más chico posibles (además de estar correctamente calibrados). Por su parte, probabilísticamente bien calibrados se refiere a que, lo que decimos que puede ocurrir con 10% de probabilidad ocurre efectivamente 1 de cada 10 veces, si decimos 20% entonces ocurre 2 de 20, etc. Veremos que para muestras dadas naturalmente, a veces es muy difiícil entender a fondo el proceso que generó la muestra y por tanto no tenemos las garantías de eficiencia y calibración. Ejemplo: Prevalencia de anemia Supongamos que nos interesa conocer el porcentaje de menores en edad escolar, (entre 6 y 15 años), con anemia en México. La fuente de datos disponible corresponde a registros del IMSS de hospitalizaciones de menores, ya sea por anemia o por otra causa (infecciones gastrointestinales, apendicitis, tratamiento de leucemia, …), se registró si el menor tenía anemia. En nuestra muestra el 47% de los niños tiene anemia. head(paciente) #> # A tibble: 6 × 4 #> edad padecimiento sexo anemia #> <int> <chr> <chr> <int> #> 1 8 picadura alacrán mujer 0 #> 2 10 infección intestinal hombre 1 #> 3 7 mordedura de perro hombre 1 #> 4 8 asma hombre 1 #> 5 13 infección intestinal mujer 0 #> 6 7 picadura alacrán hombre 0 ¿Qué nos dice esta cantidad acerca de la anemia en la población? ¿Podemos hacer inferencia estadística? ¿Cómo calculamos intervalos de confianza? # Si calculo el error estándar de la p estimada como sigue, es correcto? p <- mean(paciente$anemia) sqrt(p * (1 - p) / 5000) #> [1] 0.007060751 Muestreo aleatorio En la situación ideal diseñaríamos una muestra aleatoria de menores de edad, por ejemplo, utilizando el registro en educación primaria de la SEP, y mediríamos la prevalencia de anemia en la muestra, usaríamos esta muestra para estimar la prevalencia en la población y tendríamos además las herramientas para medir la incertidumbre de nuestra estimación (reportar intervalos, o errores estándar). El elemento clave, es la aleatorización en la selección de la muestra, la idea es distribuir los efecros desconcidos o no controlables que pueden introducir sesgos o variabilidad no conocida en los resultados. Pero si no podemos hacer muestreo aleatorio? En el caso de prevalencia de anemia, discutiendo con médicos e investigadores nos informan que la anemia se presenta en tasas más altas en niños más chicos. paciente |> count(edad) |> mutate(prop = round(100 * n / sum(n))) #> # A tibble: 10 × 3 #> edad n prop #> <int> <int> <dbl> #> 1 6 1001 20 #> 2 7 931 19 #> 3 8 980 20 #> 4 9 445 9 #> 5 10 484 10 #> 6 11 489 10 #> 7 12 246 5 #> 8 13 239 5 #> 9 14 90 2 #> 10 15 95 2 Y consultando con las proyecciones de población notamos que los niños chicos están sobrerepresentados en la muestra. Lo que nos hace considerar que debemos buscar una manera de ponderar nuestras observaciones para que reflejen a la población. Más aún, investigamos que algunas enfermedades están asociadas a mayor prevalencia de anemia: paciente |> count(padecimiento) |> arrange(-n) #> # A tibble: 7 × 2 #> padecimiento n #> <chr> <int> #> 1 infección respiratoria 745 #> 2 mordedura de perro 723 #> 3 úlcera 723 #> 4 asma 713 #> 5 apendcitis 704 #> 6 picadura alacrán 701 #> 7 infección intestinal 691 Utilizamos esta información para modelar y corregir nuestra estimación original. Por ejemplo con modelos de regresión. Sin embargo, debemos preguntarnos: ¿Hay más variables qué nos falta considerar? Ejemplo: Policías y tráfico Supongamos que nos preguntan en cuánto reduce un policía el tráfico en un crucero grande de la ciudad. La cultura popular ha establecido que los policías en cruceros hacen más tráfico porque no saben mover los semáforos. Nosotros decidimos buscar unos datos para entender esto. Escogemos entonces un grupo de cruceros problemáticos, registramos el tráfico cuando visitamos, y si había un policía o no. Después de este esfuerzo, obtenemos los siguientes datos: #> # A tibble: 10 × 2 #> # Groups: policia [2] #> policia tiempo_espera_min #> <int> <dbl> #> 1 0 2.27 #> 2 0 2.65 #> 3 0 3.4 #> 4 0 0.39 #> 5 0 1.1 #> 6 1 10.8 #> 7 1 4.67 #> 8 1 7.77 #> 9 1 6.3 #> 10 1 6.99 Lo que sabemos ahora es que la presencia de un policía es indicador de tráfico alto. El análisis prosiguiría calculando medias y medidas de error (escogimos una muestra aleatoria): Si somos ingenuos, entonces podríamos concluir que los policías efectivamente empeoran la situación cuando manipulan los semáforos, y confirmaríamos la sabiduría popular. Para juzgar este argumento desde el punto de vista causal, nos preguntamos primero: ¿Cuáles son los contrafactuales (los contrafactuales explican que pasaría si hubiéramos hecho otra cosa que la que efectivamente hicimos) de las observaciones? Efectos causales y el esquema de resultados potenciales Consideramos un tratamiento binario: Se manda policía o no se manda policía. Un resultado potencial es aquél que se observaría bajo un tratamiento particular. En cada semáforo, a una hora dada, hay dos resultados potenciales, uno por cada valor del tratamiento: \\(y_1:\\) tiempo de espera si se envía policía. \\(y_0:\\) tiempo de espera si no se envía policía. Para cada semáforo, en el momento de registro, uno observa únicamente uno de los dos resultados potenciales. El resultado no observado se conoce como resultado contrafactual. El estimador estándar A la comparación anterior - la diferencia de medias de tratados y no tratados - le llamamos usualmente el estimador estándar del efecto causal. Muchas veces este es un estimador malo del efecto causal. En nuestro ejemplo, para llegar a la conclusión errónea que confirma la sabiduría popular, hicimos un supuesto importante: En nuestra muestra, los casos con policía actúan como contrafactuales de los casos sin policía. Asi que asumimos que los casos con policía y sin policía son similares, excepto por la existencia o no de policía. En nuestro ejemplo, quizá un analista más astuto nota que tienen categorías históricas de qué tan complicado es cada crucero. Junta a sus datos, y obtiene: #> # A tibble: 10 × 3 #> # Groups: policia [2] #> policia tiempo_espera_min categoria #> <int> <dbl> <fct> #> 1 0 2.27 Fluido #> 2 0 2.65 Fluido #> 3 0 3.4 Típico #> 4 0 0.39 Fluido #> 5 0 1.1 Fluido #> 6 1 10.8 Complicado #> 7 1 4.67 Típico #> 8 1 7.77 Complicado #> 9 1 6.3 Complicado #> 10 1 6.99 Típico El analista argumenta entonces que los policías se enviaron principalmente a cruceros que se consideran Complicados según datos históricos. Esto resta credibilidad a la comparación que hicimos inicialmente: La comparación del estimador estándar no es de peras con peras: estamos comparando qué efecto tienen los policías en cruceros difíciles, con cruceros no difíciles donde no hay policía. La razón de esto es que el proceso generador de los datos incluye el hecho de que no se envían policías a lugares donde no hay tráfico. ¿Cómo producir contrafactuales para hacer la comparación correcta? Experimentos tradicionales Idealmente, quisiéramos observar un mismo crucero en las dos condiciones: con y sin policías. Esto no es posible. En un experimento “tradicional”, como nos lo explicaron en la escuela, nos aproximamos a esto preparando dos condiciones idénticas, y luego alteramos cada una de ellas con nuestra intervención. Si el experimento está bien hecho, esto nos da observaciones en pares, y cada quien tiene su contrafactual. La idea del experimiento tradicional es controlar todos los factores que intervienen en los resultados, y sólo mover el tratamiento para producir los contrafactuales. Más en general, esta estrategia consiste en hacer bloques de condiciones, donde las condiciones son prácticamente idénticas dentro de cada bloque. Comparamos entonces unidades tratadas y no tratadas dentro de cada bloque. Por ejemplo, si queremos saber si el tiempo de caída libre es diferente para un objeto más pesado que otro, prepararíamos dos pesos con el mismo tamaño pero de peso distinto. Soltaríamos los dos al mismo tiempo y compararíamos el tiempo de caída de cada uno. En nuestro caso, como es usual en problemas de negocio o sociales, hacer esto es considerablemente más difícil. No podemos “preparar” cruceros con condiciones idénticas. Sin embargo, podríamos intentar \\(bloquear\\) los cruceros según información que tenemos acerca de ellos, para hacer más comparaciones de peras con peras. Bloqueo Podemos acercanos en lo posible a este ideal de experimentación usando información existente. En lugar de hacer comparaciones directas entre unidades que recibieron el tratamiento y las que no (que pueden ser diferentes en otros aspectos, como vimos arriba), podemos refinar nuestras comparaciones bloquéandolas con variables conocidas. En el ejemplo de los policías, podemos hacer lo siguiente: dentro de cada categoría de cruceros (fluido, típico o complicado), tomaremos una muestra de cruceros, algunos con policía y otros sin. Haremos comparaciones dentro de cada categoría. Obtenemos una muestra con estas características (6 casos en cada categoría de crucero, 3 con policía y 3 sin policía): categoria policia n Fluido 0 3 Fluido 1 3 Típico 0 3 Típico 1 3 Complicado 0 3 Complicado 1 3 Y ahora hacemos comparaciones dentro de cada bloque creado por categoría: #> # A tibble: 3 × 3 #> # Groups: categoria [3] #> categoria `policia =0` `policia =1` #> <fct> <dbl> <dbl> #> 1 Fluido 2.1 0.8 #> 2 Típico 5.6 4.2 #> 3 Complicado 10.4 8.6 Y empezamos a ver otra imagen en estos datos: comparando tipos e cruceros similares, los que tienen policía tienen tiempos de espera ligeramente más cortos. ¿Hemos termniado? ¿Podemos concluir que el efecto de un policía es beneficiosos pero considerablemente chico? ¿Qué problemas puede haber con este análisis? Variables desconocidas El problema con el análisis anterior es que controlamos por una variable que conocemos, pero muchas otras variables pueden estar ligadas con el proceso de selección de cruceros para enviar policías. Por ejemplo, envían o policías a cruceros Típicos solo cuando reportan mucho tráfico. No envían a un polícia a un crucero Complicado si no presenta demasiado tráfico. Existen otras variables desconocidas que los tomadores de decisiones usan para enviar a los policías. En este caso, por ejemplo, los expertos hipotéticos nos señalan que hay algunos cruceros que aunque problemáticos, a veces su tráfico se resuelve rápidamente, mientras que otros tienen tráfico más persistente, y prefieren enviar policías a los de tráfico persistente. La lista de cruceros persistentes están en una hoja de excel que se comparte de manera informal. En resumen, no tenemos conocimiento detallado del proceso generador de datos en cuanto a cómo se asignan los policías a los cruceros. Igual que en la sección anterior, podemos cortar esta complejidad usando aleatorización. Nótese que los expertos no están haciendo nada malo: en su trabajo están haciendo el mejor uso de los recursos que tienen. El problema es que por esa misma razón no podemos saber el resultado de sus esfuerzos, y si hay maneras de optimizar la asignación que hacen actualmente. Aleatorizando el tratamiento Tomamos la decisión entonces de hacer un experimento que incluya aletorización. En un dia particular, escogeremos algunos cruceros. Dicidimos usar solamente cruceros de la categoría Complicada y Típica, pues esos son los más interesantes para hacer intervenciones. Usaremos un poco de código para entener el detalle: en estos datos, tenemos para cada caso los dos posibles resultados hipotéticos \\(y_0\\) y \\(y_1\\) (con policia y sin policia). En el experimento asignamos el tratamiento al azar: muestra_exp <- trafico_tbl |> filter(categoria != "Fluido") |> sample_n(200) |> # asignar tratamiento al azar, esta es nuestra intervención: mutate(tratamiento_policia = rbernoulli(length(y_0), 0.5)) |> # observar resultado mutate(tiempo_espera_exp = ifelse(tratamiento_policia == 1, y_1, y_0)) Nótese la diferencia si tomamos la asignación natural del tratamiento (policía o no): set.seed(134) muestra_natural <- trafico_tbl |> filter(categoria != "Fluido") |> sample_n(200) |> # usamos el tratamiento que se asignó # policia indica si hubo o no policía en ese crucero # observar resultado mutate(tiempo_espera_obs = ifelse(policia == 1, y_1, y_0)) Resumimos nuestros resultados del experimento son: #> # A tibble: 2 × 3 #> # Groups: categoria [2] #> categoria `policia=0` `policia=1` #> <fct> <dbl> <dbl> #> 1 Típico 6.24 4.97 #> 2 Complicado 15.8 8.47 Sin embargo, la muestra natural da: #> # A tibble: 2 × 3 #> # Groups: categoria [2] #> categoria `policia=0` `policia=1` #> <fct> <dbl> <dbl> #> 1 Típico 5.49 4.35 #> 2 Complicado 10.8 8.93 ¿Cuál de los dos análisis da la respuesta correcta a la pregunta: ayudan o no los policías a reducir el tráfico en los cruceros problemáticos? El experimento establece que un policía en promedio reduce a la mitad el tiempo de espera en un crucero complicado Selección de unidades y tratamiento Vimos dos tipos de inferencia que requieren distintos diseños de estudio: a poblaciones (ejemplo anemia) y causal (ejemplo policías). En el escenario ideal de cada uno de estos ejemplos requerimos un mecanismo de aleatorización, sin embargo, la aleatorización requerida en cada caso es distinta y distinguir esto es fundamental para entender las inferencias que podemos hacer en distintos escenarios. Inferencia estadística de acuerdo al tipo del diseño (Ramsey and Schafer (2012)). El cuadro arriba a la izquierda es donde el análisis es más simple y los resultados son más fáciles de interpretar. En este escenario don de la aleatorización es tanto en unidades como en grupos no hacen falta supuestos adicionales para tener las garantías de métodos de inferencia. Es posible hacer análisis fuera de este cuadro, pero el proceso es más complicado, requieren más supuestos, conocimiento del dominio y habilidades de análisis. En general resultan conclusiones menos sólidas. Muchas veces no nos queda otra más que trabajar fuera del cuadro ideal. El punto crucial para entender las medidas de incertidumbre estadística es visualizar de manera hipotética, replicaciones del estudio y las condiciones que llevaron a la selección de la muestra. Esto es, entender el proceso generador de datos e imaginar replicarlo. Ubica los siguientes tipos de análisis: Pruebas clínicas para medicinas Analizar cómo afecta tener seguro médico a los ingresos, usando datos del ENIGH. Estimación de retorno sobre inversión en modelos de marketing mix. Asignación natural del tratamiento Cuando consideramos un sistema donde se “asignan” tratamientos de manera natural, generalmente los tratamientos se asignan bajo un criterio de optimización o conveniencia (por ejemplo los policías a cruceros problemáticos). La cara buena de este hecho es que de alguna forma los resultados están intentando optimizarse, y la gente está haciendo su trabajo. La cara mala de este hecho es que no podemos evaluar de manera simple la efectividad de los tratamientos. Y esto hace difícil optimizar de forma cuantificable los procesos, o entender qué funciona y qué no. Referencias "],["pruebas-de-hipótesis.html", "Sección 3 Pruebas de hipótesis Comparación con poblaciones de referencia Comparando distribuciones Prueba de permutaciones y el lineup Comparaciones usando lineup (continuación) Prueba de permutaciones para proporciones Pruebas de hipótesis tradicionales Tomadores de té (continuación) Pruebas de permutación: implementación. Ejemplo: tiempos de fusión Ejemplo: tiempos de fusión (continuación) Separación de grupos La “crisis de replicabilidad” El jardín de los senderos que se bifurcan Ejemplo: decisiones de análisis y valores p Alternativas o soluciones", " Sección 3 Pruebas de hipótesis Las primeras técnicas inferenciales que veremos intentan contestar la siguiente pregunta: Si observamos cierto patrón en los datos, ¿cómo podemos cuantificar la evidencia de que es un patrón notable y no sólo debido a fluctuaciones en los datos particulares que tenemos? ¿Cómo sabemos que no estamos sobreinterpretando esas fluctuaciones? Por ejemplo: Un sistema tiene cierto comportamiento “usual” para el cual tenemos datos históricos. El sistema presenta fluctuaciones en el tiempo. Observamos la última salida de nuestro sistema. Naturalmente, tiene fluctuaciones. ¿Esas fluctuaciones son consistentes con la operación usual del sistema? ¿Existe evidencia para pensar que algo en el sistema cambió? Comparación con poblaciones de referencia En las prueba de hipótesis, tratamos de construir distribuciones de referencia para comparar resultados que obtengamos con un “estándar” de variación, y juzgar si nuestros resultados son consistentes con la referencia o no (Box et al. 1978). En algunos casos, ese estándar de variación puede construirse con datos históricos. Ejemplo Supongamos que estamos considerando cambios rápidos en una serie de tiempo de alta frecuencia. Hemos observado la serie en su estado “normal” durante un tiempo considerable, y cuando observamos nuevos datos quisiéramos juzgar si hay indicaciones o evidencia en contra de que el sistema sigue funcionando de manera similar. Digamos que monitoreamos ventanas de tiempo de tamaño 20 y necesitamos tomar una decisión. Abajo mostramos cinco ejemplos donde el sistema opera normalmente, que muestra la variabilidad en el tiempo en ventanas cortas del sistema. Ahora suponemos que obtenemos una nueva ventana de datos. ¿Hay evidencia en contra de que el sistema sigue funcionando de manera similar? Nuestra primera inclinación debe ser comparar: en este caso, compararamos ventanas históricas con nuestra nueva serie: # usamos datos simulados para este ejemplo set.seed(8812) historicos <- simular_serie(2000) ¿Vemos algo diferente en los datos nuevos (el panel de color diferente)? Indpendientemente de la respuesta, vemos que hacer este análisis de manera tan simple no es siempre útil: seguramente podemos encontrar maneras en que la nueva muestra (4) es diferente a muestras históricas. Por ejemplo, ninguna de muestras tiene un “forma de montaña” tan clara. Nos preguntamos si no estamos sobreinterpretando variaciones que son parte normal del proceso. Podemos hacer un mejor análisis si extraemos varias muestras del comportamiento usual del sistema, graficamos junto a la nueva muestra, y revolvemos las gráficas para que no sepamos cuál es cuál. Entonces la pregunta es: ¿Podemos detectar donde están los datos nuevos? Esta se llama una prueba de lineup, o una prueba de ronda de sospechosos (Hadley Wickham et al. 2010). En la siguiente gráfica, en uno de los páneles están los datos recientemente observados. ¿Hay algo en los datos que distinga al patrón nuevo? # nuevos datos obs <- simular_serie(500, x_inicial = last(obs$obs)) # muestrear datos históricos prueba_tbl <- muestrear_ventanas(historicos, obs[1:20, ], n_ventana = 20) # gráfica de pequeños múltiplos ggplot(prueba_tbl$lineup, aes(x = t_0, y = obs)) + geom_line() + facet_wrap(~rep, nrow = 4) + scale_y_log10() ¿Cuáles son los datos nuevos (solo hay un panel con los nuevos datos)? ¿Qué implica que la gráfica que escojamos como “más diferente” no sean los datos nuevos? ¿Qué implica que le “atinemos” a la gráfica de los datos nuevos? Ahora observamos al sistema en otro momento y repetimos la comparación. En el siguiente caso obtenemos: Aunque es imposible estar seguros de que ha ocurrido un cambio, la diferencia de una de las series es muy considerable. Si identificamos los datos correctos, la probabilidad de que hayamos señalado la nueva serie “sobreinterpretando” fluctuaciones en un proceso que sigue comportándose normalente es 0.05 - relativamente baja. Detectar los datos diferentes es evidencia en contra de que el sistema sigue funcionando de la misma manera que antes. En el ejemplo anterior se encontraban en la posición: prueba_tbl$pos ## [1] 18 Observaciones y terminología: Llamamos hipótesis nula a la hipótesis de que los nuevos datos son producidos bajo las mismas condiciones que los datos de control o de referencia. Si no escogemos la gráfica de los nuevos datos, nuestra conclusión es que la prueba no aporta evidencia en contra de la hipótesis nula. Si escogemos la gráfica correcta, nuestra conclusión es que la prueba aporta evidencia en contra de la hipótesis nula. ¿Qué tan fuerte es la evidencia, en caso de que descubrimos los datos no nulos? Cuando el número de paneles es más grande y detectamos los datos, la evidencia es más alta en contra de la nula. Decimos que el nivel de significancia de la prueba es la probabilidad de seleccionar a los datos correctos cuando la hipótesis nula es cierta (el sistema no ha cambiado). En el caso de 20 paneles, la significancia es de 1/20 = 0.05. Cuando detectamos los datos nuevos, niveles de significancia más bajos implican más evidencia en contra de la nula. Si acertamos, y la diferencia es más notoria y fue muy fácil detectar la gráfica diferente (pues sus diferencias son más extremas), esto también sugiere más evidencia en contra de la hipótesis nula. Finalmente, esta prueba rara vez (o nunca) nos da seguridad completa acerca de ninguna conclusión, aún cuando hiciéramos muchos páneles. Comparando distribuciones Ahora intentamos un ejemplo más típico. Supongamos que tenemos muestras para tres grupos a, b y c, esto es que dentro de cada grupo, el proceso de selección de los elementos se hace al azar y de manera simétrica (por ejemplo cada elemento tiene a misma probabiidad de ser seleccionado, y las extracciones se hacen de manera independiente.) Queremos comparar las distribuciones de los datos obtenidos para cada grupo. Quizá la pregunta detrás de esta comparación es: el grupo de clientes b recibió una promoción especial. ¿Están gastando más? La medición que comparamos es el gasto de los clientes. En la muestra observamos diferencias entre los grupos. Pero notamos adicionalmente que hay mucha variación dentro de cada grupo. Nos podríamos preguntar entonces si las diferencias que observamos se deben variación muestral, por ejemplo. Podemos construir ahora una hipótesis nula, que establece que las observaciones provienen de una población similar: Las tres poblaciones (a, b, c) son prácticamente indistiguibles. En este caso, la variación que observamos se debería a que tenemos información incompleta. Como en el ejemplo anterior necesitamos construir u obtener una distribución de referencia para comparar qué tan extremos o diferentes son los datos que observamos. Esa distribución de referencia debería estar basada en el supuesto de que los grupos producen datos de distribuciones similares. Si tuvieramos mediciones similares históricas de estos tres grupos, quizá podríamos extraer datos de referencia y comparar, como hicimos en el ejempo anterior. Pero esto es menos común en este tipo de ejemplos. Prueba de permutaciones y el lineup Para abordar este problema podemos pensar en usar permutaciones de los grupos de la siguiente forma ((Box et al. 1978), (Tim C. Hesterberg 2015a)): Si los grupos producen datos bajo procesos idénticos, entonces los grupos a, b, c solo son etiquetas que no contienen información. Podríamos permutar al azar las etiquetas y observar nuevamente la gráfica de caja y brazos por grupos. Si la hipótesis nula es cierta (grupos idénticos), esta es una muestra tan verosímil como la que obtuvimos. Así que podemos construir datos de referencia permutando las etiquetas de los grupos al azar, y observando la variación que ocurre. Si la hipótesis nula es cercana a ser cierta, no deberíamos de poder distinguir fácilmente los datos observados de los producidos con las permutaciones al azar. Vamos a intentar esto, por ejemplo usando una gráfica de cuantiles simplificada. Hacemos un lineup, o una rueda de sospechosos (usamos el paquete (H. Wickham, Chowdhury, and Cook 2012), ver (Hadley Wickham et al. 2010)), donde 19 de los acusados son generados mediante permutaciones al azar de la variable del grupo, y el culpable (los verdaderos datos) están en una posición escogida al azar. ¿Podemos identificar los datos verdaderos? Para evitar sesgarnos, también ocultamos la etiqueta verdadera. Usamos una gráfica que muestra los cuantiles 0.10, 0.50, 0.90: set.seed(88) reps <- lineup(null_permute("grupo"), muestra_tab, n = 20) ## decrypt("M7xA 2S8S Jj dUyJ8JUj ZW") reps_mezcla <- reps |> mutate(grupo_1 = factor(digest::digest2int(grupo) %% 177)) grafica_cuantiles(reps_mezcla, grupo_1, x) + coord_flip() + facet_wrap(~.sample, ncol = 5) + ylab("x") + labs(caption = "Mediana y percentiles 10% y 90%") + geom_point(aes(colour = grupo_1)) Y la pregunta que hacemos es ¿podemos distinguir nuestra muestra entre todas las replicaciones producidas con permutaciones? ¿Dónde están los datos observados? Según tu elección, ¿qué tan diferentes son los datos observados de los datos nulos? En este ejemplo, es difícil indicar cuáles son los datos. Los grupos tienen distribuciones similares y es factible que las diferencias que observamos se deban a variación muestral. Si la persona escoge los verdaderos datos, encontramos evidencia en contra de la hipótesis nula (los tres grupos son equivalentes). En algunos contextos, se dice que los datos son significativamente diferentes al nivel 0.05. Esto es evidencia en contra de que los datos se producen de manera homogénea, independientemente del grupo. Si la persona escoge uno de los datos permutados, no encontramos evidencia en contra de que los tres grupos producen datos con distribuciones similares. Comparaciones usando lineup (continuación) Repetimos el ejemplo para otra muestra (en este ejemplo el proceso generador de datos es diferente para el grupo b): Hacemos primero la prueba del lineup: set.seed(121) reps <- lineup(null_permute("grupo"), muestra_tab, n = 20) grafica_cuantiles(reps |> mutate(grupo_escondido = factor(digest::digest2int(grupo) %% 177)), grupo_escondido, x) + facet_wrap(~.sample) + ylab("x") + coord_flip() + geom_point(aes(colour = grupo_escondido)) Podemos distinguir más o menos claramente que está localizada en valores más altos y tiene mayor dispersión. En este caso, como en general podemos identificar los datos, obtenemos evidencia en contra de que los tres grupos tienen distribuciones iguales. Estos ejemplos siguen la idea de inferencia visual propuestas en (Hadley Wickham et al. 2010), (Hofmann et al. 2012) son pruebas muy flexibles y estadísticamente rigurosas. Prueba de permutaciones para proporciones Veremos otro ejemplo donde podemos hacer más concreta la idea de distribución nula o de referencia usando pruebas de permutaciones. Supongamos que con nuestra muestra de tomadores de té, queremos probar la siguiente hipótesis nula: Los tomadores de té en bolsas exclusivamente, usan azúcar a tasas simillares que los tomadores de té suelto (que pueden o no también tomar té en bolsita). Los datos que obtuvimos en nuestra encuesta, en conteos, son: sugar bolsa_exclusivo suelto o bolsa No.sugar 81 74 sugar 89 56 Y en proporciones tenemos que: how prop_azucar n bolsa_exclusivo 0.52 170 suelto o bolsa 0.43 130 Pero distintas muestras podrían haber dado distintos resultados. Nos preguntamos qué tan fuerte es la evidencia en contra de que en realidad los dos grupos de personas usan azúcar en proporciones similares, y la diferencia que vemos se puede atribuir a variación muestral. En este ejemplo, podemos usar una estadística de prueba numérica, por ejemplo, la diferencia entre las dos proporciones: \\[\\hat p_1 - \\hat p_2,\\] (tomadores de té en bolsa solamente vs. suelto y bolsa). El proceso sería entonces: La hipótesis nula es que los dos grupos tienen distribuciones iguales. Este caso quiere decir que en la población, tomadores de té solo en bolsa usan azúcar a las mismas tasas que tomadores de suelto o bolsas. Bajo nuestra hipótesis nula (proporciones iguales), producimos una cantidad grande (por ejemplo 10 mil o más) de muestras permutando las etiquetas de los grupos. Evaluamos nuestra estadística de prueba en cada una de las muestras permutadas. El conjunto de valores obtenidos nos da nuestra distribución de referencia (ya no estamos limitados a 20 replicaciones como en las pruebas gráficas). Y la pregunta clave es: ¿el valor de la estadística en nuestra muestra es extrema en comparación a la distribución de referencia? dif_obs <- te_azucar |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(how) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = how, values_from = prop_azucar) |> mutate(diferencia_prop = bolsa_exclusivo - `suelto o bolsa`) |> pull(diferencia_prop) La diferencia observada es: dif_obs |> round(3) ## [1] 0.093 Ahora construimos nuestra distribución nula o de referencia: reps <- lineup(null_permute("how"), te_azucar, n = 50000) glimpse(reps) ## Rows: 15,000,000 ## Columns: 3 ## $ how <chr> "bolsa_exclusivo", "bolsa_exclusivo", "suelto o bolsa", "suelt… ## $ sugar <chr> "sugar", "No.sugar", "No.sugar", "sugar", "No.sugar", "No.suga… ## $ .sample <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,… valores_ref <- reps |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(.sample, how) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = how, values_from = prop_azucar) |> mutate(diferencia = bolsa_exclusivo - `suelto o bolsa`) Y graficamos nuestros resultados (con un histograma y una gráfica de cuantiles, por ejemplo). la estadística evaluada un cada una de nuestras muestras permutadas: g_1 <- ggplot(valores_ref, aes(sample = diferencia)) + geom_qq(distribution = stats::qunif) + xlab("f") + ylab("diferencia") + labs(subtitle = "Distribución nula o de referencia") g_2 <- ggplot(valores_ref, aes(x = diferencia)) + geom_histogram(binwidth = 0.04) + coord_flip() + xlab("") + labs(subtitle = " ") g_1 + g_2 Este es el rango de fluctuación usual para nuestra estadística bajo la hipótesis de que los dos grupos de tomadores de té consumen té a la misma tasa. El valor que obtuvimos en nuestros datos es: 0.09. Mismo que no es un valor extremo en la distribución de referencia que vimos arriba. Ésta muestra no aporta mucha evidencia en contra de que los grupos tienen distribuciones similares. Podemos graficar otra vez marcando el valor observado: # Función de distribución acumulada (inverso de función de cuantiles) dist_perm <- ecdf(valores_ref$diferencia) # Calculamos el percentil del valor observado percentil_obs <- dist_perm(dif_obs) g_1 <- ggplot(valores_ref, aes(sample = diferencia)) + geom_qq(distribution = stats::qunif) + xlab("f") + ylab("diferencia") + labs(subtitle = "Distribución nula o de referencia") + geom_hline(yintercept = dif_obs, colour = "red") + annotate("text", x = 0.35, y = dif_obs - 0.03, label = "diferencia observada", colour = "red") g_2 <- ggplot(valores_ref, aes(x = diferencia)) + geom_histogram(binwidth = 0.04) + coord_flip() + xlab("") + labs(subtitle = " ") + geom_vline(xintercept = dif_obs, colour = "red") + annotate("text", x = dif_obs, y = N_rep * .3, label = percentil_obs,vjust = -0.2, colour = "red") g_1 + g_2 Y vemos que es un valor algo (pero no muy) extremo en la distribución de referencia que vimos arriba: esta muestra no aporta una gran cantidad de evidencia en contra de que los grupos tienen distribuciones similares, que en este caso significa que los dos grupos usan azúcar a tasas similares. Es decir, sobre la hipótesis \\[H_0: p_1 = p_2,\\] o bien, \\[H_0: p_1 - p_2 = 0.\\] Pruebas de hipótesis tradicionales Comencemos recordando la definición de parámetro y estadística. Definición. Un parámetro es una característica (numérica) de una población o de una distribución de probabilidad. Usualmente denotado por \\(\\theta \\in \\mathbb{R},\\) o por \\(\\theta \\in \\mathbb{R}^p.\\) Una estadística es una característica (numérica) de los datos. Usualmente denotado por \\(\\hat \\theta.\\) Cualquier función de un parámetro es también un parámetro \\(\\varphi = h(\\theta),\\) y cualquier función de una estadística es también una estadística \\(\\hat \\varphi = h(\\hat \\theta).\\) Cuando la estadística se calcula de una muestra aleatoria (\\(T(X),\\) para \\(X_i \\sim \\pi_x\\) para \\(i = 1, \\ldots, n\\)), es por consiguiente aleatoria y es por tanto una variable aleatoria (\\(T \\sim \\pi_T\\)). Por ejemplo \\(\\mu\\) y \\(\\sigma\\) son parámetros de la distribución normal con función de densidad \\(\\pi(x) = (1/\\sqrt{2\\pi}\\sigma)e^{(x-\\mu)^2/(2\\sigma^2)}\\). La varianza \\(\\sigma^2\\), y el coeficiente de variación (cociente de señal a ruido) \\(\\mu/\\sigma\\) también son parámetros. Si \\(X_1, \\ldots ,X_n\\) son una muestra aleatoria, entonces la media \\(\\bar{X}=\\frac1n\\sum_i X_i\\) es una estadística. Ahora podemos pasar a las definiciones correspondientes a pruebas de hipótesis (o pruebas de significancia). Definición. Denotamos por \\(H_0\\) a la hipótesis nula la cual usualmente tratamos como la afirmación del status quo. La hipótesis alternativa la denotamos por \\(H_1\\) y representa el supuesto que está a prueba y para el cual buscamos evidencia en los datos. Definición. La hipótesis normalmente se plantea en términos de un parámetro (\\(\\theta\\in\\mathbb{R}\\)) o conjunto de parámetros (\\(\\theta\\in\\mathbb{R}^p\\)) de la distribución de interés (por ejemplo media, moda, varianza). Para una hipótesis nula del estilo \\(H_0: \\theta = \\theta_0,\\) la hipótesis a contrastar se puede denominar como: Hipótesis alternativa de una cola \\(H_1: \\theta \\gt \\theta_0\\) Hipótesis alternativa de dos colas \\(H_1: \\theta \\neq \\theta_0\\) En el ejemplo anterior planteamos hipótesis nula (proporciones iguales) e hipótesis alternativa que la proporción de tomadores de te suelto que usan azúcar en menor proporción, esto corresponde a una hipótesis alternativa a dos colas: \\(H_0: p_1 = p_2\\), y \\(H_1:p_1 > p_2\\). Definición. Una estadística de prueba es una función numérica de los datos cuyo valor determina el resultado de la prueba. La función usualmente es denotada por \\(T(\\bf X)\\) donde \\(\\bf X\\) representa los datos como variable aleatoria. Por ejemplo, \\(T = T(X_1, \\ldots, X_n)\\) si sólo tenemos una muestra, o por \\(T = T(X_1, \\ldots, X_n, Y_1, \\ldots, Y_m)\\) en el caso de tener dos muestras. Al evaluar la prueba para un conjunto de datos dado, \\(x\\), ésta se denomina estadística de prueba observada, \\(t = T(x).\\) La estadística de prueba correspondiente al ejemplo es \\(T = \\hat p_1 - \\hat p_2.\\) Definición. El valor p es la probabilidad de que bajo la hipótesis nula los datos generen un valor tan extremo como la estadística de prueba observada. Por ejemplo, si consideramos la hipótesis nula admite valores grandes, el valor p se calcula como \\(P(T \\geq t).\\) En el ejemplo de tomadores de té: el valor p lo calculamos usando el percentil donde nuestra observación cae en la distribución generada por las permutación (valor p de una cola). 1 - dist_perm(dif_obs) ## [1] 0.04344 Por otro lado, podemos calcular: Valor p de dos colas: Si la hipótesis nula es cierta, ¿cuál es la probabilidad de observar una diferencia tan extrema o más extrema de lo que observamos? Considerando este caso interpretamos extrema como qué tan lejos cae del centro de masa de la distribución. De tal forma que podemos calcular el valor p como sigue. A partir del valor observado, consideramos cuál dato es menor: la probabilidad bajo lo hipótesis nula de observar una diferencia mayor de la que observamos, o la probabilidad de observar una diferencia menor a la que observamos. Tomamos el mínimo y multiplicamos por dos (Tim C. Hesterberg 2015a): 2 * min(dist_perm(dif_obs), (1 - dist_perm(dif_obs))) ## [1] 0.08688 Este valor p se considera como evidencia moderada en contra de la hipótesis nula. Valores p chicos (observaciones más extremas en comparación con la referencia) aportan más evidencia en contra de la hipótesis nula, y valores más grandes aportan menos evidencia en contra. Definición. Un resultado es estadisticamente significativo si tiene muy baja probabilidad de suceder al azar. Entre más pequeño requiramos un valor p oara declarar un resultado estadísticamente significativo, somos más conservadores. Las pruebas de hipótesis con frecuencia inician contestando una pregunta más general que los valores p: ¿Cuál es la distribución de la estadística de prueba cuando no hay un efecto real? Definición. La distribución nula es la distribución de la estadística de prueba si la hipótesis nula es cierta. En ocasiones también nos referimos a ella como la distribución de referencia pues estamos comparando la estadística de prueba observada a su referencia para determinar que tan inusual es. En el ejemplo de tomadores de té aproximamos la distribución nula (y los valores p) con simulación; sin embargo, para algunas estadísticas hay métodos exactos. En particular, usamos el método de pruebas de permutación. Para dicha prueba el algoritmo para en el caso de dos grupos sería como sigue: Prueba de permutación para dos muestras Supongamos que tenemos m observaciones de una población y n de otra. Combina los m+n valores. Repite: Obtén un remuestra de tamaño m sin reemplazo del total. Usa las n observaciones restantes para obtener la otra muestra. Calcula la estadística de prueba (que compara las muestras). Calcula el valor p como la fracción de las veces que la estadística sobrepasó la estadística observada, multiplica por 2 para una prueba de dos lados. La distribución de la estadística a lo largo de las remuestras de permutación es la distribución de permutación. Ésta puede ser exacta, si se calcula exhaustivamente (como cuando tenemos pocas observaciones) o aproximada (cuando enlistar todas las posible combinaciones es prohibitivo). Tomadores de té (continuación) Ahora hacemos una prueba de permutaciones para otro par de proporciones utilizando el mismo método. La hipótesis nula ahora es: Los tomadores de té Earl Gray usan azúcar a una tasa similar a los tomadores de té negro. Los datos que obtuvimos en nuestra encuesta se muestran en la siguiente tabla: sugar Earl Grey black No.sugar 84 51 sugar 109 23 Y en porcentajes tenemos que: prop_azucar <- te_azucar |> count(Tea, sugar) |> group_by(Tea) |> mutate(prop = 100 * n / sum(n), n = sum(n)) |> filter(sugar == "sugar") |> select(Tea, prop_azucar = prop, n) |> mutate('% usa azúcar' = round(prop_azucar)) |> select(-prop_azucar) prop_azucar |> formatear_tabla() Tea n % usa azúcar Earl Grey 193 56 black 74 31 Pero distintas muestras podrían haber dado distintos resultados. Nos preguntamos qué tan fuerte es la evidencia en contra de que en realidad los dos grupos de personas usan azúcar en proporciones similares considerando que la diferencia que vemos se puede atribuir a variación muestral. Escribimos la función que calcula diferencias para cada muestra: calc_diferencia_2 <- function(datos){ datos |> mutate(usa_azucar = as.numeric(sugar == "sugar")) |> group_by(Tea) |> summarise(prop_azucar = mean(usa_azucar), .groups = 'drop') |> pivot_wider(names_from = Tea, values_from = prop_azucar) |> mutate(diferencia_prop = `Earl Grey` - black) |> pull(diferencia_prop) } La diferencia observada es: ## [1] 0.254 Ahora construimos nuestra distribución nula o de referencia: set.seed(2) reps <- lineup(null_permute("Tea"), te_azucar, n = N_rep) valores_ref <- reps |> group_by(.sample) |> nest() |> mutate(diferencia = lapply(data, calc_diferencia_2)) |> unnest(diferencia) Y podemos graficar la distribución de referencia otra vez marcando el valor observado En este caso, la evidencia es muy fuerte en contra de la hipótesis nula, pues el resultado que obtuvimos es muy extremo en relación a la distribución de referencia. El valor p es cercano a 0. Haz una prueba de permutaciones para diferencia de medias para comparar la propina en cena vs en comidas. Grafica la distribución de referencia. Calcula el valor p (dos colas). Pruebas de permutación: implementación. Hasta ahora nos hemos centrado en ejemplos de diferencias en medias. Podemos extender las pruebas de permutación a \\(\\bar{X}\\) (la media de la primera muestra), \\(n\\bar{X}\\) (la suma de las observaciones en la primera muestra), y más. Teorema. En pruebas de permutación, si dos estadísticas de prueba \\(T_1\\) y \\(T_2\\) están relacionadas por una función estríctamente monótona, \\(T_1(X^*)=f(T_2(X^*))\\) donde \\(X^*\\) es una remuestra de permutación de los datos originales, entonces los valores p serán los mismos en las pruebas de permutación. Muestras con reemplazo de la Distribución Nula. En la implementación de muestreo, no nos aseguramos que las remuestras sean únicas. Sería más acertado tomar muestras sin reemplazo, sin embargo, el costo computacional es demasiado alto. Por simplicidad consideramos muestras con reemplazo del total de \\[m+n\\choose n\\] posibles remuestras. Por lo tanto, al remuestrar obtenemos una muestra de la distribución nula. Entre más muestras, más exactitud. Hemos usado \\(B = 10^3\\) remuestras (N_rep en el código), en general entre más remuestras tendremos una mejor estimación del valor p. Si el verdadero valor es \\(p\\) el estimado tendrá una varianza aproximadamente de \\(p(1- p)/B\\) donde \\(B\\) es el número de remuestras generadas. Observación. Así como los \\(n\\) datos originales son una muestra de la población, también las \\(B\\) remuestras de la estadística son una muestra de una población, en este caso de la distribución nula. La pruebas de permutaciones son más útiles cuando nuestra hipótesis nula se refiere que la distribución de los grupos son muy similares, o la independencia entre observaciones y grupo. Esto también aplica cuando queremos probar por ejemplo, que una variable numérica \\(Y\\) es independiente de \\(X.\\) Hay algunas hipótesis que no se pueden probar con este método, como por ejemplo, las que se refieren a una sola muestra: ¿los datos son consistentes con que su media es igual a 5? Adicionalmente, en algunas ocasiones queremos probar aspectos más específicos de las diferencias: como ¿son iguales las medias o medianas de dos grupos de datos? ¿Tienen dispersión similar? Es común aplicar pruebas de permutaciones a este segundo problema, sin embargo, no están tan perfectamente adaptadas a el, pues prueban todos los aspectos de las distribuciones que se comparan, aún cuando escojamos una estadística particular que pretende medir. Por ejemplo, cuando trabajamos con la diferencia de medias. Eso quiere decir que podemos rechazar igualdad de medias, por ejemplo, cuando en realidad otra característica de las distribuciones es la que difiere mucho en las poblaciones. En algunas referencias (ver (Chihara and Hesterberg 2018), (Efron and Tibshirani 1993)) se argumenta que de todas formas las pruebas de permutaciones son relativamente robustas a esta desadaptación. Un caso excepcional, por ejemplo, es cuando las poblaciones que comparamos resultan tener dispersión extremadamente distinta, y adicionalmente los tamaños de muestra de los grupos son muy desiguales (otra vez, ver ejemplos en (Chihara and Hesterberg 2018)). Ejemplo: tiempos de fusión Veamos el siguiente ejemplo, que es un experimento donde se midió el tiempo que tardan distintas personas en fusionar un estereograma para ver una imagen 3D. (William S. Cleveland (1993)). Existen dos condiciones: en una se dio indicaciones de qué figura tenían que buscar (VV) y en otra no se dio esa indicación. ¿Las instrucciones verbales ayudan a fusionar más rápido el estereograma? ## ## ── Column specification ──────────────────────────────────────────────────────── ## cols( ## n = col_double(), ## time = col_double(), ## nv.vv = col_character() ## ) La situación es la siguiente: considerando que hay mucha variación en el tiempo de fusión dentro de cada tratamiento, necesitamos calificar la evidencia de nuestra conclusión (el tiempo de fusión se reduce con información verbal). Podemos usar una prueba de permutaciones, esta vez justificándola por el hecho de que los tratamientos se asignan al azar: si los tratamientos son indistinguibles, entonces las etiquetas de los grupos son sólo etiquetas, y permutarlas daría muestras igualmente verosímiles. En este caso, compararemos gráficas de cuantiles de los datos con los producidos por permutaciones (transformamos los datos pues en este caso es más apropiado una comparación multiplicativa): ¿Podemos identificar los datos? En general, muy frecuentemente las personas identifican los datos correctamente, lo que muestra evidencia considerable de que la instrucción verbal altera los tiempos de respuesta de los partipantes, y en este caso ayuda a reducir el tiempo de fusión de los estereogramas. Ejemplo: tiempos de fusión (continuación) Podemos usar las pruebas de permutaciones para distintos tipos de estadísticas: medianas, medias, comparar dispersión usando rangos intercuartiles o varianzas, etc. Regresamos a los tiempos de fusión. Podemos hacer una prueba de permutaciones para la diferencia de las medias o medianas, por ejemplo. En este ejemplo usaremos una medida de centralidad un poco diferente, como ilustración: el promedio de los cuartiles superior e inferior de las dos distribuciones. Usaremos el cociente de estas dos cantidades para medir su diferencia # esta función hace permutaciones y calcula la diferencia para cada una permutaciones_est <- function(datos, variable, calc_diferencia, n = 1000){ # calcular estadística para cada grupo permutar <- function(variable){ sample(variable, length(variable)) } tbl_perms <- tibble(.sample = seq(1, n-1, 1)) |> mutate(diferencia = map_dbl(.sample, ~ datos |> mutate({{variable}}:= permutar({{variable}})) |> calc_diferencia())) bind_rows(tbl_perms, tibble(.sample = n, diferencia = calc_diferencia(datos))) } stat_fusion <- function(x){ (quantile(x, 0.75) + quantile(x, 0.25))/2 } calc_fusion <- function(stat_fusion){ fun <- function(datos){ datos |> group_by(nv.vv) |> summarise(est = stat_fusion(time), .groups = 'drop') |> pivot_wider(names_from = nv.vv, values_from = est) |> mutate(dif = VV / NV ) |> pull(dif) } fun } calc_cociente <- calc_fusion(stat_fusion) dif_obs <- calc_cociente(fusion) # permutar valores_ref <- permutaciones_est(fusion, nv.vv, calc_cociente, n = N_rep) dist_perm_nv <- ecdf(valores_ref$diferencia) cuantil_obs <- dist_perm_nv(dif_obs) Y el valor p de dos colas es dist_perm_nv <- ecdf(valores_ref$diferencia) 2 * min(dist_perm_nv(dif_obs), 1 - dist_perm_nv(dif_obs)) ## [1] 0.028 Lo que muestra evidencia considerable, aunque no muy fuerte, de que la instrucción verbal ayuda a reducir el tiempo de fusión de los estereogramas: la caja del diagrama de caja y brazos para el grupo VV está encogida por un factor menor a 1. Separación de grupos Este ejemplo tomado de (Chowdhury et al. 2015) (tanto la idea como el código). La pregunta que se aborda en ese estudio es: Existen métodos de clasificación (supervisados o no supervisados) para formar grupos en términos de variables que describen a los individuos Estos métodos (análisis discriminante, o k-means, por ejemplo), pretenden formar grupos compactos, bien separados entre ellos. Cuando aplicamos el método, obtenemos clasificadores basados en las variables de entrada. La pregunta es: ¿los grupos resultantes son producto de patrones que se generalizan a la población, o capitalizaron en variación aleatoria para formarse? Especialmente cuando tenemos muchas mediciones de los individuos, y una muestra relativamente chica, Es relativamente fácil encontrar combinaciones de variables que separan los grupos, aunque estas combinaciones y diferencias están basadas en ruido y no generalizan a la población. Como muestran en (Chowdhury et al. 2015), el lineup es útil para juzgar si tenemos evidencia en contra de que los grupos en realidad son iguales, y usamos variación muestral para separarlos. Avispas (opcional) En el siguiente ejemplo, tenemos 4 grupos de avispas (50 individuos en total), y para cada individuo se miden expresiones de 42 genes distintos. La pregunta es: ¿Podemos separar a los grupos de avispas dependiendo de sus mediciones? En este se usó análisis discriminante (LDA) para buscar proyecciones de los datos en dimensión baja de forma que los grupos sean lo más compactos y separados posibles. Para probar qué tan bien funciona este método, podemos hacer una prueba de permutación, aplicamos LDA y observamos los resultados. Y vemos que incluso permutando los grupos, es generalmente posible separarlos en grupos bien definidos: la búsqueda es suficientemente agresiva para encontrar combinaciones lineales que los separan. Que no podamos distinguir los datos verdaderos de las replicaciones nulas indica que este método difícilmente puede servir para separar los grupos claramente. Otro enfoque sería separar los datos en una muestra de entrenamiento y una de prueba (que discutiremos en la última sesión). Aplicamos el procedimiento a la muestra de entrenamiento y luego vemos qué pasa con los datos de prueba: set.seed(8) wasps_1 <- wasps |> mutate(u = runif(nrow(wasps), 0, 1)) wasps_entrena <- wasps_1 |> filter(u <= 0.8) wasps_prueba <- wasps_1 |> filter(u > 0.8) wasp.lda <- MASS::lda(Group ~ ., data=wasps_entrena[,-1]) wasp_ld_entrena <- predict(wasp.lda, dimen=2)$x |> as_tibble(.name_repair = "universal") |> mutate(tipo = "entrenamiento") |> mutate(grupo = wasps_entrena$Group) wasp_ld_prueba <- predict(wasp.lda, newdata = wasps_prueba, dimen=2)$x |> as_tibble(.name_repair = "universal") |> mutate(tipo = "prueba")|> mutate(grupo = wasps_prueba$Group) wasp_lda <- bind_rows(wasp_ld_entrena, wasp_ld_prueba) ggplot(wasp_lda, aes(x = LD1, y = LD2, colour = grupo)) + geom_point(size = 3) + facet_wrap(~tipo) Aunque esta separación de datos es menos efectiva en este ejemplo por la muestra chica, podemos ver que la separación lograda en los datos de entrenamiento probablemente se debe a variación muestral. La “crisis de replicabilidad” Recientemente (Ioannidis 2005) se ha reconocido en campos como la psicología la crisis de replicabilidad. Varios estudios que recibieron mucha publicidad inicialmente no han podido ser replicados posteriormente por otros investigadores. Por ejemplo: Hacer poses poderosas produce cambios fisiológicos que mejoran nuestro desempeño en ciertas tareas. Mostrar palabras relacionadas con “viejo” hacen que las personas caminen más lento (efectos de priming). En todos estos casos, el argumento de la evidencia de estos efectos fue respaldada por una prueba de hipótesis nula con un valor p menor a 0.05. La razón es que ese es el estándar de publicación seguido por varias áreas y revistas arbitradas. La tasa de no replicabilidad parece ser mucho más alta (al menos la mitad o más, según algunas fuentes como la señalada arriba) que la sugerida por la tasa de falsos positivos (menos de 5%). Este problema de replicabilidad parece ser más frecuente cuando: Se trata de estudios de potencia baja: mediciones ruidosas y tamaños de muestra chicos. El plan de análisis no está claramente definido desde un principio (lo cual es difícil cuando se están investigando “fenómenos no estudiados antes”). ¿A qué se atribuye esta crisis de replicabilidad? El jardín de los senderos que se bifurcan Aunque haya algunos ejemplos de manipulaciones conscientes —e incluso, en menos casos, malintencionadas— para obtener resultados publicables o significativos (p-hacking), como vimos en ejemplos anteriores, hay varias decisiones, todas razonables, que podemos tomar cuando estamos buscando las comparaciones correctas. Algunas pueden ser: Transformar los datos (tomar o no logaritmos, u otra transformación). Editar datos atípicos (razonable si los equipos pueden fallar, o hay errores de captura, por ejemplo). Distintas maneras de interpretar los criterios de inclusión de un estudio (por ejemplo, algunos participantes mostraron tener gripa, o revelaron que durmieron muy poco la noche anterior, etc. ¿los dejamos o los quitamos?). Dado un conjunto de datos, las justificaciones de las decisiones que se toman en cada paso son razonables, pero con datos distintos las decisiones podrían ser diferentes. Este es el jardín de los senderos que se bifurcan (ver referencia en Gelman), que invalida en parte el uso valores p como criterio de evidencia contra la hipótesis nula. Esto es exacerbado por: Tamaños de muestra chicos y efectos “inestables” que se quieren medir (por ejemplo en psicología). El hecho de que el criterio de publicación es obtener un valor \\(p < 0.05\\), y la presión fuerte sobre los investigadores para producir resultados publicables (\\(p < 0.05\\)). El que estudios o resultados similares que no obtuvieron valores \\(p\\) por debajo del umbral no son publicados o reportados. Ver por ejemplo el comunicado de la ASA. Ojo: esas presiones de publicación no sólo ocurre para investigadores en psicología. Cuando trabajamos en problemas de análisis de datos que son de importancia, es común que existan intereses de algunas partes o personas involucradas por algunos resultados u otros (por ejemplo, nuestros clientes de consultoría o clientes internos). Eso puede dañar nuestro trabajo como analistas, y el avance de nuestro equipo. Aunque esas presiones son inevitables, se vuelven manejables cuando hay una relación de confianza entre las partes involucradas. Ejemplo: decisiones de análisis y valores p En el ejemplo de datos de fusión, decidimos probar, por ejemplo, el promedio de los cuartiles inferior y superior, lo cual no es una decisión típica pero usamos como ilustración. Ahora intentamos usar distintas mediciones de la diferencia entre los grupos, usando distintas medidas resumen y transformaciones (por ejemplo, con o sin logaritmo). Aquí hay unas 12 combinaciones distintas para hacer el análisis (multiplicadas por criterios de “aceptación de datos en la muestra”, que simulamos tomando una submuestra al azar): calc_fusion <- function(stat_fusion, trans, comparacion){ fun <- function(datos){ datos |> group_by(nv.vv) |> summarise(est = stat_fusion({{ trans }}(time)), .groups = 'drop') |> pivot_wider(names_from = nv.vv, values_from = est) |> mutate(dif = {{ comparacion }}) |> pull(dif) } fun } valor_p <- function(datos, variable, calc_diferencia, n = 1000){ # calcular estadística para cada grupo permutar <- function(variable){ sample(variable, length(variable)) } tbl_perms <- tibble(.sample = seq(1, n-1, 1)) |> mutate(diferencia = map_dbl(.sample, ~ datos |> mutate({{variable}} := permutar({{variable}})) |> calc_diferencia())) perms <- bind_rows(tbl_perms, tibble(.sample = n, diferencia = calc_diferencia(datos))) perms_ecdf <- ecdf(perms$diferencia) dif <- calc_diferencia(datos) 2 * min(perms_ecdf(dif), 1- perms_ecdf(dif)) } set.seed(7272) media_cuartiles <- function(x){ (quantile(x, 0.75) + quantile(x, 0.25))/2 } # nota: usar n=10000 o más, esto solo es para demostración: ejemplo <- list() calc_dif <- calc_fusion(mean, identity, VV - NV) ejemplo$media_dif <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(mean, log, VV - NV) ejemplo$media_dif_log <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(median, identity, VV / NV) ejemplo$mediana_razon <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) calc_dif <- calc_fusion(media_cuartiles, identity, VV / NV) ejemplo$cuartiles_razon <- valor_p(fusion |> sample_frac(0.95), nv.vv, calc_dif, n = N_rep) ejemplo <- read_rds("cache/ejemplo_p_val.rds") ejemplo$media_dif ## [1] 0.0658 ejemplo$media_dif_log ## [1] 0.018 ejemplo$mediana_razon ## [1] 0.049 ejemplo$cuartiles_razon ## [1] 0.0464 Si existen grados de libertad —muchas veces necesarios para hacer un análisis exitoso—, entonces los valores p pueden tener poco significado. Alternativas o soluciones El primer punto importante es reconocer que la mayor parte de nuestro trabajo es exploratorio (recordemos el proceso complicado del análisis de datos de refinamiento de preguntas). En este tipo de trabajo, reportar valores p puede tener poco sentido, y mucho menos tiene sentido aceptar algo verdadero cuando pasa un umbral de significancia dado. Nuestro interés principal al hacer análisis es: expresar correctamente, y de manera útil, la incertidumbre asociada a las conclusiones o patrones que mostramos (asociada a variación muestral, por ejemplo) con el objetivo que el proceso de toma de decisiones sea informado. Un resumen de un número (valor p, o el que sea) no puede ser tomado como criterio para tomar una decisión que generalmente es compleja. En la siguiente sección veremos cómo podemos mostrar parte de esa incertidumbre de manera más útil. Por otra parte, los estudios confirmatorios (donde se reportan valores p) también tienen un lugar. En áreas como la psicología, existen ahora movimientos fuertes en favor de la repetición de estudios prometedores pero donde hay sospecha de grados de libertad del investigador. Este movimiento sugiere dar valor a los estudios exploratorios que no reportan valor p, y posteriormente, si el estudio es de interés, puede intentarse una replicación confirmatoria, con potencia más alta y con planes de análisis predefinidos. Referencias "],["estimación-y-distribución-de-muestreo-1.html", "Sección 4 Estimación y distribución de muestreo Ejemplo: precios de casas Distribución de muestreo Más ejemplos El error estándar Calculando la distribución de muestreo Teorema central del límite Normalidad y gráficas de cuantiles normales Prueba de hipótesis de normalidad Ejemplo Más del Teorema central del límite", " Sección 4 Estimación y distribución de muestreo En esta sección discutiremos cuál el objetivo general del proceso de estimación, y cómo entender y manejar la variabilidad que se produce cuando aleatorizamos la selección de las muestras que utilizamos para hacer análisis. A diferencia de las pruebas de permutación, donde evaluábamos como cambiaría una estadísitica si un tratamiento o grupo se hubiera asignado de forma distinta, en la siguiente sección nos preguntamos como varía una estadística entre muestras. Por ejemplo, pasaremos de preguntar si una vacuna reduce el riesgo de una enfermedad a evaluar en que magnitud se reduce el riesgo de contraer la enfermedad. Ejemplo: precios de casas Supongamos que queremos conocer el valor total de las casas que se vendieron recientemente en una zona particular. Supondremos que tenemos un listado de las casas que se han vendido recientemente, pero en ese listado no se encuentra el precio de venta. Decidimos entonces tomar una muestra aleatoria de 100 de esas casas. Para esas casas hacemos trabajo de campo para averiguar el precio de venta. marco_casas <- read_csv("data/casas.csv") set.seed(841) muestra_casas <- sample_n(marco_casas, 100) |> select(id, nombre_zona, area_habitable_sup_m2, precio_miles) sprintf("Hay %0.0f casas en total, tomamos muestra de %0.0f", nrow(marco_casas), nrow(muestra_casas)) ## [1] "Hay 1144 casas en total, tomamos muestra de 100" head(muestra_casas) ## # A tibble: 6 × 4 ## id nombre_zona area_habitable_sup_m2 precio_miles ## <dbl> <chr> <dbl> <dbl> ## 1 287 NAmes 161. 159 ## 2 755 NAmes 95.3 156 ## 3 1190 Gilbert 168. 189 ## 4 36 NridgHt 228. 309 ## 5 32 Sawyer 114. 149. ## 6 538 NAmes 80.3 111. Como tomamos una muestra aleatoria, intentamos estimar el valor total de las casas que se vendieron expandiendo el total muestral, es decir nuestro estimador \\(\\hat{t} = t(X_1,\\ldots X_{100})\\) del total poblacional \\(t\\) es \\[\\hat{t} = \\frac{N}{n} \\sum_{i=1}^{100} X_i = N\\bar{x}\\] Esta función implementa el estimador: n <- nrow(muestra_casas) # tamaño muestra N <- nrow(marco_casas) # tamaño población estimar_total <- function(muestra_casas, N){ total_muestral <- sum(muestra_casas$precio_miles) n <- nrow(muestra_casas) # cada unidad de la muestra representa a N/n f_exp <- N / n # estimador total es la expansión del total muestral estimador_total <- f_exp * total_muestral res <- tibble(total_muestra = total_muestral, factor_exp = f_exp, est_total_millones = estimador_total / 1000) res } estimar_total(muestra_casas, N) |> mutate(across(where(is.numeric), \\(x) round(x, 2))) ## # A tibble: 1 × 3 ## total_muestra factor_exp est_total_millones ## <dbl> <dbl> <dbl> ## 1 18444. 11.4 211 Sin embargo, si hubiéramos obtenido otra muestra, hubiéramos obtenido otra estimación diferente. Por ejemplo: estimar_total(sample_n(marco_casas, 100), N) |> mutate(across(where(is.numeric), \\(x) round(x, 2))) ## # A tibble: 1 × 3 ## total_muestra factor_exp est_total_millones ## <dbl> <dbl> <dbl> ## 1 17916. 11.4 205. El valor poblacional que buscamos estimar (nótese que en la práctica este no lo conocemos) es: # multiplicar por 1000 para que sea en millones de dólares total_pob <- sum(marco_casas |> pull(precio_miles)) / 1000 total_pob ## [1] 209.7633 Así que: Para algunas muestras esta estadística puede estar muy cercana al valor poblacional, pero para otras puede estar más lejana. Para entender qué tan buena es una estimación particular, entonces, tenemos que entender cuánta variabilidad hay de muestra a muestra debida a la aleatorización. Esto depende del diseño de la muestra y de la población de precios de casas (que no conocemos). Distribución de muestreo La distribución de muestreo de una estadística enumera los posibles resultados que puede tomar esa estadística sobre todas las muestras posibles. Este es el concepto básico para poder entender qué tan bien o mal estima un parámetro poblacional dado. En nuestro ejemplo anterior de precio de casas, no podemos calcular todas las posibles estimaciones bajo todas las posibles muestras, pero podemos aproximar repitiendo una gran cantidad de veces el proceso de muestreo, como hicimos al aproximar la distribución de permutaciones de estadísticas de prueba de las secciones anteriores. Empezamos repitiendo 10 veces y examinamos cómo varía nuestra estadística: replicar_muestreo <- function(marco_casas, m = 500, n){ # n es el tamaño de muestra que se saca de marco_casas # m es el número de veces que repetimos el muestro de tamaño n resultados <- map_df(1:m, function(id) { sample_n(marco_casas, n) |> estimar_total(N) }, .id = "id_muestra") } replicar_muestreo(marco_casas, m = 10, n = 100) |> mutate(across(where(is.numeric), round, 1)) |> formatear_tabla() id_muestra total_muestra factor_exp est_total_millones 1 17594.8 11.4 201.3 2 17423.9 11.4 199.3 3 18444.3 11.4 211.0 4 17696.6 11.4 202.4 5 17275.8 11.4 197.6 6 17867.6 11.4 204.4 7 18450.8 11.4 211.1 8 18187.2 11.4 208.1 9 18604.2 11.4 212.8 10 19144.4 11.4 219.0 Como vemos, hay variación considerable en nuestro estimador del total, pero la estimación que haríamos con cualquiera de estas muestras no es muy mala. Ahora examinamos un número más grande de simulaciones: replicaciones_1 <- replicar_muestreo(marco_casas, m = 1500, n = 100) Y el siguiente histograma nos dice qué podemos esperar de la variación de nuestras estimaciones, y donde es más probable que una estimación particular caiga: graf_1 <- ggplot(replicaciones_1, aes(x = est_total_millones)) + geom_histogram() + geom_vline(xintercept = total_pob, colour = "red") + xlab("Millones de dólares") + scale_x_continuous(breaks = seq(180, 240, 10), limits = c(180, 240)) graf_1 Con muy alta probabilidad el error no será de más de unos 30 millones de dólares (o no más de 20% del valor poblacional). Definición Sea \\(X_1, X_2, \\ldots X_n\\) una muestra, y \\(T = t(X_1, X_2, \\ldots, X_n)\\) una estadística. La distribución de muestreo de \\(T\\) es la función de distribución de \\(T\\). Esta distribución es sobre todas las posibles muestras que se pueden obtener. Cuando usamos \\(T\\) para estimar algún parámetro poblacional \\(\\theta\\), decimos informalmente que el estimador es preciso si su distribución de muestreo está muy concentrada alrededor del valor \\(\\theta\\) que queremos estimar. Si la distribución de muestreo está concentrada en un conjunto muy grande o muy disperso, quiere decir que con alta probabilidad cuando obtengamos nuestra muestra y calculemos nuestra estimación, el resultado estará lejano del valor poblacional que nos interesa estimar. Veamos qué pasa cuando hacemos la muestra más grande en nuestro ejemplo: replicaciones_2 <- replicar_muestreo(marco_casas, m = 1500, n = 250) Graficamos las dos distribuciones de muestreo juntas, y vemos cómo con mayor muestra obtenemos un estimador más preciso, y sin considerar el costo, preferimos el estimador mejor concentrado alrededor del valor que buscamos estimar. library(patchwork) graf_2 <- ggplot(replicaciones_2, aes(x = est_total_millones)) + geom_histogram() + geom_vline(xintercept = total_pob, colour = "red") + xlab("Millones de dólares") + scale_x_continuous(breaks = seq(180, 240, 10), limits = c(180, 240)) graf_1 + graf_2 Observación: a veces este concepto se confunde la distribución poblacional de las \\(X_i\\). Esto es muy diferente. Por ejemplo, en nuestro caso, el histograma de la distribución de valores poblacionales es ggplot(marco_casas, aes(x = precio_miles)) + geom_histogram() que en general no tiene ver mucho en escala o forma con la distribución de muestreo de nuestro estimador del total. Más ejemplos Podemos también considerar muestrear de poblaciones sintéticas o modelos probabilísticos que usamos para modelar poblaciones reales. Por ejemplo, supongamos que tomamos una muestra de tamaño 15 de la distribución uniforme en \\([0,1]\\). Es decir, cada \\(X_i\\) es un valor uniformemente distribuido en \\([0,1]\\), y las \\(X_i\\) se extraen independientemente unas de otras. Consideramos dos estadísticas de interés: La media muestral \\(T_1(X) = \\frac{1}{15}\\sum_{i = 1}^{15} X_i\\) El cuantil 0.75 de la muestra \\(T_2(X) = q_{0.75}(X)\\) ¿Cómo crees que se vean las distribuciones muestrales de estas estadísticas? ¿Alrededor de qué valores crees que concentren? ¿Crees que tendrán mucha o poca dispersión? ¿Qué forma crees que tengan? Para el primer caso hacemos: # simular replicar_muestreo_unif <- function(est = mean, m, n = 15){ valores_est <- map_dbl(1:m, ~ est(runif(n))) tibble(id_muestra = 1:m, estimacion = valores_est) } sim_estimador_1 <- replicar_muestreo_unif(mean, 4000, 15) # graficar aprox de distribución de muestreo ggplot(sim_estimador_1, aes(x = estimacion)) + geom_histogram(bins = 40) + xlim(c(0, 1)) # simular para el máximo cuantil_75 <- function(x) quantile(x, 0.75) sim_estimador_2 <- replicar_muestreo_unif(cuantil_75, 4000, 15) # graficar distribución de muestreo ggplot(sim_estimador_2, aes(x = estimacion)) + geom_histogram(breaks = seq(0, 1, 0.02)) + xlim(c(0, 1)) Supón que tenemos una muestra de 30 observaciones de una distribución uniforme \\([0,b]\\). ¿Qué tan buen estimador de \\(b/2\\) es la media muestral? ¿Cómo lo cuantificarías? ¿Qué tan buen estimador del cuantil 0.8 de la distribución uniforme es el cuantil 0.8 muestral? ¿Qué desventajas notas en este estimador? El error estándar Una primera medida útil de la dispersión de la distribución de muestreo es su desviación estándar: la razón específica tiene qué ver con un resultado importante, el teorema central del límite, que veremos más adelante. En este caso particular, a esta desviación estándar se le llama error estándar: Definición A la desviación estándar de una estadística \\(T\\) le llamamos su error estándar, y la denotamos por \\(\\text{ee}(T)\\). A cualquier estimador de este error estándar lo denotamos como \\(\\hat{\\text{ee}}(T)\\). Este error estándar mide qué tanto varía el estimador \\(T\\) de muestra a muestra. Observación: es importante no confundir el error estándar con la desviación estándar de una muestra (o de la población). En nuestro ejemplo de las uniformes, la desviación estándar de las muestras varía como: map_dbl(1:10000, ~ sd(runif(15))) |> quantile() |> round(2) ## 0% 25% 50% 75% 100% ## 0.11 0.26 0.29 0.31 0.41 Mientras que el error estándar de la media es aproximadamente map_dbl(1:10000, ~ mean(runif(15))) |> sd() ## [1] 0.07439575 y el error estándar del máximo es aproximadamente map_dbl(1:10000, ~ max(runif(15))) |> sd() ## [1] 0.05928675 Como ejercicio para contrastar estos conceptos, puedes considerar: ¿Qué pasa con la desviación estándar de una muestra muy grande de uniformes? ¿Qué pasa con el error estándar de la media muestral de una muestra muy grande de uniformes? Ejemplo: valor de casas Consideramos el error estándar del estimador del total del inventario vendido, usando una muestra de 250 con el estimador del total que describimos arriba. Como aproximamos con simulación la distribución de muestreo, podemos hacer: ee_2 <- replicaciones_2 |> pull(est_total_millones) |> sd() round(ee_2, 1) ## [1] 5.2 que está en millones de pesos y cuantifica la dispersión de la distribución de muestreo del estimador del total. Para tamaño de muestra 100, obtenemos más dispersión: ee_1 <- replicaciones_1 |> pull(est_total_millones) |> sd() round(ee_1, 1) ## [1] 8.9 Nótese que esto es muy diferente, por ejemplo, a la desviación estándar poblacional o de una muestra. Estas dos cantidades miden la variabilidad del estimador del total. Calculando la distribución de muestreo En los ejemplos anteriores usamos simulación para obtener aproximaciones de la distribución de muestreo de algunos estimadores. También es posible: Hacer cálculos exactos a partir de modelos probabilísticos. Hacer aproximaciones asintóticas para muestras grandes (de las cuales la más importante es la que da el teorema central del límite). En los ejemplos de arriba, cuando muestreamos de la poblaciones, extrajimos las muestras de manera aproximadamente independiente. Cada observación \\(X_i\\) tiene la misma distribución y las \\(X_i\\)’s son independientes. Este tipo de diseños aleatorizados es de los más simples, y se llama muestreo aleatorio simple. En general, en esta parte haremos siempre este supuesto: Una muestra es iid (independiente e idénticamente distribuida) si es es un conjunto de observaciones \\(X_1,X_2, \\ldots X_n\\) independientes, y cada una con la misma distribución. En términos de poblaciones, esto lo logramos obteniendo cada observación de manera aleatoria con el mismo procedimiento. En términos de modelos probabilísticos, cada \\(X_i\\) se extrae de la misma distribución fija \\(F\\) (que pensamos como la “población”) de manera independiente. Esto lo denotamos por \\(X_i \\overset{iid}{\\sim} F.\\) Ejemplo Si \\(X_1, X_2, \\ldots X_n\\) es una muestra de uniformes independientes en \\([0,1]\\), ¿cómo calcularíamos la distribución de muestreo del máximo muestra \\(T_2 = \\max\\)? En este caso, es fácil calcular su función de distribución acumulada de manera exacta: \\[F_{\\max}(x) = P(\\max\\{X_1,X_2,\\ldots X_n\\} \\leq x)\\] El máximo es menor o igual a \\(x\\) si y sólo si todas las \\(X_i\\) son menores o iguales a \\(x\\), así que \\[F_{\\max} (x) = P(X_1\\leq x, X_2\\leq x, \\cdots, X_n\\leq x)\\] como las \\(X_i\\)’s son independientes entonces \\[F_{\\max}(x) = P(X_1\\leq x)P(X_2\\leq x)\\cdots P(X_n\\leq x) = x^n\\] para \\(x\\in [0,1]\\), pues para cada \\(X_i\\) tenemos \\(P(X_i\\leq x) = x\\). Así que no es necesario usar simulación para conocer esta distribución de muestreo. Derivando esta distribución acumulada obtenemos su densidad, que es \\[f(x) = nx^{n-1}\\] para \\(x\\in [0,1]\\), y es cero en otro caso. Si comparamos con nuestra simulación: teorica <- tibble(x = seq(0, 1 ,0.001)) |> mutate(f_dens = 15 * x^14) sim_estimador_3 <- replicar_muestreo_unif(max, 4000, 15) ggplot(sim_estimador_3) + geom_histogram(aes(x = estimacion), breaks = seq(0, 1, 0.02)) + xlim(c(0.5, 1)) + # el histograma es de ancho 0.02 y el número de simulaciones 4000 geom_line(data = teorica, aes(x = x, y = (4000 * 0.02) * f_dens), colour = "red", linewidth = 1.3) Y vemos que con la simulación obtuvimos una buena aproximación Nota: ¿cómo se relaciona un histograma con la función de densidad que genera los datos? Supón que \\(f(x)\\) es una función de densidad, y obtenemos un número \\(n\\) de simulaciones independientes. Si escogemos un histograma de ancho \\(\\Delta\\), ¿cuántas observaciones esperamos que caigan en un intervalo \\(I = [a - \\Delta/2, a + \\Delta/2]\\)?. La probabilidad de que una observación caiga en \\(I\\) es igual a \\[P(X\\in I) = \\int_I f(x)\\,dx = \\int_{a - \\Delta/2}^{a + \\Delta/2} f(x)\\,dx \\approx f(a) \\text{long}(I) = f(a) \\Delta\\] para \\(\\Delta\\) chica. Si nuestra muestra es de tamaño \\(n\\), el número esperado de observaciones que caen en \\(I\\) es entonces \\(nf(a)\\Delta\\). Eso explica el ajuste que hicimos en la gráfica de arriba. Otra manera de hacer es ajustando el histograma: si en un intervalo el histograma alcanza el valor \\(y\\), \\[f(a) = \\frac{y}{n\\Delta}\\] teorica <- tibble(x = seq(0, 1 ,0.001)) |> mutate(f_dens = 15*x^{14}) ggplot(sim_estimador_3) + geom_histogram(aes(x = estimacion, y = after_stat(density)), breaks = seq(0, 1, 0.02)) + xlim(c(0.5, 1)) + # el histograma es de ancho 0.02 y el número de simulaciones 4000 geom_line(data = teorica, aes(x = x, y = f_dens), colour = "red", size = 1.3) Ejemplo Supongamos que las \\(X_i\\)’s son independientes y exponenciales con tasa \\(\\lambda > 0\\). ¿Cuál es la distribución de muestreo de la suma \\(S = X_1 + \\cdots + X_n\\)? Sabemos que la suma de exponenciales independientes es una distribución gamma con parámetros \\((n, \\lambda)\\), y esta es la distribución de muestreo de nuestra estadística \\(S\\) bajo las hipótesis que hicimos. Podemos checar este resultado con simulación, por ejemplo para una muestra de tamaño \\(n=15\\) con \\(\\lambda = 1\\): replicar_muestreo_exp <- function(est = mean, m, n = 150, lambda = 1){ valores_est <- map_dbl(1:m, ~ est(rexp(n, lambda))) tibble(id_muestra = 1:m, estimacion = valores_est) } sim_estimador_1 <- replicar_muestreo_exp(sum, 4000, n = 15) teorica <- tibble(x = seq(0, 35, 0.001)) |> mutate(f_dens = dgamma(x, shape = 15, rate = 1)) # graficar aprox de distribución de muestreo ggplot(sim_estimador_1) + geom_histogram(aes(x = estimacion, y = after_stat(density)), bins = 35) + geom_line(data = teorica, aes(x = x, y = f_dens), colour = "red", linewidth = 1.2) Teorema central del límite Si consideramos los ejemplos de arriba donde tratamos con estimadores basados en una suma, total o una media —y en menor medida cuantiles muestrales—, vimos que las distribución de muestreo de las estadísticas que usamos tienden a tener una forma común. Estas son manifestaciones de una regularidad estadística importante que se conoce como el teorema central del límite: las distribuciones de muestreo de sumas y promedios son aproximadamente normales cuando el tamaño de muestra es suficientemente grande. Teorema central del límite Si \\(X_1,X_2, \\ldots, X_n\\) son independientes e idénticamente distribuidas con media \\(\\mu\\) y desviación estándar \\(\\sigma\\) finitas. Si el tamaño de muestra \\(n\\) es grande, entonces la distribución de muestreo de la media \\[\\bar{X} = \\frac{X_1 + X_2 +\\cdots + X_n}{n}\\] es aproximadamente normal con media \\(\\mu\\) y desviación estándar \\(\\sigma/\\sqrt{n}\\), que escribimos como \\[\\bar{X} \\xrightarrow{} \\mathsf{N}\\left( \\mu, \\frac{\\sigma}{\\sqrt{n}} \\right)\\] Adicionalmente, la distribución de la media estandarizada converge a una distribución normal estándar cuando \\(n\\) es grande: \\[\\sqrt{n} \\, \\left( \\frac{\\bar{X}-\\mu}{\\sigma} \\right) \\xrightarrow{} \\mathsf{N}(0, 1)\\] El error estándar de \\(\\bar{X}\\) es \\(\\text{ee}(\\bar{X}) = \\frac{\\sigma}{\\sqrt{n}}\\). Si tenemos una muestra, podemos estimar \\(\\sigma\\) con de la siguiente forma: \\[\\hat{\\sigma} =\\sqrt{\\frac{1}{n}\\sum_{i=1}^n (X_i - \\bar{X})^2}\\] o el más común (que explicaremos más adelante) \\[\\hat{s} = \\sqrt{\\frac{1}{n-1}\\sum_{i=1}^n (X_i - \\bar{X})^2}\\] Este hecho junto con el teorema del límite central nos dice cuál es la dispersión, y cómo se distribuyen las posibles desviaciones de la media muestral alrededor de la verdadera media poblacional. ¿Qué tan grande debe ser \\(n\\). Depende de cómo es la población. Cuando la población tiene una distribución muy sesgada, por ejemplo, \\(n\\) típicamente necesita ser más grande que cuando la población es simétrica si queremos obtener una aproximación “buena”. En algunos textos se afirma que \\(n\\geq 30\\) es suficiente para que la aproximación del Teorema central del límite (TCL) sea buena siempre y cuando la distribución poblacional no sea muy sesgada. Esta regla es más o menos arbitraria y es mejor no confiarse, pues fácilmente puede fallar. En la práctica es importante checar este supuesto, por ejemplo usando remuestreo (que veremos más adelante) Revisa los ejemplos que hemos visto hasta ahora (precios de casas, simulaciones de uniformes y exponenciales según las distintas estadísticas que consideramos). ¿Qué distribuciones de muestreo parecen tener una distribución normal? ¿Cómo juzgamos si estas distribuciones están cerca o lejos de una distribución normal? Normalidad y gráficas de cuantiles normales Para checar si una distribución de datos dada es similar a la normal, la herramienta mas común en estádística es la gráfica de cuantiles teóricos, que es una generalización de la gráfica de cuantiles que vimos anteriormente. En primer lugar, definimos la función de cuantiles de una distribución teórica, que es análoga a la que definimos para conjuntos de datos: Supongamos que tenemos una distribución acumulada teórica \\(\\Phi\\). Podemos definir el cuantil-\\(f\\) \\(q(f)\\) de \\(\\Phi\\) como el valor \\(q(f)\\) tal que \\[q(f) = \\text{argmin}\\{x \\,| \\, \\Phi(x)\\geq f \\}\\] En el caso de que \\(\\Phi\\) tiene densidad \\(\\phi\\), y su soporte es un intervalo (que puede ser de longitud infinita), entonces podemos también escribir \\(q(f)\\) como el valor único donde acumulamos \\(f\\) de la probabilidad \\[\\int_{-\\infty}^{q(f)} \\phi(x)\\,dx= f\\] Por ejemplo, para una densidad normal, abajo mostramos los cuantiles \\(f=0.5\\) (mediana) y \\(f=0.95\\) densidad_tbl <- tibble(x = seq(0, 10, 0.01)) |> mutate(densidad = dnorm(x, 5, 1)) # qnorm es la función de cuantiles de una normal cuantil_50 <- qnorm(0.50, 5, 1) cuantil_90 <- qnorm(0.95, 5, 1) # graficamos densidad_tbl <- densidad_tbl |> mutate(menor_50 = x >= cuantil_50) |> mutate(menor_90 = x >= cuantil_90) g_normal_50 <- ggplot(densidad_tbl, aes(y = densidad)) + ylab('f(x)') + geom_area(aes(x = x, fill = menor_50)) + geom_line(aes(x = x), alpha = 0.1) + geom_vline(xintercept = cuantil_50) + theme(legend.position = "none") + annotate("text", 4.3, 0.2, label = "50%") + labs(subtitle = paste0("q(0.5)=", round(cuantil_50,1))) g_normal_90 <- ggplot(densidad_tbl, aes(y = densidad)) + ylab('f(x)') + geom_area(aes(x = x, fill = menor_90)) + geom_line(aes(x = x), alpha = 0.1) + geom_vline(xintercept = cuantil_90) + theme(legend.position = "none") + annotate("text", 5.0, 0.2, label = "95%") + labs(subtitle = paste0("q(0.95)=", round(cuantil_90,1))) g_normal_50 + g_normal_90 Como todas las distribuciones normales tienen la misma forma, y para obtener una de otra solo basta reescalar y desplazar, para calcular los cuantiles de una variable con distribución normal \\(\\mathsf{N}(\\mu, \\sigma)\\) sólo tenemos que saber los cuantiles de la distribución normal estándar \\(\\mathsf{N}(0,1)\\) y escalarlos apropiadamente por su media y desviación estándar \\[q(f, \\mu, \\sigma) = \\mu + \\sigma q(f, 0, 1)\\] Puedes demostrar esto sin mucha dificultad empezando con \\(P(X\\leq q) = f\\) y estandarizando: \\[P(X\\leq q(f, \\mu, \\sigma)) = f \\implies P\\left (Z\\leq \\frac{q(f,\\mu,\\sigma) - \\mu}{\\sigma}\\right)=f\\] y esto implica que \\[q(f, 0, 1) = \\frac{q(f,\\mu,\\sigma) - \\mu}{\\sigma} \\implies q(f, \\mu, \\sigma) = \\mu + \\sigma q(f, 0, 1)\\] De modo que si graficáramos los cuantiles de una distribución \\(\\mathsf{N}(\\mu, \\sigma)\\) contra los cuantiles de una distribución \\(\\mathsf{N}(0,1)\\), estos cuantiles aparecen en una línea recta: comparacion_tbl <- tibble(f = seq(0.01, 0.99, 0.01)) |> mutate(cuantiles_normal = qnorm(f, 5, 3), cuantiles_norm_estandar = qnorm(f, 0, 1)) ggplot(comparacion_tbl, aes(cuantiles_norm_estandar, cuantiles_normal)) + geom_point() Ahora supongamos que tenemos una muestra \\(X_1, \\ldots, X_n\\). ¿Cómo podemos checar si estos datos tienen una distribución aproximadamente normal? Si la muestra tiene una distribución aproximadamente \\(\\mathsf{N}(\\mu, \\sigma)\\), entonces sus cuantiles muestrales y los cuantiles respectivos de la normal estándar están aproximadamente en una línea recta. Primero veamos un ejemplo donde los datos son generados según una normal. set.seed(21) muestra <- tibble(x_1 = rnorm(60, 10, 3), x_2 = rgamma(60, 2, 5)) graf_1 <- ggplot(muestra, aes(sample = x_1)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") graf_2 <- ggplot(muestra, aes(sample = x_2)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") graf_1 + graf_2 ¿Cuáles son los datos aproximadamente normales? ¿Cómo interpretas las desviaciones de la segunda gráfica en términos de la forma de la distribución normal? Prueba de hipótesis de normalidad Para interpretar las gráficas de cuantiles normales se requiere práctica, pues claramente los datos, aún cuando provengan de una distribución normal, no van a caer justo sobre una línea recta y observaremos variabilidad. Esto no descarta necesariamente que los datos sean aproximadamente normales. Con la práctica, generalmente esta gráfica nos da una buena indicación si el supuesto de normalidad es apropiado. Sin embargo, podemos hacer una prueba de hipótesis formal de normalidad si quisiéramos. La hipótesis nula es la siguiente: Los datos provienen de una distribución normal, y las desviaciones que observamos de una línea recta se deben a variación muestral. Podemos generar datos nulos tomando la media y desviación estándar muestrales, y generando muestras normales \\(\\mathsf{N}(\\bar{x}, s)\\). Usamos el lineup, produciendo datos bajo la hipótesis nula y viendo si podemos distinguir los datos. Por ejemplo: library(nullabor) lineup_normal <- lineup(null_dist("x_2", dist = "normal"), muestra) ggplot(lineup_normal, aes(sample = x_2)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") + facet_wrap(~ .sample) En esta gráfica claramente rechazaríamos la hipótesis de normalidad. Sin embargo, para la primera muestra, obtenemos: lineup_normal <- lineup(null_dist("x_1", dist = "normal"), muestra) ggplot(lineup_normal, aes(sample = x_1)) + geom_qq(distribution = stats::qnorm) + geom_qq_line(colour = "red") + facet_wrap(~ .sample) Los datos verdaderos están en attr(lineup_normal, "pos") ## [1] 4 Ejemplo Consideremos el problema de estimar el total poblacional de los precios de las casas que se vendieron. El estimador que usamos fue la suma muestral expandida por un factor. Vamos a checar qué tan cerca de la normalidad está la distribución de meustreo de esta estadística (\\(n=250\\)): replicaciones_2 ## # A tibble: 1,500 × 4 ## id_muestra total_muestra factor_exp est_total_millones ## <chr> <dbl> <dbl> <dbl> ## 1 1 47089. 4.58 215. ## 2 2 45654. 4.58 209. ## 3 3 43973. 4.58 201. ## 4 4 45665. 4.58 209. ## 5 5 43551. 4.58 199. ## 6 6 46066. 4.58 211. ## 7 7 46626. 4.58 213. ## 8 8 47944. 4.58 219. ## 9 9 45381. 4.58 208. ## 10 10 46519. 4.58 213. ## # ℹ 1,490 more rows ggplot(replicaciones_2, aes(sample = est_total_millones)) + geom_qq(alpha = 0.3) + geom_qq_line(colour = "red") Y vemos que en efecto el TCL aplica en este ejemplo, y la aproximación es buena. Aunque la población original es sesgada, la descripción de la distribución de muestreo es sorprendemente compacta: La distribución de muestreo de nuestro estimador del total \\(\\hat{t}\\) es aproximadamente normal con media \\(\\bar{x}\\) y desviación estándar \\(s\\), donde: mu <- mean(replicaciones_2$est_total_millones) s <- sd(replicaciones_2$est_total_millones) c(mu = mu, s = s) |> round(2) ## mu s ## 209.90 5.24 Estas cantidades están en millones de dólares. Ejemplo Supongamos que queremos calcular la probabilidad que la suma de 30 variables uniformes en \\([0,1]\\) independientes sea mayor que 18. Podríamos aproximar esta cantidad usando simulación. Otra manera de aproximar esta cantidad es con el TCL, de la siguiente forma: Si \\(S=X_1 + X_2 + X_{30}\\), entonces la media de \\(S\\) es 15 (¿cómo se calcula?) y su desviación estándar es \\(\\sqrt{\\frac{30}{12}}\\). La suma es entonces aproximadamente \\(\\mathsf{N}\\left(15, \\sqrt{\\frac{30}{12}}\\right)\\). Entonces \\[P(S > 18) = P \\left (\\frac{S - 15}{\\sqrt{\\frac{30}{12}}} > \\frac{18 - 15}{\\sqrt{\\frac{30}{12}}}\\right) \\approx P(Z > 1.897)\\] donde \\(Z\\) es normal estándar. Esta última cantidad la calculamos usando la función de distribución de la normal estándar, y nuestra aproximación es 1 - pnorm(1.897) ## [1] 0.02891397 Podemos checar nuestro cálculo usando simulación: tibble(n_sim = 1:100000) |> mutate(suma = map_dbl(n_sim, ~ sum(runif(30)))) |> summarise(prob_may_18 = mean(suma > 18), .groups = "drop") ## # A tibble: 1 × 1 ## prob_may_18 ## <dbl> ## 1 0.0280 Y vemos que la aproximación normal es buena para fines prácticos. Usando simulaciones haz un histograma que aproxime la distribución de muestreo de \\(S\\). Haz una gráfica de cuantiles normales para checar la normalidad de esta distribución. Ejemplo Cuando el sesgo de la distribución poblacional es grande, puede ser necesario que \\(n\\) sea muy grande para que la aproximación normal sea aceptable para el promedio o la suma. Por ejemplo, si tomamos una gamma con parámetro de forma chico, \\(n = 30\\) no es suficientemente bueno, especialmente si quisiéramos aproximar probabilidades en las colas de la distribución: sims_gamma <- map_df(1:2000, ~ tibble(suma = sum(rgamma(30, 0.1, 1))), .id = "n_sim") ggplot(sims_gamma, aes(x = suma)) + geom_histogram() Más del Teorema central del límite El teorema central del límite aplica a situaciones más generales que las del enunciado del teorema básico. Por ejemplo, aplica a poblaciones finitas (como vimos en el ejemplo de las casas), en 1960 Jaroslav Hajek demostró una versión del TCL bajo muestreo sin reemplazo. Mas allá de la media muestral, el TCL se puede utilizar para más estadísticas ya que muchas pueden verse como promedios, como totales o errores estándar. El TLC se ha generalizado incluso para cuantiles muestrales. Es importante notar que la calidad de la aproximación del TCL depende de características de la población y también del tamaño de muestra \\(n\\). Para ver si el TCL aplica, podemos hacer ejercicios de simulación bajo diferentes supuestos acerca de la población. También veremos más adelante, con remuestreo, maneras de checar si es factible el TCL dependiendo del análisis de una muestra dada que tengamos. El TCL era particularmente importante en la práctica antes de que pudiéramos hacer simulación por computadora. Era la única manera de aproximar y entender la distribución muestral fuera de cálculos analíticos (como los que hicimos para el máximo de un conjunto de uniformes, por ejemplo). Hoy en día, veremos que podemos hacer simulación para obtener respuestas más exactas, particularmente en la construcción de intervalos de confianza, por ejemplo. Dependemos menos de resultados asintóticos, como el TCL. Cuando aproximamos una distribución discreta mediante la distribución normal, conviene hacer correcciones de continuidad, como se explica en (Chihara and Hesterberg 2018), 4.3.2. Referencias "],["intervalos-de-confianza-y-remuestreo.html", "Sección 5 Intervalos de confianza y remuestreo Ejemplo introductorio La idea del bootstrap El principio de plug-in Discusión: propiedades de la distribución bootstrap Error estándar bootstrap e intervalos normales Ejemplo: inventario de casas vendidas Calibración de intervalos de confianza Interpretación de intervalos de confianza Sesgo Intervalos bootstrap de percentiles Bootstrap para dos muestras Bootstrap y otras estadísticas Bootstrap y estimadores complejos: tablas de perfiles Bootstrap y muestras complejas Bootstrap en R Conclusiones y observaciones", " Sección 5 Intervalos de confianza y remuestreo En la sección anterior, vimos el concepto de distribución de muestreo de una estadística que queremos utilizar para estimar un valor poblacional, y vimos que con esta distribución podíamos evaluar qué tan preciso es nuestro estimador evaluando qué tan concentrada está esta distribución alrededor del valor poblacion que queremos estimar. Sin embargo, en los ejemplos que vimos la población era conocida: ya sea que tuviéramos toda la población finita disponible (como el ejemplo de las casas), o donde la población estaba definida por un modelo teórico de probabilidad (como los ejemplos de las distribuciones uniforme o exponencial). Ahora vemos qué hacer en el caso que realmente nos interesa: solo tenemos una muestra disponible, y la población es desconocida. Todo lo que tenemos es una muestra y una estimación basada en la muestra, y requerimos estimar la distribución de muestreo de la estadística de interés. El enfoque que presentaremos aquí es uno de los más flexibles y poderosos que están disponibles para este problema: el método bootstrap o de remuestreo. En primer lugar explicamos el concepto de intervalo de confianza, que es una manera resumida de evaluar la precisión de nuestras estimaciones. Ejemplo introductorio Regresamos a nuestro ejemplo anterior donde muestreamos 3 grupos, y nos preguntábamos acerca de la diferencia de sus medianas. En lugar de hacer pruebas de permutaciones (ya sea pruebas gráficas o alguna prueba de permutaciones para media o mediana, por ejemplo), podríamos considerar qué tan precisa es cada una de nuestras estimaciones para las medianas de los grupos. Nuestros resultados podríamos presentarlos como sigue. Este código lo explicaremos más adelante, por el momento consideramos la gŕafica resultante: set.seed(8) pob_tab <- tibble(id = 1:2000, x = rgamma(2000, 4, 1), grupo = sample(c("a","b", "c"), 2000, prob = c(4,2,1), replace = T)) muestra_tab <- pob_tab |> slice_sample(n = 125) g_1 <- ggplot(muestra_tab, aes(x = grupo, y = x)) + geom_boxplot(outlier.alpha = 0) + geom_jitter(alpha = 0.3) + labs(subtitle = "Muestra \\n") + ylim(c(0,14)) ## Hacemos bootstrap fun_boot <- function(datos){ datos |> group_by(grupo) |> slice_sample(prop = 1, replace = TRUE) } reps_boot <- map_df(1:2000, function(i){ muestra_tab |> fun_boot() |> group_by(grupo) |> summarise(mediana = median(x), .groups = "drop")}, .id = 'rep') resumen_boot <- reps_boot |> group_by(grupo) |> summarise(ymin = quantile(mediana, 0.025), ymax = quantile(mediana, 0.975), .groups = "drop") |> left_join(muestra_tab |> group_by(grupo) |> summarise(mediana = median(x))) g_2 <- ggplot(resumen_boot, aes(x = grupo, y = mediana, ymin = ymin, ymax = ymax)) + geom_linerange() + geom_point(colour = "red", size = 2) + ylim(c(0,14)) + labs(subtitle = "Intervalos de 95% \\n para la mediana") g_1 + g_2 Donde: En rojo está nuestro = puntual de la mediana de cada grupo (la mediana muestral), y Las segmentos muestran un intervalo de confianza del 95% para nuestra estimación de la mediana: esto quiere decir que los valores poblacionales tienen probabilidad aproximada de 95% de estar dentro del intervalo. Este análisis comunica correctamente que tenemos incertidumbre alta acerca de nuestras estimaciones (especialmente grupos b y c), y que no tenemos mucha evidencia de que el grupo b tenga una mediana poblacional considerablemente más alta que a o c. En muchos casos es más útil presentar la información de esta manera que usando alguna prueba de hipótesis. La idea del bootstrap Como explicamos, el problema que tenemos ahora es que normalmente sólo tenemos una muestra, así que no es posible calcular las distribuciones de muestreo como hicimos en la sección anterior y así evaluar qué tan preciso es nuestro estimador. Sin embargo, podemos hacer lo siguiente: Supongamos que tenemos una muestra \\(X_1,X_2,\\dots, X_n\\) independientes de alguna población desconocida y un estimador \\(T=t(X_1,\\dots, X_n)\\) Mundo poblacional Si tuviéramos la distribución poblacional, simulamos muestras iid para aproximar la distribución de muestreo de nuestro estimador, y así entender su variabilidad. Pero no tenemos la distribución poblacional. Sin embargo, podemos estimar la distribución poblacional con nuestros valores muestrales. Mundo bootstrap Si usamos la estimación del inciso 3, entonces usando el inciso 1 podríamos tomar muestras de nuestros datos muestrales, como si fueran de la población, y usando el mismo tamaño de muestra. El muestreo lo hacemos con reemplazo de manera que produzcamos muestras independientes de la misma “población estimada”, que es la muestra. Evaluamos nuestra estadística en cada una de estas remuestras, a estas les llamamos replicaciones bootstrap. A la distribución de las replicaciones le llamamos distribución bootstrap o distribución de remuestreo del estimador. Usamos la distribución bootstrap para estimar la variabilidad en nuestra estimación con la muestra original. Veamos que sucede para un ejemplo concreto, donde nos interesa estimar la media de los precios de venta de una población de casas. Tenemos nuestra muestra: set.seed(2112) poblacion_casas <- read_csv("data/casas.csv") muestra <- slice_sample(poblacion_casas, n = 200, replace = TRUE) mean(muestra$precio_miles) ## [1] 179.963 Esta muestra nos da nuestro estimador de la distribución poblacional: bind_rows(muestra |> mutate(tipo = "muestra"), poblacion_casas |> mutate(tipo = "población")) |> ggplot(aes(sample = precio_miles, colour = tipo, group = tipo)) + geom_qq(distribution = stats::qunif, alpha = 0.4, size = 1) + facet_wrap(~ tipo) O con histogramas: bind_rows(muestra |> mutate(tipo = "muestra"), poblacion_casas |> mutate(tipo = "población")) |> ggplot(aes(x = precio_miles, group = tipo)) + geom_histogram(aes(y=..density..), binwidth = 50) + facet_wrap(~ tipo) Y vemos que la aproximación es razonable en las partes centrales de la distribución. Ahora supongamos que nos interesa cuantificar la precisión de nuestra estimación de la media poblacional de precios de casas, y usaremos la media muestral para hacer esto. Para nuestra muestra, nuestra estimación puntual es: media <- mean(muestra$precio_miles) media ## [1] 179.963 Y recordamos que para aproximar la distribución de muestreo podíamos muestrear repetidamente la población y calcular el valor del estimador en cada una de estas muestras. Aquí no tenemos la población, pero tenemos una estimación de la población: la muestra obtenida. Así que para evaluar la variabilidad de nuestro estimador, entramos en el mundo bootstrap, y consideramos que la población es nuestra muestra. Podemos entonces extraer un número grande de muestras con reemplazo de tamaño 200 de la muestra: el muestreo debe ser análogo al que se tomó para nuestra muestra original. Evaluamos nuestra estadística (en este caso la media) en cada una de estas remuestras: media_muestras <- map_dbl(1:5000, ~ muestra |> slice_sample(n = 200, replace = TRUE) |> summarise(media_precio = mean(precio_miles), .groups = "drop") |> pull(media_precio)) Y nuestra estimación de la distribución de muestreo para la media es entonces: bootstrap <- tibble(media = media_muestras) g_cuantiles <- ggplot(bootstrap, aes(sample = media)) + geom_qq(distribution = stats::qunif) g_histograma <- ggplot(bootstrap, aes(x = media)) + geom_histogram(binwidth = 2) g_cuantiles + g_histograma A esta le llamamos la distribución bootstrap (o de remuestreo) de la media, que definimos más abajo. Ahora podemos calcular un intervalo de confianza del 90% simplemente calculando los cuantiles de esta distribución (no son los cuantiles de la muestra original!): limites_ic <- quantile(media_muestras, c(0.05, 0.95)) |> round() limites_ic ## 5% 95% ## 171 189 Presentaríamos nuestro resultado como sigue: nuestra estimación puntual de la mediana es 180, con un intervalo de confianza del 90% de (171, 189) Otra cosa que podríamos hacer para describir la dispersión de nuestro estimador es calcular el error estándar de remuestreo, que estima el error estándar de la distribución de muestreo: ee_boot <- sd(media_muestras) round(ee_boot, 2) ## [1] 5.39 Definición. Sea \\(X_1,X_2,\\ldots,X_n\\) una muestra independiente y idénticamente distribuida, y \\(T=t(X_1, X_2, \\ldots, X_n)\\) una estadística. Supongamos que sus valores que obervamos son \\(x_1, x_2,\\ldots, x_n\\). La distribución bootstrap, o distribución de remuestreo, de \\(T\\) es la distribución de \\(T^*=t(X_1^*, X_2^*, \\dots X_n^*)\\), donde cada \\(X_i^*\\) se obtiene tomando al azar uno de los valores de \\(x_1,x_2,\\ldots, x_n\\). Otra manera de decir esto es que la remuestra \\(X_1^*, X_2^*, \\ldots, X_n^*\\) es una muestra con reemplazo de los valores observados \\(x_1, x_2, \\ldots, x_n\\) Ejemplo. Si observamos la muestra muestra <- sample(1:20, 5) muestra ## [1] 6 10 7 3 14 Una remuestra se obtiene: sample(muestra, size = 5, replace = TRUE) ## [1] 7 3 7 10 6 Nótese que algunos valores de la muestra original pueden aparecer varias veces, y otros no aparecen del todo. La idea del bootstrap (no paramétrico). La muestra original es una aproximación de la población de donde fue extraída. Así que remuestrear la muestra aproxima lo que pasaría si tomáramos muestras de la población. La distribución de remuestreo de una estadística, que se construye tomando muchas remuestras, aproxima la distribución de muestreo de la estadística. Y el proceso que hacemos es: Remuestreo para una población. Dada una muestra de tamaño \\(n\\) de una población, Obtenemos una remuestra de tamaño \\(n\\) con reemplazo de la muestra original y calculamos la estadística de interés. Repetimos este remuestreo muchas veces (por ejemplo, 10,000). Construímos la distribución bootstrap, y examinamos sus características (dónde está centrada, dispersión y forma). El principio de plug-in La idea básica detrás del bootstrap es el principio de plug-in para estimar parámetros poblacionales: si queremos estimar una cantidad poblacional, calculamos esa cantidad poblacional con la muestra obtenida. Es un principio común en estadística. Por ejemplo, si queremos estimar la media o desviación estándar poblacional, usamos la media muestral o la desviación estándar muestral. Si queremos estimar un cuantil de la población usamos el cuantil correspondiente de la muestra, y así sucesivamente. En todos estos casos, lo que estamos haciendo es: Tenemos una fórmula para la cantidad poblacional de interés en términos de la distribución poblacional. Tenemos una muestra, la distribución que da esta muestra se llama distribución empírica (\\(\\hat{F}(x) = \\frac{1}{n}\\{\\#valores \\le x\\}\\)). Contruimos nuestro estimador, de la cantidad poblacional de interés, “enchufando” la distribución empírica de la muestra en la fórmula del estimador. En el bootstrap aplicamos este principio simple a la distribución de muestreo: Si tenemos la población, podemos calcular la distribución de muestreo de nuestro estimador tomando muchas muestras de la población. Estimamos la poblacion con la muestra y enchufamos en la frase anterior: estimamos la distribución de muestreo de nuestro estimador tomando muchas muestras de la muestra. Nótese que el proceso de muestreo en el último paso debe ser el mismo que se usó para tomar la muestra original. Estas dos imágenes simuladas con base en un ejemplo de Chihara and Hesterberg (2018) muestran lo que acabamos de describir: Figure 5.1: Mundo Real Figure 5.2: Mundo Bootstrap Observación 1. Veremos ejemplos más complejos, pero nótese que si la muestra original son observaciones independientes obtenidas de la distribución poblacional, entonces logramos esto en las remuestras tomando observaciones con reemplazo de la muestra. Igualmente, las remuestras deben ser del mismo tamaño que la muestra original. ¿Porqué no funcionaría tomar muestras sin reemplazo? Piensa si hay independencia entre las observaciones de la remuestra, y cómo serían las remuestras sin reemplazo. ¿Por qué no se puede hacer bootstrap si no conocemos cómo se obtuvo la muestra original? Observación 2. Estos argumentos se pueden escribir con fórmulas usando por ejemplo la función de distribución acumulada \\(F\\) de la población y su estimador, que es la función empírica \\(\\hat{F}\\). Si \\(\\theta = t(F)\\) es una cantidad poblacional que queremos estimar, su estimador plug-in es \\(\\hat{\\theta} = t(\\hat{F})\\). Observación 3: La distribución empírica \\(\\hat{F}\\) es un estimador “razonable” de la distribución poblacional \\(F,\\) pues por el teorema de Glivenko-Cantelli (ver Wasserman (2013), o aquí), \\(\\hat{F}\\) converge a \\(F\\) cuando el tamaño de muestra \\(n\\to\\infty\\), lo cual es intuitivamente claro. Ejemplo En el ejemplo de tomadores de té, podemos estimar la proporción de tomadores de té que prefiere el té negro usando nuestra muestra: te <- read_csv("data/tea.csv") |> rowid_to_column() |> select(rowid, Tea, sugar) te |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro), .groups = "drop") ## # A tibble: 1 × 2 ## prop_negro n ## <dbl> <int> ## 1 0.247 300 ¿Cómo evaluamos la precisión de este estimador? Supondremos que el estudio se hizo tomando una muestra aleatoria simple de tamaño 300 de la población de tomadores de té que nos interesa. Podemos entonces usar el bootstrap: # paso 1: define el estimador calc_estimador <- function(datos){ prop_negro <- datos |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro), .groups = "drop") |> pull(prop_negro) prop_negro } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador prop_negro_tbl <- tibble(prop_negro = map_dbl(1:10000, ~ calc_estimador(muestra_boot(datos = te)))) # paso 4: examina la distribución bootstrap prop_negro_tbl |> ggplot(aes(x = prop_negro)) + geom_histogram(bins = 15) + geom_vline(xintercept = calc_estimador(te), color = "red") Y podemos evaluar varios aspectos, por ejemplo dónde está centrada y qué tan dispersa es la distribución bootstrap: prop_negro_tbl |> summarise(media = mean(prop_negro), ee = sd(prop_negro), cuantil_75 = quantile(prop_negro, 0.75), cuantil_25 = quantile(prop_negro, 0.25), .groups = "drop") |> mutate(across(where(is.numeric), round, 3)) |> pivot_longer(cols = everything()) ## # A tibble: 4 × 2 ## name value ## <chr> <dbl> ## 1 media 0.247 ## 2 ee 0.025 ## 3 cuantil_75 0.263 ## 4 cuantil_25 0.23 –> –> Discusión: propiedades de la distribución bootstrap Uasremos la distribución bootstrap principalmente para evaluar la variabilidad de nuestros estimadores (y también otros aspectos como sesgo) estimando la dispersión de la distribución de muestreo. Sin embargo, es importante notar que no la usamos, por ejemplo, para saber dónde está centrada la distribución de muestreo, o para “mejorar” la estimación remuestreando. Ejemplo En este ejemplo, vemos 20 muestras de tamaño 200, y evaluamos cómo se ve la aproximación a la distribución de la población (rojo): Podemos calcular las distribuciones de remuestreo (bootstrap) para cada muestra, y compararlas con la distribución de muestreo real. # paso 1: define el estimador calc_estimador <- function(datos){ media_precio <- datos |> summarise(media = mean(precio_miles), .groups = "drop") |> pull(media) media_precio } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos, n = NULL){ #tomar muestra con reemplazo del mismo tamaño if(is.null(n)){ m <- slice_sample(datos, prop = 1, replace = TRUE)} else { m <- slice_sample(datos, n = n, replace = TRUE) } m } dist_boot <- datos_sim |> filter(tipo == "muestras") |> select(precio_miles, rep) |> group_by(rep) |> nest() |> mutate(precio_miles = map(data, function(data){ tibble(precio_miles = map_dbl(1:1000, ~ calc_estimador(muestra_boot(data)))) })) |> select(rep, precio_miles) |> unnest() dist_muestreo <- datos_sim |> filter(tipo == "población") |> group_by(rep) |> nest() |> mutate(precio_miles = map(data, function(data){ tibble(precio_miles = map_dbl(1:1000, ~ calc_estimador(muestra_boot(data, n = 200)))) })) |> select(rep, precio_miles) |> unnest() Obsérvese que: En algunos casos la aproximación es mejor que en otros (a veces la muestra tiene valores ligeramente más altos o más bajos). La dispersión de cada una de estas distribuciones bootstrap es similar a la de la verdadera distribución de muestreo (en rojo), pero puede está desplazada dependiendo de la muestra original que utilizamos. Adicionalmente, los valores centrales de la distribución de bootstrap tiende cubrir el verdadero valor que buscamos estimar, que es: poblacion_casas |> summarise(media = mean(precio_miles), .groups = "drop") ## # A tibble: 1 × 1 ## media ## <dbl> ## 1 183. Variación en distribuciones bootstrap En el proceso de estimación bootstrap hay dos fuentes de variación pues: La muestra original se selecciona con aleatoriedad de una población. Las muestras bootstrap se seleccionan con aleatoriedad de la muestra original. Esto es: La estimación bootstrap ideal es un resultado asintótico \\(B=\\infty\\), en esta caso \\(\\hat{\\textsf{se}}_B\\) iguala la estimación plug-in \\(se_{P_n}\\). En el proceso de bootstrap podemos controlar la variación del segundo aspecto, conocida como implementación de muestreo Monte Carlo, y la variación Monte Carlo decrece conforme incrementamos el número de muestras. Podemos eliminar la variación Monte Carlo si seleccionamos todas las posibles muestras con reemplazo de tamaño \\(n\\), hay \\({2n-1}\\choose{n}\\) posibles muestras y si seleccionamos todas obtenemos \\(\\hat{\\textsf{se}}_\\infty\\) (bootstrap ideal), sin embargo, en la mayor parte de los problemas no es factible proceder así. En la siguiente gráfica mostramos 6 posibles muestras de tamaño 50 simuladas de la población, para cada una de ellas se graficó la distribución empírica y se se realizan histogramas de la distribución bootstrap con \\(B=30\\) y \\(B=1000\\), en cada caso hacemos dos repeticiones, notemos que cuando el número de muestras bootstrap es grande las distribuciones bootstrap son muy similares (para una muestra de la población dada), esto es porque disminuimos el erro Monte Carlo. También vale la pena recalcar que la distribución bootstrap está centrada en el valor observado en la muestra (línea azúl punteada) y no en el valor poblacional sin embargo la forma de la distribución es similar a lo largo de las filas. Entonces, ¿cuántas muestras bootstrap? Incluso un número chico de replicaciones bootstrap, digamos \\(B=25\\) es informativo, y \\(B=50\\) con frecuencia es suficiente para dar una buena estimación de \\(se_P(\\hat{\\theta})\\) (Efron and Tibshirani (1993)). Cuando se busca estimar error estándar Chihara and Hesterberg (2018) recomienda \\(B=1000\\) muestras, o \\(B=10,000\\) muestras dependiendo la presición que se busque. Error estándar bootstrap e intervalos normales Ahora podemos construir nuestra primera versión de intervalos de confianza basados en la distribución bootstrap. Supongamos que queremos estimar una cantidad poblacional \\(\\theta\\) con una estadística \\(\\hat{\\theta} = t(X_1,\\ldots, X_n)\\), donde \\(X_1,\\ldots, X_n\\) es una muestra independiente e idénticamente distribuida de la población. Suponemos además que la distribución muestral de \\(\\hat{\\theta}\\) es aproximadamente normal (el teorema central del límite aplica), y está centrada en el verdadero valor poblacional \\(\\theta\\). Ahora queremos construir un intervalo que tenga probabilidad 95% de cubrir al valor poblacional \\(\\theta\\). Tenemos que \\[P(-2\\mathsf{ee}(\\hat{\\theta}) < \\hat{\\theta} - \\theta < 2\\mathsf{ee}(\\hat{\\theta})) \\approx 0.95\\] por las propiedades de la distribución normal (\\(P(-2\\sigma < X -\\mu < 2\\sigma)\\approx 0.95\\) si \\(X\\) es normal con media \\(\\mu\\) y desviación estándar \\(\\sigma\\)). Entonces \\[P(\\hat{\\theta} - 2\\mathsf{ee}(\\hat{\\theta}) < \\theta < \\hat{\\theta} + 2\\mathsf{ee}(\\hat{\\theta})) \\approx 0.95\\] Es decir, la probabilidad de que el verdadero valor poblacional \\(\\theta\\) esté en el intervalo \\[[\\hat{\\theta} - 2\\mathsf{ee}(\\hat{\\theta}), \\hat{\\theta} + 2\\mathsf{ee}(\\hat{\\theta})]\\] es cercano a 0.95. En este intervalo no conocemos el error estándar (es la desviación estándar de la distribución de muestreo de \\(\\hat{\\theta}\\)), y aquí es donde entre la distribución bootstrap, que aproxima la distribución de muestreo. Lo estimamos con \\[\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})\\] que es la desviación estándar de la distribución bootsrap. Definición. El error estándar bootstrap \\(\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})\\) se define como la desviación estándar de la distribución bootstrap de \\(\\theta\\). El intervalo de confianza normal bootstrap al 95% está dado por \\[[\\hat{\\theta} - 2\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta}), \\hat{\\theta} + 2\\hat{\\mathsf{ee}}_{\\textrm{boot}}(\\hat{\\theta})].\\] Nótese que hay varias cosas qué revisar aquí: que el teorema central del límite aplica y que la distribución de muestreo de nuestro estimador está centrado en el valor verdadero. Esto en algunos casos se puede demostrar usando la teoría, pero más abajo veremos comprobaciones empíricas. Ejemplo: tomadores de té negro Consideremos la estimación que hicimos de el procentaje de tomadores de té que toma té negro: # paso 1: define el estimador calc_estimador <- function(datos){ prop_negro <- datos |> mutate(negro = ifelse(Tea == "black", 1, 0)) |> summarise(prop_negro = mean(negro), n = length(negro)) |> pull(prop_negro) prop_negro } prop_hat <- calc_estimador(te) prop_hat |> round(2) ## [1] 0.25 Podemos graficar su distribución bootstrap —la cual simulamos arriba—. g_hist <- ggplot(prop_negro_tbl, aes(x = prop_negro)) + geom_histogram(bins = 15) g_qq_normal <- ggplot(prop_negro_tbl, aes(sample = prop_negro)) + geom_qq() + geom_qq_line(colour = "red") g_hist + g_qq_normal Y notamos que la distribución bootstrap es aproximadamente normal. Adicionalmente, vemos que el sesgo tiene un valor estimado de: media_boot <- prop_negro_tbl |> pull(prop_negro) |> mean() media_boot - prop_hat ## [1] 0.0004393333 De esta forma, hemos verificado que: La distribución bootstrap es aproximadamente normal (ver gráfica de cuantiles normales); La distribución bootstrap es aproximadamente insesgada. Lo cual nos lleva a construir intervalos de confianza basados en la distribución normal. Estimamos el error estándar con la desviación estándar de la distribución bootstrap ee_boot <- prop_negro_tbl |> pull(prop_negro) |> sd() ee_boot ## [1] 0.02485138 y construimos un intervalo de confianza del 95%: intervalo_95 <- c(prop_hat - 2 * ee_boot, prop_hat + 2 * ee_boot) intervalo_95 |> round(2) ## [1] 0.2 0.3 Este intervalo tiene probabilidad del 95% de capturar al verdadero poblacional. Con alta probabilidad, entonces, el porcentaje de tomadores de té en la población está entre 0.2 y 0.3. Ejemplo: inventario de casas vendidas Ahora consideremos el problema de estimar el total del valor de las casas vendidas en un periodo. Tenemos una muestra de tamaño \\(n=150\\): # muestra original set.seed(121) muestra_casas <- slice_sample(poblacion_casas, n = 150) # paso 1: define el estimador calc_estimador_casas <- function(datos){ N <- nrow(poblacion_casas) n <- nrow(datos) total_muestra <- sum(datos$precio_miles) estimador_total <- (N / n) * total_muestra estimador_total } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador totales_boot <- tibble(total_boot = map_dbl(1:5000, ~ calc_estimador_casas(muestra_boot(muestra_casas)))) # paso 4: examina la distribución bootstrap g_hist <- totales_boot |> ggplot(aes(x = total_boot)) + geom_histogram() g_qq <- totales_boot |> ggplot(aes(sample = total_boot)) + geom_qq() + geom_qq_line(colour = "red") + geom_hline(yintercept = quantile(totales_boot$total_boot, 0.975), colour = "gray") + geom_hline(yintercept = quantile(totales_boot$total_boot, 0.025), colour = "gray") g_hist + g_qq En este caso, distribución de muestreo presenta cierta asimetría, pero la desviación no es grande. En la parte central la aproximación normal es razonable. Procedemos a revisar sesgo total_est <- calc_estimador_casas(muestra_casas) sesgo <- mean(totales_boot$total_boot) - total_est sesgo ## [1] 110.0851 Este número puede parecer grande, pero sí calculamos la desviación relativa con respecto al error estándar vemos que es chico en la escala de la distribución bootstrap: ee_boot <- sd(totales_boot$total_boot) sesgo_relativo <- sesgo / ee_boot sesgo_relativo ## [1] 0.01522088 De forma que procedemos a construir intervalos de confianza como sigue : c(total_est - 2*ee_boot, total_est + 2*ee_boot) ## [1] 203366.6 232296.6 Que está en miles de dólares. En millones de dólares, este intervalo es: intervalo_total <- c(total_est - 2*ee_boot, total_est + 2*ee_boot) / 1000 intervalo_total |> round(1) ## [1] 203.4 232.3 Así que con 95% de confianza el verdadero total del valor de las casas vendidas está entre 203 y 232 millones de dólares. Nota: en este ejemplo mostraremos una alternativa de intervalos de confianza que es más apropiado cuando observamos asimetría. Sin embargo, primero tendremos que hablar de dos conceptos clave con respecto a intervalos de confianza: calibración e interpretación. Calibración de intervalos de confianza ¿Cómo sabemos que nuestros intervalos de confianza del 95% nominal tienen cobertura real de 95%? Es decir, tenemos que checar: El procedimiento para construir intervalos debe dar intervalos tales que el valor poblacional está en el intervalo de confianza para 95% de las muestras. Como solo tenemos una muestra, la calibración depende de argumentos teóricos o estudios de simulación previos. Para nuestro ejemplo de casas tenemos la población, así que podemos checar qué cobertura real tienen los intervalos normales: simular_intervalos <- function(rep, size = 150){ muestra_casas <- slice_sample(poblacion_casas, n = size) N <- nrow(poblacion_casas) n <- nrow(muestra_casas) total_est <- (N / n) * sum(muestra_casas$precio_miles) # paso 1: define el estimador calc_estimador_casas <- function(datos){ total_muestra <- sum(datos$precio_miles) estimador_total <- (N / n) * total_muestra estimador_total } # paso 2: define el proceso de remuestreo muestra_boot <- function(datos){ #tomar muestra con reemplazo del mismo tamaño slice_sample(datos, prop = 1, replace = TRUE) } # paso 3: remuestrea y calcula el estimador totales_boot <- map_dbl(1:2000, ~ calc_estimador_casas(muestra_boot(muestra_casas))) |> tibble(total_boot = .) |> summarise(ee_boot = sd(total_boot)) |> mutate(inf = total_est - 2*ee_boot, sup = total_est + 2*ee_boot) |> mutate(rep = rep) totales_boot } # Para recrear, correr: # sims_intervalos <- map(1:100, ~ simular_intervalos(rep = .x)) # write_rds(sims_intervalos, "cache/sims_intervalos.rds") # Para usar resultados en cache: sims_intervalos <- read_rds("cache/sims_intervalos.rds") total <- sum(poblacion_casas$precio_miles) sims_tbl <- sims_intervalos |> bind_rows() |> mutate(cubre = inf < total & total < sup) ggplot(sims_tbl, aes(x = rep)) + geom_hline(yintercept = total, colour = "red") + geom_linerange(aes(ymin = inf, ymax = sup, colour = cubre)) La cobertura para estos 100 intervalos simulados da total <- sum(poblacion_casas$precio_miles) sims_tbl |> summarise(cobertura = mean(cubre)) ## # A tibble: 1 × 1 ## cobertura ## <dbl> ## 1 0.96 que es consistente con una cobertura real del 95% (¿qué significa “consistente”? ¿Cómo puedes checarlo con el bootstrap?) Observación. En este caso teníamos la población real, y pudimos verificar la cobertura de nuestros intervalos. En general no la tenemos. Estos ejercicios de simulación se pueden hacer con poblaciones sintéticas que se generen con las características que creemos va a tener nuestra población (por ejemplo, sesgo, colas largas, etc.). En general, no importa qué tipo de estimadores o intervalos de confianza usemos, requerimos checar la calibración. Esto puede hacerse con ejercicios de simulación con poblaciones sintéticas y tanto los procedimientos de muestreo como los tamaños de muestra que nos interesa usar. Verificar la cobertura de nuestros intervalos de confianza por medio simulación está bien estudiado para algunos casos. Por ejemplo, cuando trabajamos con estimaciones para poblaciones teóricas. En general sabemos que los procedimientos funcionan bien en casos: con distribuciones simétricas que tengan colas no muy largas; estimación de proporciones donde no tratamos con casos raros o casos seguros (probabilidades cercanas a 0 o 1). Interpretación de intervalos de confianza Como hemos visto, “intervalo de confianza” (de 90% de confianza, por ejemplo) es un término frecuentista, que significa: Cada muestra produce un intervalo distinto. Para el 90% de las muestras posibles, el intervalo cubre al valor poblacional. La afirmación es sobre el intervalo y el mecanismo para construirlo. Así que con alta probabilidad, el intervalo contiene el valor poblacional. Intervalos más anchos nos dan más incertidumbre acerca de dónde está el verdadero valor poblacional (y al revés para intervalos más angostos). Existen también “intervalos de credibilidad” (de 90% de probabilidad, por ejemplo), que se interpetan de forma bayesiana: Con 90% de probabilidad (relativamente alta), creemos que el valor poblacional está dentro del intervalo de credibilidad. Esta última interpretación es más natural. Obsérvese que para hablar de intervalos de confianza frecuentista tenemos que decir: Este intervalo particular cubre o no al verdadero valor, pero nuestro procedimiento produce intervalos que contiene el verdadero valor para el 90% de las muestras. Esta es una interpretación relativamente débil, y muchos intervalos poco útiles pueden satisfacerla. La interpretación bayesiana es más natural porque expresa más claramente incertidumbre acerca del valor poblacional. Por otro lado, La interpretación frecuentista nos da maneras empíricas de probar si los intervalos de confianza están bien calibrados o no: es un mínimo que “intervalos del 90%” deberían satisfacer. Así que tomamos el punto de vista bayesiano en la intepretación, pero buscamos que nuestros intervalos cumplan o aproximen bien garantías frecuentistas (discutimos esto más adelante). Los intervalos que producimos en esta sección pueden interpretarse de las dos maneras. Sesgo Notemos que hemos revisado el sesgo en varias ocasiones, esto es porque algunos estimadores comunes (por ejemplo, cociente de dos cantidades aleatorias) pueden sufrir de sesgo grande, especialmente en el caso de muestras chicas. Esto a su vez afecta la cobertura, pues es posible que nuestros intervalos no tengan “cobertura simétrica”, por ejemplo. Para muchos estimadores, y muestras no muy chicas, esté sesgo tiende a ser poco importante y no es necesario hacer correcciones. Si el tamaño del sesgo es grande comparado con la dispersión de la distribución bootstrap generalmente consideramos que bajo el diseño actual el estimador que estamos usando no es apropiado, y podemos proponer otro estimador u otro procedimiento para construir intervalos (ver Efron and Tibshirani (1993) intervalos BC_{a}), Efron and Tibshirani (1993) sugieren más de 20% de la desviación estándar, mientras que en Chihara and Hesterberg (2018) se sugiere 2% de la desviación estándar. Dependiendo que tan crítico es que los intervalos estén bien calibrados podemos evaluar nuestro problema particular. Intervalos bootstrap de percentiles Retomemos nuestro ejemplo del valor total del precio de las casas. A través de remuestras bootstrap hemos verificado gráficamente que la distribución de remuestreo es ligeramente asimétrica (ver la figura de abajo). Anteriormente hemos calculado intervalos de confianza basados en supuestos normales por medio del error éstandar. Este intervalo está dado por ## [1] 203.4 232.3 y por construcción sabemos que es simétrico con respecto al valor estimado, pero como podemos ver la distribución de muestreo no es simétrica, lo cual podemos confirmar por ejemplo calculando el porcentaje de muestras bootstrap que caen por arriba y por debajo del intervalo construido: ## # A tibble: 1 × 2 ## prop_inf prop_sup ## <dbl> <dbl> ## 1 0.0192 0.026 los cuales se han calculado como el porcentaje de medias bootstrap por debajo (arriba) de la cota inferior (superior), y vemos que no coinciden con el nivel de confianza prestablecido (2.5% para cada extremo). Otra opción común que se usa específicamente cuando la distribución bootstrap no es muy cercana a la normal son los intervalos de percentiles bootstrap: Definición. El intervalo de percentiles bootstrap al 95% de confianza está dado por \\[[q_{0.025}, q_{0.975}]\\] donde \\(q_f\\) es el percentil \\(f\\) de la distribución bootstrap. Otros intervalos comunes son el de 80% o 90% de confianza, por ejemplo, que corresponden a \\([q_{0.10}, q_{0.90}]\\) y \\([q_{0.05}, q_{0.95}]\\). Ojo: intervalos de confianza muy alta (por ejemplo 99.5%) pueden tener mala calibración o ser muy variables en su longitud pues dependen del comportamiento en las colas de la distribución. Para el ejemplo de las casas, calcularíamos simplemente intervalo_95 <- totales_boot |> pull(total_boot) |> quantile(probs = c(0.025, 0.975)) / 1000 (intervalo_95) |> round(1) ## 2.5% 97.5% ## 204.3 232.5 que está en millones de dólares. Nótese que es similar al intervalo de error estándar. Otro punto interesante sobre los intervalos bootstrap de percentiles es que lidian naturalmente con la asímetría de la distribución bootstrap. Ilustramos esto con la distancia de las extremos del intervalo con respecto a la media: abs(intervalo_95 - total_est/1000) ## 2.5% 97.5% ## 13.53912 14.64674 Los intervalos de confianza nos permiten presentar un rango de valores posibles para el parámetro de interés. Esto es una notable diferencia con respecto a presentar sólo un candidato como estimador. Nuestra fuente de información son los datos. Es por esto que si vemos valores muy chicos (grandes) en nuestra muestra, el intervalo se tiene que extender a la izquierda (derecha) para compensar dichas observaciones. Explica por qué cuando la aproximación normal es apropiada, el intervalo de percentiles al 95% es muy similar al intervalo normal de 2 errores estándar. Ejemplo Consideramos los datos de propinas. Queremos estimar la media de cuentas totales para la comida y la cena. Podemos hacer bootstrap de cada grupo por separado: # en este ejemplo usamos rsample, pero puedes # escribir tu propio código library(rsample) propinas <- read_csv("data/propinas.csv") estimador <- function(split, ...){ muestra <- analysis(split) |> group_by(momento) muestra |> summarise(estimate = mean(cuenta_total), .groups = 'drop') |> mutate(term = momento) } intervalo_propinas_90 <- bootstraps(propinas, strata = momento, 1000) |> mutate(res_boot = map(splits, estimador)) |> int_pctl(res_boot, alpha = 0.10) |> mutate(across(where(is.numeric), round, 2)) intervalo_propinas_90 ## # A tibble: 2 × 6 ## term .lower .estimate .upper .alpha .method ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> ## 1 Cena 19.8 20.8 22.0 0.1 percentile ## 2 Comida 15.6 17.1 18.8 0.1 percentile Nota: .estimate es la media de los valores de la estadística sobre las remuestras, no es el estimador original. De la tabla anterior inferimos que la media en la cuenta en la cena es más grande que la de la comida. Podemos graficar agregando los estimadores plugin: estimadores <- propinas |> group_by(momento) |> rename(term = momento) |> summarise(media = mean(cuenta_total)) ggplot(intervalo_propinas_90, aes(x = term)) + geom_linerange(aes(ymin = .lower, ymax = .upper)) + geom_point(data = estimadores, aes(y = media), colour = "red", size = 3) + xlab("Momento") + ylab("Media de cuenta total (dólares)") + labs(subtitle = "Intervalos de 90% para la media") Nótese que el bootstrap lo hicimos por separado en cada momento del día (por eso el argumento strata en la llamada a bootstraps): Justifica el procedimiento de hacer el bootstrap separado para cada grupo. ¿Qué supuestos acerca del muestreo se deben satisfacer? ¿Deben ser muestras aleatorias simples de cada momento del día, por ejemplo? ¿Qué harías si no fuera así, por ejemplo, si se escogieron al azar tickets de todos los disponibles en un periodo? Bootstrap para dos muestras En el ejemplo anterior consideramos cómo hacer bootstrap cuando tenemos muestras independientes. También podemos aplicarlo a estimadores que comparen directamente las dos muestras: Bootstrap para comparar poblaciones. Dadas muestras independientes de tamaños \\(m\\) y \\(n\\) de dos poblaciones: Extraer una remuestra de tamaño \\(m\\) con reemplazo de la primera muestra y una remuestra separada de tamaño \\(n\\) de la segunda muestra. Calcula la estadística que compara los dos grupos (por ejemplo, diferencia de medias) Repetir este proceso muchas veces (por ejemplo, 1000 - 10000). Construir la distribución bootstrap de la estadística. Examinar dispersión, sesgo y forma. Ejemplo Supongamos que queremos comparar directamente la media de la cuenta total en comida y cena. Podemos hacer: estimador_dif <- function(split, ...){ muestra <- analysis(split) |> group_by(momento) muestra |> summarise(estimate = mean(cuenta_total), .groups = "drop") |> pivot_wider(names_from = momento, values_from = estimate) |> mutate(estimate = Cena - Comida, term = "diferencia") } dist_boot <- bootstraps(propinas, strata = momento, 2000) |> mutate(res_boot = map(splits, estimador_dif)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) + xlab("Diferencia Comida vs Cena") g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 Y podemos calcular un intervalo de confianza para la diferencia de medias: dist_boot |> int_pctl(res_boot, alpha = 0.01) |> mutate(across(where(is.numeric), round, 2)) |> select(term, .lower, .upper) ## # A tibble: 1 × 3 ## term .lower .upper ## <chr> <dbl> <dbl> ## 1 diferencia 0.73 6.54 Que nos indica que con alta probabilidad las cuentas son más altas que en la cena que en la comida. La diferencia puede ir de un poco menos de un dólar hasta seis dólares con 99% de confianza. Datos pareados En otros casos, las muestras no son independientes y están pareadas. Por ejemplo, este es un estudio dende a 10 personas una noche se les dio una medicina para dormir y otra noche otra medicina. Se registraron cuántas horas de sueño extra comparados con un día donde no tomaron medicina. dormir <- sleep |> pivot_wider(names_from = group, names_prefix = "medicina_", values_from = extra) dormir ## # A tibble: 10 × 3 ## ID medicina_1 medicina_2 ## <fct> <dbl> <dbl> ## 1 1 0.7 1.9 ## 2 2 -1.6 0.8 ## 3 3 -0.2 1.1 ## 4 4 -1.2 0.1 ## 5 5 -0.1 -0.1 ## 6 6 3.4 4.4 ## 7 7 3.7 5.5 ## 8 8 0.8 1.6 ## 9 9 0 4.6 ## 10 10 2 3.4 En este caso, el bootstrap se hace sobre individuos, y quisiéramos comparar la medición de la medicina_1 con la medicina_2. Usaremos la media de al diferencia entre horas de sueño entre las dos medicinas. Nuestro estimador puntual es: estimador_dif <- dormir |> mutate(dif_2_menos_1 = medicina_2 - medicina_1) |> summarise(dif_media = mean(dif_2_menos_1)) estimador_dif ## # A tibble: 1 × 1 ## dif_media ## <dbl> ## 1 1.58 Esto indica que en promedio duermen hora y media más con la medicina 2 que con la medicina 1. Como hay variabilildad considerable en el número de horas extra de cada medicina dependiendo del individuo, es necesario hacer una intervalo de confianza para descartar que esta diferencia haya aparecido por azar debido a la variación muestral. Nótese que aquí no tenemos estratos, pues solo hay una muestra de individuo con dos mediciones. estimador_dif <- function(split, ...){ muestra <- analysis(split) muestra |> mutate(dif_2_menos_1 = medicina_2 - medicina_1) |> summarise(estimate = mean(dif_2_menos_1), .groups = "drop") |> mutate(term = "diferencia 2 vs 1") } dist_boot <- bootstraps(dormir, 2000) |> mutate(res_boot = map(splits, estimador_dif)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 Nuestro intervalo de percentiles al 90% es de dist_boot |> int_pctl(res_boot, 0.10) ## # A tibble: 1 × 6 ## term .lower .estimate .upper .alpha .method ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> ## 1 diferencia 2 vs 1 1.04 1.57 2.22 0.1 percentile Lo que indica con alta probabilidad que la medicina 2 da entre 1 y 2 horas extras de sueño. Nota que en este ejemplo también podríamos hacer una prueba de hipótesis por permutaciones, suponiendo como hipótesis nula que las dos medicinas son equivalentes. Sin embargo, usualmente es más informativo presentar este tipo de intervalos para estimar la diferencia. Bootstrap y otras estadísticas El bootstrap es una técnica versátil. Un ejemplo son estimadores de razón, que tienen la forma \\[ \\hat{r} = \\frac{\\overline y}{\\overline x}\\] Por ejemplo, ¿cómo haríamos estimación para el procentaje de área area habitable de las casas en relación al tamaño del lote? Una manera de estimar esta cantidad es dividiendo la suma del área habitable de nuestra muestra y dividirlo entre la suma del área de los lotes de nuestra muestra, como en la fórmula anterior. Esta fórmula es más difícil pues tanto numerador como denominador tienen variabilidad, y estas dos cantidades no varían independientemente. Con el bootstrap podemos atacar estos problemas Ejemplo: estimadores de razón Nuestra muestra original es: set.seed(250) casas_muestra <- slice_sample(poblacion_casas, n = 200) El estimador de interés es: estimador_razon <- function(split, ...){ muestra <- analysis(split) muestra |> summarise(estimate = sum(area_habitable_sup_m2) / sum(area_lote_m2), .groups = "drop") |> mutate(term = "% area del lote construida") } Y nuestra estimación puntual es estimacion <- muestra_casas |> summarise(estimate = sum(area_habitable_sup_m2) / sum(area_lote_m2)) estimacion ## # A tibble: 1 × 1 ## estimate ## <dbl> ## 1 0.148 Es decir que en promedio, un poco más de 15% del lote total es ocupado por área habitable. Ahora hacemos bootstrap para construir un intervalo: dist_boot <- bootstraps(casas_muestra, 2000) |> mutate(res_boot = map(splits, estimador_razon)) g_1 <- ggplot(dist_boot |> unnest(res_boot), aes(x = estimate)) + geom_histogram(bins = 20) g_2 <- ggplot(dist_boot |> unnest(res_boot), aes(sample = estimate)) + geom_qq() + geom_qq_line(colour = 'red') g_1 + g_2 En este caso la cola derecha parece tener menos dispersión que una distribución normal. Usamos un intervalo de percentiles para obtener: dist_boot |> int_pctl(res_boot) |> mutate(estimador = estimacion$estimate) |> rename(media_boot = .estimate) |> mutate(bias = media_boot - estimador) |> pivot_longer(is_double) |> mutate(value = round(value, 3)) ## # A tibble: 6 × 4 ## term .method name value ## <chr> <chr> <chr> <dbl> ## 1 % area del lote construida percentile .lower 0.121 ## 2 % area del lote construida percentile media_boot 0.142 ## 3 % area del lote construida percentile .upper 0.159 ## 4 % area del lote construida percentile .alpha 0.05 ## 5 % area del lote construida percentile estimador 0.148 ## 6 % area del lote construida percentile bias -0.006 De modo que en esta zona, entre 12% y 16% de toda el área disponible es ocupada por área habitable: estas son casas que tienen jardines o terrenos, garage relativamente grandes. Ejemplo: suavizadores Podemos usar el bootstrap para juzgar la variabilidad de un suavizador, que consideramos como nuestra estadística: graf_casas <- function(data){ ggplot(data |> filter(calidad_gral < 7), aes(x = area_habitable_sup_m2)) + geom_point(aes(y = precio_m2_miles), alpha = 0.75) + geom_smooth(aes(y = precio_m2_miles), method = "loess", span = 0.7, se = FALSE, method.args = list(degree = 1, family = "symmetric")) } graf_casas(casas_muestra) Podemos hacer bootstrap para juzgar la estabilidad del suavizador: suaviza_boot <- function(x, data){ # remuestreo muestra_boot <- slice_sample(data, prop = 1, replace = T) ajuste <- loess(precio_m2_miles ~ area_habitable_sup_m2, data = muestra_boot, degree = 1, span = 0.7, family = "symmetric") datos_grafica <- tibble(area_habitable_sup_m2 = seq(25, 250, 5)) ajustados <- predict(ajuste, newdata = datos_grafica) datos_grafica |> mutate(ajustados = ajustados) |> mutate(rep = x) } reps <- map(1:10, ~ suaviza_boot(.x, casas_muestra |> filter(calidad_gral < 7))) |> bind_rows() # ojo: la rutina loess no tienen soporte para extrapolación graf_casas(casas_muestra) + geom_line(data = reps, aes(y = ajustados, group = rep), alpha = 1, colour = "red") Donde vemos que algunas cambios de pendiente del suavizador original no son muy interpretables (por ejemplo, para áreas chicas) y alta variabilidad en general en los extremos. Podemos hacer más iteraciones para calcular bandas de confianza: reps <- map(1:200, ~ suaviza_boot(.x, casas_muestra |> filter(calidad_gral < 7))) |> bind_rows() # ojo: la rutina loess no tienen soporte para extrapolación graf_casas(casas_muestra) + geom_line(data = reps, aes(y = ajustados, group = rep), alpha = 0.2, colour = "red") Donde observamos cómo tenemos incertidumbre en cuanto al nivel y forma de las curvas en los extremos de los datos (casas grandes y chicas), lo cual es natural. Aunque podemos resumir para hacer bandas de confianza, mostrar remuestras de esta manera es informativo: por ejempo: vemos cómo es probable también que para casas de menos de 70 metros cuadrados el precio por metro cuadrado no cambia tanto (líneas constantes) Bootstrap y estimadores complejos: tablas de perfiles Podemos regresar al ejemplo de la primera sesión donde calculamos perfiles de los tomadores de distintos tés: en bolsa, suelto, o combinados. Caundo hacemos estos tipos de análisis no es raro que los prefiles tengan variabilidad considerable que es necesario cuantificar. price tea bag tea bag+unpackaged unpackaged promedio p_upscale -0.71 -0.28 0.98 28 p_variable -0.12 0.44 -0.31 36 p_cheap 0.3 -0.53 0.23 2 p_branded 0.62 -0.16 -0.45 25 p_private label 0.72 -0.22 -0.49 5 p_unknown 1.58 -0.58 -1 3 Hacemos bootstrap sobre toda la muestra, y repetimos exactamente el mismo proceso de construción de perfiles: boot_perfiles <- map(1:1000, function(x){ te_boot <- te |> slice_sample(prop = 1, replace = TRUE) calcular_perfiles(te_boot) |> mutate(rep = x) }) |> bind_rows() Ahora resumimos y graficamos, esta vez de manera distinta: resumen_perfiles <- boot_perfiles |> group_by(how, price) |> summarise(perfil_media = mean(perfil), ymax = quantile(perfil, 0.9), ymin = quantile(perfil, 0.10)) resumen_bolsa <- resumen_perfiles |> ungroup() |> filter(how == "tea bag") |> select(price, perfil_bolsa = perfil_media) resumen_perfiles <- resumen_perfiles |> left_join(resumen_bolsa) |> ungroup() |> mutate(price = fct_reorder(price, perfil_bolsa)) ggplot(resumen_perfiles, aes(x = price, y = perfil_media, ymax = ymax, ymin = ymin)) + geom_point(colour = "red") + geom_linerange() + facet_wrap(~how) + coord_flip() + geom_hline(yintercept = 0, colour = "gray") + ylab("Perfil") + xlab("Precio") Nótese una deficiencia clara del bootstrap: para los que compran té suelto, en la muestra no existen personas que desconocen de dónde provienen su té (No sabe/No contestó). Esto produce un intervalo colapsado en 0 que no es razonable. Podemos remediar esto de varias maneras: quitando del análisis los que no sabe o no contestaron, agrupando en otra categoría, usando un modelo, o regularizar usando proporciones calculadas con conteos modificados: por ejemplo, agregando un caso de cada combinación (agregaría 18 personas “falsas” a una muestra de 290 personas). Bootstrap y muestras complejas La necesidad de estimaciones confiables junto con el uso eficiente de recursos conllevan a diseños de muestras complejas. Estos diseños típicamente usan las siguientes técnicas: muestreo sin reemplazo de una población finita, muestreo sistemático, estratificación, conglomerados, ajustes a no-respuesta, postestratificación. Como consecuencia, los valores de la muestra suelen no ser independientes y los análisis de los mismos dependerá del diseño de la muestra. Comenzaremos con definiciones para entender el problema. set.seed(3872999) n_escuelas <- 5000 tipo <- sample(c("rural", "urbano", "indigena"), n_escuelas, replace = TRUE, prob = c(0.3, 0.5, 0.2)) escuela <- tibble(ind_escuela = 1:n_escuelas, tipo, media_tipo = case_when(tipo == "urbano" ~ 550, tipo == "rural" ~ 400, TRUE ~ 350), media_escuela = rnorm(n_escuelas, media_tipo, 30), n_estudiantes = round(rnorm(n_escuelas, 30, 4))) estudiantes <- uncount(escuela, n_estudiantes, .id = "id_estudiante") %>% rowwise() %>% mutate(calif = rnorm(1, media_escuela, 70)) %>% ungroup() Imaginemos que tenemos una población de 5000 escuelas, y queremos estimar la media de las calificaciones de los estudiantes en una prueba. head(estudiantes) ## # A tibble: 6 × 6 ## ind_escuela tipo media_tipo media_escuela id_estudiante calif ## <int> <chr> <dbl> <dbl> <int> <dbl> ## 1 1 urbano 550 561. 1 488. ## 2 1 urbano 550 561. 2 574. ## 3 1 urbano 550 561. 3 456. ## 4 1 urbano 550 561. 4 507. ## 5 1 urbano 550 561. 5 598. ## 6 1 urbano 550 561. 6 527. La primera idea sería tomar una muestra aleatoria (MAS, muestreo aleatorio simple), donde todos los estudiantes tienen igual probabilidad de ser seleccionados. Con estas condiciones el presupuesto alcanza para seleccionar a 60 estudiantes, hacemos esto y calculamos la media. muestra <- slice_sample(estudiantes, n = 60) round(mean(muestra$calif), 2) ## [1] 466.73 Este número es muy cercano a la media verdadera de la población: 466.51, pero esta es una de muchas posibles muestras. medias_mas <- rerun(1000, mean(sample(estudiantes$calif, 60))) %>% flatten_dbl() sd(medias_mas) ## [1] 14.75242 hist_mas <- ggplot(tibble(medias_mas), aes(x = medias_mas)) + geom_histogram(binwidth = 10) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_mas <- ggplot(tibble(medias_mas), aes(sample = medias_mas)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_mas + qq_mas Algunas de las muestras generan valores alejados de la verdadera media, para minimizar la probabilidad de seleccionar muestras que lleven a estimaciones alejadas del verdadero valor poblacional podríamos tomar muestras más grandes. Pero usualmente los costos limitan el tamaño de muestra. Una alternativa es estratificar, supongamos que sabemos el tipo de cada escuela (urbana, rural o indígena) y sabemos también que la calificación de los estudiantes de escuelas urbanas tiende a ser distinta a las calificaciones que los estudiantes de escuelas rurales o indígenas. En esta caso un diseño más eficiente consiste en tomar muestras independientes dentro de cada estrato. muestra_estrat <- estudiantes %>% group_by(tipo) %>% sample_frac(0.0004) dim(muestra_estrat) ## [1] 60 6 muestrea_estrat <- function(){ muestra <- estudiantes %>% group_by(tipo) %>% sample_frac(0.0004) mean(muestra$calif) } medias_estrat <- rerun(1000, muestrea_estrat()) %>% flatten_dbl() Notamos que la distribución muestral está más concentrada que el caso de MAS, el error estándar se reduce de 14.75 a 10.2 hist_estrat <- ggplot(tibble(medias_estrat), aes(x = medias_estrat)) + geom_histogram(binwidth = 6) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_estrat <- ggplot(tibble(medias_estrat), aes(sample = medias_estrat)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_estrat + qq_estrat Entonces, la estratificación nos sirve para reducir el error estándar de las estimaciones. Otro procedimiento común en muestreo es introducir conglomerados, a diferencia del muestreo estratificado, el propósito principal de los conglomerados es reducir costos. Veamos cuantas escuelas tendría que visitar en una muestra dada (con diseño estratificado). n_distinct(muestra_estrat$ind_escuela) ## [1] 60 Es fácil ver que visitar una escuela para aplicar solo uno o dos exámenes no es muy eficiente en cuestión de costos. Es por ello que se suelen tomar muestras considerando conglomerados naturales, en este caso la escuela. En nuestro ejemplo es razonable suponer que una parte grande del costo del muestreo sea mandar al examinador a la escuela, y que una vez en la escuela el costo de evaluar a todo sexto, en lugar de a un único alumno, es relativamente bajo. Podemos imaginar que considerando estos costos por visita de escuela nos alcance para visitar 40 escuelas y en cada una examinar a todos los estudiantes. muestra_escuelas <- escuela %>% group_by(tipo) %>% sample_frac(size = 0.008) muestra_cgl <- muestra_escuelas %>% left_join(estudiantes) mean(muestra_cgl$calif) ## [1] 462.5677 muestrea_cgl <- function(){ muestra_escuelas <- escuela %>% group_by(tipo) %>% sample_frac(size = 0.008) muestra_cgl <- muestra_escuelas %>% left_join(estudiantes, by = c("ind_escuela", "tipo")) mean(muestra_cgl$calif) } medias_cgl <- rerun(1000, muestrea_cgl()) %>% flatten_dbl() En este caso, el número de estudiantes examinados es mucho mayor que en MAS y muestreo estratificado, notemos que el número de estudiantes evaluados cambiará de muestra a muestra dependiendo del número de alumnos en las escuelas seleccionadas. sd(medias_cgl) ## [1] 5.337327 hist_cgl <- ggplot(tibble(medias_cgl), aes(x = medias_cgl)) + geom_histogram(binwidth = 6) + geom_vline(xintercept = mean(estudiantes$calif), color = "red") + xlim(410, 520) qq_cgl <- ggplot(tibble(medias_cgl), aes(sample = medias_cgl)) + geom_qq(distribution = stats::qunif) + ylim(410, 520) hist_cgl + qq_cgl Ejemplo: ENIGH La complejidad de los diseños de encuestas conlleva a que el cálculo de errores estándar sea muy complicado, para atacar este problema hay dos técnicas básicas: 1) un enfoque analítico usando linearización, 2) métodos de remuestreo como bootstrap. El incremento en el poder de cómputo ha favorecido los métodos de remuestreo pues la linearización requiere del desarrollo de una fórmula para cada estimación y supuestos adicionales para simplificar. En 1988 Rao and Wu (1988) propusieron un método de bootstrap para diseños estratificados multietápicos con reemplazo de UPMs (Unidades Primarias de Muestreo) que describimos a continuación. ENIGH. Usaremos como ejemplo la Encuesta Nacional de Ingresos y Gastos de los Hogares, ENIGH 2018 (INEGI 2018), esta encuesta usa un diseño de conglomerados estratificado. Antes de proceder a bootstrap debemos entender como se seleccionaron los datos, esto es, el diseño de la muestra: Unidad primaria de muestreo (UPM). Las UPMs están constituidas por agrupaciones de viviendas. Se les denomina unidades primarias pues corresponden a la primera etapa de selección, las unidades secundarias (USMs) serían los hogares. Estratificación. Los estratos se construyen en base a estado, ámbito (urbano, complemento urbano, rural), características sociodemográficas de los habitantes de las viviendas, características físicas y equipamiento. El proceso de estratificación resulta en 888 subestratos en todo el ámbito nacional. La selección de la muestra es independiente para cada estrato, y una vez que se obtiene la muestra se calculan los factores de expansión que reflejan las distintas probabilidades de selección. Después se llevan a cabo ajustes por no respuesta y por proyección (calibración), esta última busca que distintos dominios de la muestra coincidan con la proyección de población de INEGI. concentrado_hogar <- read_csv(here::here("data", "conjunto_de_datos_enigh_2018_ns_csv", "conjunto_de_datos_concentradohogar_enigh_2018_ns", "conjunto_de_datos", "conjunto_de_datos_concentradohogar_enigh_2018_ns.csv")) # seleccionar variable de ingreso corriente hogar <- concentrado_hogar %>% mutate( upm = as.integer(upm), edo = str_sub(ubica_geo, 1, 2) ) %>% select(folioviv, foliohog, est_dis, upm, factor, ing_cor, edad_jefe, edo) %>% group_by(est_dis) %>% mutate(n = n_distinct(upm)) %>% # número de upms por estrato ungroup() hogar ## # A tibble: 74,647 × 9 ## folioviv foliohog est_dis upm factor ing_cor edad_jefe edo n ## <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <chr> <int> ## 1 100013601 1 2 1 175 76404. 74 10 106 ## 2 100013602 1 2 1 175 42988. 48 10 106 ## 3 100013603 1 2 1 175 580698. 39 10 106 ## 4 100013604 1 2 1 175 46253. 70 10 106 ## 5 100013606 1 2 1 175 53837. 51 10 106 ## 6 100026701 1 2 2 189 237743. 41 10 106 ## 7 100026703 1 2 2 189 32607. 57 10 106 ## 8 100026704 1 2 2 189 169918. 53 10 106 ## 9 100026706 1 2 2 189 17311. 30 10 106 ## 10 100027201 1 2 3 186 120488. 69 10 106 ## # ℹ 74,637 more rows Para el cálculo de estadísticos debemos usar los factores de expansión, por ejemplo el ingreso trimestral total sería: sum(hogar$factor * hogar$ing_cor / 1000) ## [1] 1723700566 y ingreso trimestral medio (miles pesos) sum(hogar$factor * hogar$ing_cor / 1000) / sum(hogar$factor) ## [1] 49.61029 La estimación del error estándar, por otro lado, no es sencilla y requiere usar aproximaciones, en la metodología de INEGI proponen una aproximación con series de Taylor. Figure 5.3: Extracto de estimación de errores de muestreo, ENIGH 2018. Veamos ahora como calcular el error estándar siguiendo el bootstrap de Rao y Wu: En cada estrato se seleccionan con reemplazo \\(m_h\\) UPMs de las \\(n_h\\) de la muestra original. Denotamos por \\(m_{hi}^*\\) el número de veces que se seleccionó la UPM \\(i\\) en el estrato \\(h\\) (de tal manera que \\(\\sum m_{hi}^*=m_h\\)). Creamos una replicación del ponderador correspondiente a la \\(k\\)-ésima unidad (USM) como: \\[d_k^*=d_k \\bigg[\\bigg(1-\\sqrt{\\frac{m_h}{n_h - 1}}\\bigg) + \\bigg(\\sqrt{\\frac{m_h}{n_h - 1}}\\frac{n_h}{m_h}m_{h}^*\\bigg)\\bigg]\\] donde \\(d_k\\) es el inverso de la probabilidad de selección. Si \\(m_h <(n_h -1)\\) todos los pesos definidos de esta manera serán no negativos. Calculamos el peso final \\(w_k^*\\) aplicando a \\(d_k^*\\) los mismos ajustes que se hicieron a los ponderadores originales. Calculamos el estadístico de interés \\(\\hat{\\theta}\\) usando los ponderadores \\(w_k^*\\) en lugar de los originales \\(w_k\\). Repetimos los pasos 1 y 2 \\(B\\) veces para obtener \\(\\hat{\\theta}^{*1},\\hat{\\theta}^{*2},...,\\hat{\\theta}^{*B}\\). Calculamos el error estándar como: \\[\\hat{\\textsf{se}}_B = \\bigg\\{\\frac{\\sum_{b=1}^B[\\hat{\\theta}^*(b)-\\hat{\\theta}^*(\\cdot)]^2 }{B}\\bigg\\}^{1/2}\\] En principio podemos elegir cualquier valor de \\(m_h \\geq 1\\), el más común es elegir \\(m_h=n_h-1\\), en este caso: \\[d_k^*=d_k \\frac{n_h}{n_h-1}m_{hi}^*\\] en este escenario las unidades que no se incluyen en la muestra tienen un valor de cero como ponderador. Si elegimos \\(n_h \\ne n_h-1\\) las unidades que no están en la muestra tienen ponderador distinto a cero, si \\(m_h=n_h\\) el ponderador podría tomar valores negativos. Implementemos el bootstrap de Rao y Wu a la ENIGH, usaremos \\(m_h=n_h-1\\) # creamos una tabla con los estratos y upms est_upm <- hogar %>% distinct(est_dis, upm, n) %>% arrange(est_dis, upm) hogar_factor <- est_upm %>% group_by(est_dis) %>% # dentro de cada estrato tomamos muestra (n_h-1) sample_n(size = first(n) - 1, replace = TRUE) %>% add_count(est_dis, upm, name = "m_hi") %>% # calculamos m_hi* left_join(hogar, by = c("est_dis", "upm", "n")) |> mutate(factor_b = factor * m_hi * n / (n - 1)) # unimos los pasos anteriores en una función para replicar en cada muestra bootstrap svy_boot <- function(est_upm, hogar){ m_hi <- est_upm %>% group_split(est_dis) %>% map(~sample(.$upm, size = first(.$n) - 1, replace = TRUE)) %>% flatten_int() %>% plyr::count() %>% select(upm = x, m_h = freq) m_hi %>% left_join(hogar, by = c("upm")) %>% mutate(factor_b = factor * m_h * n / (n - 1)) } set.seed(1038984) boot_rep <- rerun(500, svy_boot(est_upm, hogar)) # Aplicación a ingreso medio wtd_mean <- function(w, x, na.rm = FALSE) { sum(w * x, na.rm = na.rm) / sum(w, na.rm = na.rm) } # La media es: hogar %>% summarise(media = wtd_mean(factor, ing_cor)) ## # A tibble: 1 × 1 ## media ## <dbl> ## 1 49610. Y el error estándar: map_dbl(boot_rep, ~wtd_mean(w = .$factor_b, x = .$ing_cor)) %>% quantile(c(0.025, 0.975)) ## 2.5% 97.5% ## 48742.12 50519.02 El método bootstrap está implementado en el paquete survey y más recientemente en srvyr que es una versión tidy que utiliza las funciones en survey. Podemos comparar nuestros resultados con la implementación en survey. # 1. Definimos el diseño de la encuesta library(survey) library(srvyr) enigh_design <- hogar %>% as_survey_design(ids = upm, weights = factor, strata = est_dis) # 2. Elegimos bootstrap como el método para el cálculo de errores estándar set.seed(7398731) enigh_boot <- enigh_design %>% as_survey_rep(type = "bootstrap", replicates = 500) # 3. Así calculamos la media enigh_boot %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor)) ## # A tibble: 1 × 2 ## mean_ingcor mean_ingcor_se ## <dbl> <dbl> ## 1 49610. 468. enigh_boot %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor, vartype = "ci")) ## # A tibble: 1 × 3 ## mean_ingcor mean_ingcor_low mean_ingcor_upp ## <dbl> <dbl> <dbl> ## 1 49610. 48690. 50530. # por estado enigh_boot %>% group_by(edo) %>% srvyr::summarise(mean_ingcor = survey_mean(ing_cor)) ## # A tibble: 30 × 3 ## edo mean_ingcor mean_ingcor_se ## <chr> <dbl> <dbl> ## 1 10 50161. 995. ## 2 11 46142. 1241. ## 3 12 29334. 1063. ## 4 13 38783. 1019. ## 5 14 60541. 1924. ## 6 15 48013. 1359. ## 7 16 42653. 1393. ## 8 17 42973. 1601. ## 9 18 48148. 1967. ## 10 19 68959. 4062. ## # ℹ 20 more rows Resumiendo: El bootstrap de Rao y Wu genera un estimador consistente y aproximadamente insesgado de la varianza de estadísticos no lineales y para la varianza de un cuantil. Este método supone que la seleccion de UPMs es con reemplazo; hay variaciones del estimador bootstrap de Rao y Wu que extienden el método que acabamos de estudiar; sin embargo, es común ignorar este aspecto, por ejemplo Mach et al estudian las propiedades del estimador de varianza bootstrap de Rao y Wu cuando la muestra se seleccionó sin reemplazo. Bootstrap en R Es común crear nuestras propias funciones cuando usamos bootstrap, sin embargo, en R también hay alternativas que pueden resultar convenientes, mencionamos 3: El paquete rsample (forma parte de la colección tidymodels) y tiene una función bootstraps() que regresa un arreglo cuadrangular (tibble, data.frame) que incluye una columna con las muestras bootstrap y un identificador del número y tipo de muestra. Veamos un ejemplo donde seleccionamos muestras del conjunto de datos muestra_computos que contiene 10,000 observaciones. library(rsample) load("data/election_2012.rda") muestra_computos <- slice_sample(election_2012, n = 10000) muestra_computos ## # A tibble: 10,000 × 23 ## state_code state_name state_abbr district_loc_17 district_fed_17 polling_id ## <chr> <chr> <chr> <int> <int> <int> ## 1 18 Nayarit NAY 11 2 86709 ## 2 27 Tabasco TAB 17 5 122035 ## 3 15 México MEX 7 35 75477 ## 4 27 Tabasco TAB 19 5 122262 ## 5 17 Morelos MOR 6 2 84733 ## 6 07 Chiapas CHPS 22 5 15376 ## 7 14 Jalisco JAL 2 2 52634 ## 8 08 Chihuahua CHIH 7 4 19097 ## 9 14 Jalisco JAL 20 20 60549 ## 10 13 Hidalgo HGO 11 4 50221 ## # ℹ 9,990 more rows ## # ℹ 17 more variables: section <int>, region <chr>, polling_type <chr>, ## # section_type <chr>, pri_pvem <int>, pan <int>, panal <int>, ## # prd_pt_mc <int>, otros <int>, total <int>, nominal_list <int>, ## # pri_pvem_pct <dbl>, pan_pct <dbl>, panal_pct <dbl>, prd_pt_mc_pct <dbl>, ## # otros_pct <dbl>, winner <chr> Generamos 100 muestras bootstrap, y la función nos regresa un arreglo con 100 renglones, cada uno corresponde a una muestra bootstrap. set.seed(839287482) computos_boot <- bootstraps(muestra_computos, times = 100) computos_boot ## # Bootstrap sampling ## # A tibble: 100 × 2 ## splits id ## <list> <chr> ## 1 <split [10000/3647]> Bootstrap001 ## 2 <split [10000/3623]> Bootstrap002 ## 3 <split [10000/3724]> Bootstrap003 ## 4 <split [10000/3682]> Bootstrap004 ## 5 <split [10000/3696]> Bootstrap005 ## 6 <split [10000/3716]> Bootstrap006 ## 7 <split [10000/3679]> Bootstrap007 ## 8 <split [10000/3734]> Bootstrap008 ## 9 <split [10000/3632]> Bootstrap009 ## 10 <split [10000/3692]> Bootstrap010 ## # ℹ 90 more rows La columna splits tiene información de las muestras seleccionadas, para la primera vemos que de 10,000 observaciones en la muestra original la primera muestra bootstrap contiene 10000-3647=6353. first_computos_boot <- computos_boot$splits[[1]] first_computos_boot ## <Analysis/Assess/Total> ## <10000/3647/10000> Y podemos obtener los datos de la muestra bootstrap con la función as.data.frame() as.data.frame(first_computos_boot) ## # A tibble: 10,000 × 23 ## state_code state_name state_abbr district_loc_17 district_fed_17 polling_id ## <chr> <chr> <chr> <int> <int> <int> ## 1 07 Chiapas CHPS 13 9 13397 ## 2 14 Jalisco JAL 15 15 58404 ## 3 09 Ciudad de M… CDMX 11 13 26471 ## 4 17 Morelos MOR 7 3 84909 ## 5 25 Sinaloa SIN 11 3 114038 ## 6 11 Guanajuato GTO 16 12 41506 ## 7 29 Tlaxcala TLAX 6 3 128006 ## 8 02 Baja Califo… BC 8 5 3901 ## 9 02 Baja Califo… BC 9 5 3779 ## 10 08 Chihuahua CHIH 19 5 19536 ## # ℹ 9,990 more rows ## # ℹ 17 more variables: section <int>, region <chr>, polling_type <chr>, ## # section_type <chr>, pri_pvem <int>, pan <int>, panal <int>, ## # prd_pt_mc <int>, otros <int>, total <int>, nominal_list <int>, ## # pri_pvem_pct <dbl>, pan_pct <dbl>, panal_pct <dbl>, prd_pt_mc_pct <dbl>, ## # otros_pct <dbl>, winner <chr> Una de las principales ventajas de usar este paquete es que es eficiente en el uso de memoria. library(pryr) object_size(muestra_computos) ## 1.41 MB object_size(computos_boot) ## 5.49 MB # tamaño por muestra object_size(computos_boot)/nrow(computos_boot) ## 54.92 kB # el incremento en tamaño es << 1000 as.numeric(object_size(computos_boot)/object_size(muestra_computos)) ## [1] 3.895024 Adicionalmente incluye funciones para el cálculo de intervalos bootstrap: intervalo_propinas_90 <- bootstraps(propinas, strata = momento, 1000) |> mutate(res_boot = map(splits, estimador)) |> int_pctl(res_boot, alpha = 0.10) El paquete boot está asociado al libro Bootstrap Methods and Their Applications (Davison and Hinkley (1997)) y tiene, entre otras, funciones para calcular replicaciones bootstrap y para construir intervalos de confianza usando bootstrap: calculo de replicaciones bootstrap con la función boot(), intervalos normales, de percentiles y \\(BC_a\\) con la función boot.ci(), intevalos ABC con la función `abc.ci(). El paquete bootstrap contiene datos usados en Efron and Tibshirani (1993), y la implementación de funciones para calcular replicaciones y construir intervalos de confianza: calculo de replicaciones bootstrap con la función bootstrap(), intervalos \\(BC_a\\) con la función bcanon(), intevalos ABC con la función abcnon(). Conclusiones y observaciones El principio fundamental del Bootstrap no paramétrico es que podemos estimar la distribución poblacional con la distribución empírica. Por tanto para hacer inferencia tomamos muestras con reemplazo de la muestra y analizamos la variación de la estadística de interés a lo largo de las remuestras. El bootstrap nos da la posibilidad de crear intervalos de confianza cuando no contamos con fórmulas para hacerlo de manera analítica y sin supuestos distribucionales de la población. Hay muchas opciones para construir intervalos bootstrap, los que tienen mejores propiedades son los intervalos \\(BC_a\\), sin embargo, los más comunes son los intervalos normales con error estándar bootstrap y los intervalos de percentiles de la distribución bootstrap. Antes de hacer intervalos normales vale la pena graficar la distribución bootstrap y evaluar si el supuesto de normalidad es razonable. En cuanto al número de muestras bootstrap se recomienda al menos \\(1,000\\) al hacer pruebas, y \\(10,000\\) o \\(15,000\\) para los resultados finales, sobre todo cuando se hacen intervalos de confianza de percentiles. La función de distribución empírica es una mala estimación en las colas de las distribuciones, por lo que es difícil construir intervalos de confianza (usando bootstrap no paramétrico) para estadísticas que dependen mucho de las colas. O en general para estadísticas que dependen de un número chico de observaciones de una muestra grande. Referencias "],["estimación-por-máxima-verosimilitud.html", "Sección 6 Estimación por máxima verosimilitud Introducción a estimación por máxima verosimilitud Máxima verosimilitud para observaciones continuas Aspectos numéricos Máxima verosimilitud para más de un parámetro", " Sección 6 Estimación por máxima verosimilitud Los ejemplos que hemos visto han sido todos de estimadores plug-in (o por sustitución): si queremos saber una cantidad poblacional, y tenemos una muestra dada, entonces calculamos la estadística de interés como si la muestra fuera la población. Por ejemplo, para estimar la mediana poblacional usamos la mediana muestral, si queremos estimar la media poblacional usamos la media muestral, y así sucesivamente. Estos estimadores usualmente dan resultados razonables (pero hay que checar usando muestra bootstraps, por ejemplo, y pensar lo que estamos haciendo). Cuando sabemos más acerca de la población y usamos un modelo teórico es posible hacer más: dependiendo de qué cantidades se quieren estimar, podemos construir estimadores que sean óptimos en algún sentido siempre y cuando se cumplan los supuestos teóricos, como veremos ahora. Por ejemplo: ¿deberíamos estimar el centro de una distribución simétrica con la media o con la mediana, o quizá con una media recortada? En esta parte construiremos la teoría básica de estimación cuando trabajamos con modelos teóricos conocidos. El objetivo es entender las ideas básicas de estos procedimientos, y cómo evaluar sus resultados. Recordatorio: las ventajas de usar modelos teóricos para describir distribuciones de datos está en que es posible comprimir más eficientemente la información, es posible construir modelos más complejos juntando varios de estos modelos y de sus dependencias, y de que es posible hacer más teoría útil que nos guíe. La desventaja es que es necesario que esos supuestos teóricos sean razonables. Introducción a estimación por máxima verosimilitud Uno de los procedimientos más estándar en esta situación es el método de máxima verosimilitud. Los estimadores de máxima verosimilitud tienen propiedades convenientes, y dan en general resultados razonables siempre y cuando los supuestos sean razonables. Máxima verosimilitud es un proceso intuitivo, y consiste en aprender o estimar valores de parámetros desconocidos suponiendo para los datos su explicación más probable. Para esto, usando supuestos y modelos, requeriremos calcular la probabilidad de un conjunto de observaciones. Ejemplo. Adaptado de (Chihara and Hesterberg 2018). Supongamos que una máquina produce dos tipos de bolsas de 25 galletas: la mitad de las veces produce una bolsa con 5 galletas de avena y 20 de chispas de chocolate, y la otra mitad produce bolsas con 23 galletas de avena y 2 de chispas de chocolate. Tomamos una bolsa, y no sabemos qué tipo de bolsa es (parámetro desconocido). Extraemos al azar una de las galletas, y es de chispas de chocolate (observación). Por máxima verosimilitud, inferimos que la bolsa que estamos considerando tiene 5 galletas de avena. Esto es porque es más probable observar una galleta de chispas en las bolsas que contienen 5 galletas de avena que en las bolsas que contienen 23 galletas de avena. Podemos cuantificar la probabilidad que “acertemos” en nuestra inferencia. Cómo se aprecia en el ejemplo anterior, el esquema general es: Existe un proceso del que podemos obtener observaciones de algún sistema o población real. Tenemos un modelo probabilístico que dice cómo se producen esas observaciones a partir del sistema o población real. Usualmente este modelo tiene algunas cantidades que no conocemos, que rigen el proceso y cómo se relaciona el proceso con las observaciones. Nuestro propósito es: Extraemos observaciones del proceso \\[x_1, x_2, \\ldots, x_n.\\] Queremos aprender de los parámetros desconocidos del proceso para calcular cantidades de interés acerca del sistema o población real En principio, los modelos que consideramos pueden ser complicados y tener varias partes o parámetros. Veamos primero un ejemplo clásico con un solo parámetro, y cómo lo resolveríamos usando máxima verosimilitud. Nota: Cuando decimos muestra en general nos referimos a observaciones independientes obtenidas del mismo proceso (ver la sección de distribución de muestreo) para ver qué significa que sea independientes. Este esquema es un supuesto que simplifica mucho los cálculos, como discutimos antes. Muchas veces este supuesto sale del diseño de la muestra o del estudio, pero en todo caso es importante considerar si es razonable o no para nuestro problema particular. Denotemos por \\(f(x; \\theta)\\) la función de densidad para una variable aleatoria continua con párametro asociado \\(\\theta.\\) Denotamos por \\(X_1, \\ldots, X_n,\\) una muestra aleatoria de \\(n\\) observaciones de esta distribución y por \\(x_1, \\ldots, x_n\\) los valores observados de esta muestra aleatoria. Ejemplo. Supongamos que queremos saber qué proporción de registros de una base de datos tiene algún error menor de captura. No podemos revisar todos los registros, así que tomamos una muestra de 8 registros, escogiendo uno por uno al azar de manera independiente. Revisamos los 8 registros, y obtenemos los siguientes datos: \\[x_1 = 0, x_2 = 1, x_3 = 0, x_4 = 0, x_5 =1, x_6 =0, x_7 =0, x_8 =0\\] donde 1 indica un error menor. Encontramos dos errores menores. ¿Cómo estimamos el número de registros con errores leves en la base de datos? Ya sabemos una respuesta razonable para nuestro estimador puntual, que sería \\(\\hat{p}=2/8=0.25\\). Veamos cómo se obtendría por máxima verosimilitud. Según el proceso con el que se construyó la muestra, debemos dar una probabilidad de observar los 2 errores en 8 registros. Supongamos que en realidad existe una proporción \\(p\\) de que un registro tenga un error. Entonces calculamos Probabilidad de observar la muestra: \\[P(X_1 = 0, X_2 = 1, X_3 = 0, X_4 = 0, X_5 =1, X_6 =0, X_7 =0, X_8 =0)\\] es igual a \\[P(X_1 = 0)P(X_2 = 1)P(X_3 = 0)P( X_4 = 0)P(X_5 =1)P(X_6 =0)P(X_7 =0)P(X_8 =0)\\] pues la probabilidad de que cada observación sea 0 o 1 no depende de las observaciones restantes (la muestra se extrajo de manera independiente). Esta última cantidad tiene un parámetro que no conocemos: la proporcion \\(p\\) de registros con errores. Así que lo denotamos como una cantidad desconocida \\(p\\). Nótese entonces que \\(P(X_2=1) = p\\), \\(P(X_3=0) = 1-p\\) y así sucesivamente, así que la cantidad de arriba es igual a \\[(1-p)p(1-p)(1-p)p(1-p)(1-p)(1-p) \\] que se simplifica a \\[ \\mathcal{L}(p) = p^2(1-p)^6\\] Ahora la idea es encontrar la p que maximiza la probabilidad de lo que observamos. En este caso se puede hacer con cálculo, pero vamos a ver una gráfica de esta función y cómo resolverla de manera numérica. verosimilitud <- function(p){ p^2 * (1-p)^6 } dat_verosim <- tibble(x = seq(0,1, 0.001)) %>% mutate(prob = map_dbl(x, verosimilitud)) ggplot(dat_verosim, aes(x = x, y = prob)) + geom_line() + geom_vline(xintercept = 0.25, color = "red") + xlab("p") Nótese que esta gráfica: Depende de los datos, que pensamos fijos. Cuando cambiamos la \\(p\\), la probabilidad de observar la muestra cambia. Nos interesa ver las regiones donde la probabilidad es relativamente alta. El máximo está en 0.25. Así que el estimador de máxima verosimilitud es \\(\\hat{p} = 0.25\\), que es también el estimador usual de plugin en este caso. Para uniformizar la notación con el caso continuo que veremos más adelante, usaremos la notación \\[P(X=x) = f(x)\\] donde \\(f\\) es la función de densidad (en este caso, función de masa de probabilidad) de \\(X\\). Si esta función depende de un parámetro, escribimos \\[f(x ;\\theta)\\] Definición. Sean \\(X_1, \\ldots, X_n\\) una muestra de una densidad \\(f(x; \\theta)\\) y sean \\(x_1,x_2,\\ldots, x_n\\) los valores observados. La función de verosimilitud del párametro de interés \\(\\theta\\) está definida por \\[\\begin{align} \\mathcal{L}(\\theta; x_1, \\ldots, x_n) = \\prod_{i = 1}^n f(x_i; \\theta). \\end{align}\\] Esta función nos dice qué tan creible es el valor del parámetro \\(\\theta\\) dada la muestra observada. A veces también la denotamos por \\(\\mathcal{L}_n(\\theta)\\). Ahora definimos qué es un estimador de máxima verosimilitud. Definición. Un estimador de máxima verosimilitud lo denotamos por \\(\\hat \\theta_{\\textsf{MLE}}\\) y es un valor que satisface \\[\\begin{align} \\hat \\theta_{\\textsf{MLE}} = \\underset{\\theta \\, \\in \\, \\Theta}{\\arg\\max}\\, \\mathcal{L}(\\theta; x_1, \\ldots, x_n), \\end{align}\\] donde \\(\\Theta\\) denota el espacio parametral. Es decir, el espacio válido de búsqueda congruente con la definición del modelo. Considera el caso de una normal con media y varianza desconocidas. ¿Cuáles son los espacios parametrales para efectuar \\(\\mathsf{MLE}\\)? Considera el caso de una Binomial con parámetro \\(p\\) desconocidos. ¿Cuál es el espacio parametral para la búsqueda del \\(\\mathsf{MLE}\\)? Obsérvese que para construir la verosimilitud y en consecuencia buscar por estimadores de máxima verosimlitud necesitamos: Un modelo teórico de cómo es la población con parámetros e Información de cómo se extrajo la muestra, y entonces podemos resolver nuestro problema de estimación convirtiéndolo en uno de optimización. Probamos esta idea con un proceso más complejo. Ejemplo. Supongamos que una máquina puede estar funcionando correctamente o no en cada corrida. Cada corrida se producen 500 productos, y se muestrean 10 para detectar defectos. Cuando la máquina funciona correctamente, la tasa de defectos es de 3%. Cuando la máquina no está funcionando correctamente la tasa de defectos es de 20% Supongamos que escogemos al azar 11 corridas, y obervamos los siguientes número de defectuosos: \\[1, 0, 0, 3 ,0, 0, 0, 2, 1, 0, 0\\] La pregunta es: ¿qué porcentaje del tiempo la máquina está funcionando correctamente? Primero pensemos en una corrida. La probabilidad de observar una sucesión particular de \\(r\\) defectos es \\[0.03^r(0.97)^{(10-r)}\\] cuando la máquina está funcionando correctamente. Si la máquina está fallando, la misma probabilidad es \\[0.2^r(0.8)^{(10-r)}.\\] Ahora supongamos que la máquina trabaja correctamente en una proporción \\(p\\) de las corridas. Entonces la probabilidad de observar \\(r\\) fallas se calcula promediando (probabilidad total) sobre las probabilidades de que la máquina esté funcionando bien o no: \\[0.03^r(0.97)^{(10-r)}p + 0.2^r(0.8)^{(10-r)}(1-p)\\] Y esta es nuestra función de verosimilitud para una observación. Suponemos que las \\(r_1,r_2, \\ldots, r_{11}\\) observaciones son independientes (por ejemplo, después de cada corrida la máquina se prepara de una manera estándar, y es como si el proceso comenzara otra vez). Entonces tenemos que multiplicar estas probabilidades para cada observación \\(r_1\\): # creamos la función de verosimilitud con los datos observados como dados verosim <- function(p) { r <- c(1, 2, 0, 3, 0, 0, 0, 2, 1, 0, 3) q_func <- 0.03^r*(0.97)^(10-r) q_falla <- 0.2^r*(0.8)^(10-r) prod(p * q_func + (1 - p) * q_falla) } verosim(0.1) # Una alternativa que nos da más flexibilidad para generar la función de # verosimilitud, es crear una función que recibe los datos observados y nos # regresa la función de verosimilitud correspondiente # Entonces, cal_verosim es una función que regresa una función calc_verosim <- function(r){ q_func <- 0.03 ^ r * (0.97) ^ (10 - r) q_falla <- 0.2 ^ r * (0.8) ^ (10 - r) function(p){ #nota: esta no es la mejor manera de calcularlo, hay # que usar logaritmos. prod(p * q_func + (1 - p) * q_falla) } } verosim <- calc_verosim(r = c(1, 0, 0, 3, 0, 0, 0, 2, 1, 0, 0)) verosim(0.1) ## [1] 2.692087e-14 dat_verosim <- tibble(x = seq(0, 1, 0.001)) %>% mutate(prob = map_dbl(x, verosim)) ggplot(dat_verosim, aes(x = x, y = prob)) + geom_line() + geom_vline(xintercept = 0.773, color = "red") + xlab("prop funcionado") Y nuestra estimación puntual sería de alrededor de 80%. Máxima verosimilitud para observaciones continuas Cuando las observaciones \\(x_1,\\ldots, x_n\\) provienen de una distribución continua, no tiene sentido considerar \\(P(X = x_i)\\), pues siempre es igual a cero. Sin embargo, podemos escribir para pequeños valores \\(\\epsilon \\ll 1\\) \\[\\begin{align} P(x - \\epsilon < X < x + \\epsilon | \\theta) = \\int_{x - \\epsilon}^{x + \\epsilon} f(t; \\theta) \\, \\text{d} t \\approx 2 \\epsilon f(x; \\theta), \\end{align}\\] donde \\(f(x; \\theta)\\) es la función de densidad de \\(X.\\) Por lo tanto, \\[\\begin{align} \\begin{split} P&(x_1 - \\epsilon < X_1 < x_1 + \\epsilon, \\ldots, x_n - \\epsilon < X_n < x_n + \\epsilon | \\theta) \\\\ &= \\prod_{i = 1}^n P(x_i - \\epsilon < X_i < x_i + \\epsilon | \\theta) \\\\ &= \\prod_{i = 1}^n 2 \\epsilon f(x_i; \\theta) = (2\\epsilon)^n \\prod_{i = 1}^n f(x_i; \\theta). \\end{split} \\end{align}\\] Notemos que si \\(\\epsilon \\rightarrow 0\\) la ecuación rápidamente converge a cero. Pero para pequeños valores de \\(\\epsilon\\) la ecuación que nos interesa es proporcional a \\(\\prod_{i = 1}^n f(x_i; \\theta).\\) De esta forma, nuestra definición de máxima verosimilitud y estimadores de máxima verosimilitud es la misma para el caso continuo (verifica las definiciones de la sección anterior). Ejemplo. Supongamos que tenemos una muestra \\(x_1\\ldots, x_n\\) extraidas de una distribución exponencial con tasa \\(\\lambda>0\\) donde no conocemos \\(\\lambda\\). ¿Cuál es el estimador de máxima verosimilitud de \\(\\lambda\\)? Para \\(\\lambda>0\\), tenemos que \\[{\\mathcal L}(\\lambda) = \\prod_{i=1}^n \\lambda e^{-\\lambda x_i}\\] de modo que \\[{\\mathcal L}(\\lambda) = \\lambda^n e^{-\\lambda \\sum_{i=1}^nx_i} = \\lambda^n e^{-n\\lambda\\bar{x}} = e^{n(\\log\\lambda - \\lambda\\bar{x})}\\] Que podemos maximizar usando cálculo para obtener \\(\\hat{\\lambda}_{\\mathsf{ML}} = \\frac{1}{\\bar{x}}\\) (demuéstralo). Discute por qué esto es intuitivamente razonable: ¿cuál es el valor esperado de una exponencial con parámetro \\(\\lambda\\)? Aspectos numéricos Encontrar el estimador de máxima verosimilitud (\\(\\textsf{MLE}\\)) es automático en la mayoría de los casos. En teoría, podemos reutilizar la misma rutina numérica para encontrar el estimador sin ninguna ayuda de la analista. Esto contrasta con otras técnicas de estimación en donde se requieren cálculos y manipulación de ecuaciones. Sin embargo, hay situaciones que se pueden evitar de manera general. Por ejemplo, cuando calculamos la verosimilitud arriba, nótese que estamos multiplicando números que pueden ser muy chicos (por ejemplo \\(p^6\\), etc). Esto puede producir desbordes numéricos fácilmente. Por ejemplo para un tamaño de muestra de 1000, podríamos tener que calcular p <- 0.1 proba <- (p ^ 800)*(1-p)^200 proba ## [1] 0 En estos casos, es mejor hacer los cálculos en escala logarítmica. El logaritmo convierte productos en sumas, y baja exponentes multiplicando. Si calculamos en escala logaritmica la cantidad de arriba, no tenemos problema: log_proba <- 800 * log(p) + 200 * log(1-p) log_proba ## [1] -1863.14 Ahora notemos que Maximizar la verosimilitud es lo mismo que maximizar la log-verosimilitud, pues el logaritmo es una función creciente. Si \\(x_{\\max}\\) es el máximo de \\(f\\), tenemos que \\(f(x_{\\max})>f(x)\\) para cualquier \\(x\\), entonces tomando logaritmo, \\[\\log(f(x_{max}))>\\log(f(x)),\\] para cualquier \\(x.\\) Pues el logaritmo respeta la desigualdad por ser creciente. Usualmente usamos la log-verosimilitud para encontrar el estimador de máxima verosimilitud. Hay razónes teóricas y de interpretación por las que también es conveniente hacer esto. Definición. La log-verosimilitud la denotamos usualmente por \\[\\ell_n(\\theta) = \\log \\left(\\mathcal{L}_n(\\theta)\\right),\\] donde hemos suprimido la dependencia en la muestra por conveniencia. Ejemplo. En nuestro primer ejemplo, log_verosimilitud <- function(p){ 2*log(p) + 6*log(1-p) } dat_verosim <- tibble(x = seq(0,1, 0.01)) %>% mutate(log_prob = map_dbl(x, log_verosimilitud)) ggplot(dat_verosim, aes(x = x, y = log_prob)) + geom_line() + geom_vline(xintercept = 0.25, color = "red") + xlab("p") Obtenemos el mismo máximo. Podemos incluso resolver numéricamente: solucion <- optim(p = 0.5, log_verosimilitud, control = list(fnscale = -1), method = "Brent", lower = 0, upper = 1) solucion$par ## [1] 0.25 Y en nuestro segundo ejemplo: calc_log_verosim <- function(r){ q_func <- 0.03^r*(0.97)^(10-r) q_falla <- 0.2^r*(0.8)^(10-r) function(p){ #nota: esta no es la mejor manera de calcularlo, hay # que usar logaritmos. sum(log(p * q_func + (1 - p) * q_falla)) } } log_verosim <- calc_log_verosim(c(1, 0, 0, 3, 0, 0, 0, 2, 1, 0, 0)) log_verosim(0.1) ## [1] -31.24587 solucion <- optim(p = 0.2, log_verosim, control = list(fnscale = -1), method = "Brent", lower = 0, upper = 1) solucion$par ## [1] 0.7733766 solucion$convergence ## [1] 0 dat_verosim <- tibble(x = seq(0,1, 0.001)) %>% mutate(log_verosimilitud = map_dbl(x, log_verosim)) ggplot(dat_verosim, aes(x = x, y = log_verosimilitud)) + geom_line() + geom_vline(xintercept = 0.775, color = "red") + xlab("prop funcionado") Nótese que la verosimilitud la consideramos función de los parámetros, donde los datos están fijos. Podemos construir una función que genera la función de verosimilitud dependiendo de los datos. En nuestro primer ejemplo de muestras de registros erróneos, podríamos construir una función que genera la log verosimilitud dependiendo del tamaño de muestra y del número de errores encontrado: construir_log_verosim <- function(n, n_err){ # n es tamaño de muestra # n_err el número de errores detectados (datos) n_corr <- n - n_err log_verosim <- function(p){ n_err * log(p) + n_corr * log(1-p) } } Cuando fijamos \\(n\\) y \\(n_{\\textsf{err}}\\), esta función genera otra función, la log verosimilitud, que es la que queremos optimizar. Supongamos entonces que sacamos 20 registros al azar y observamos 10 incorrectos. La función de verosimilitud es log_vero <- construir_log_verosim(20, 10) tibble(x = seq(0,1,0.001)) %>% mutate(log_ver = log_vero(x)) %>% ggplot(aes(x = x, y = log_ver)) + geom_line() + geom_vline(xintercept = 0.5, color = 'red') Ejemplo. Supongamos que en una población de transacciones hay un porcentaje \\(p\\) (desconocido) que son fraudulentas. Tenemos un sistema de clasificación humana que que marca transacciones como sospechosas. Con este sistema hemos medido que la proporción de transacciones normales que son marcadas como sospechosas es de 0.1%, y que la proporción de transacciones fraudulentas que son marcadas como sospechosas es de 98%. Supongamos que extraemos una muestra de 2000 transacciones, de manera que todas ellas tiene la misma probabilidad de ser fraudulentas. El sistema de clasificación marca 4 transacciones como sospechosas ¿Cómo estimamos la proporción de transacciones fraudulentas en la población? Solución: sea \\(p\\) la proporción de transacciones fraudulentas. Entonces la probabilidad de que una transacción sea marcada como sospechosa es (proba total): \\[0.98p + 0.001(1-p)\\] Pues tenemos que contar 98% de la proporción \\(p\\) de fraudulentas (correctamente detectadas) más 0.1% de la proporción \\((1-p)\\) de fraudulentas. Escribimos entonces nuestra función de verosimilitud crear_log_verosim <- function(n, n_sosp){ # devolver la función log verosimilitud log_verosimilitud_pct <- function(pct){ # sup que pct es la proporcentaje de fraudes, # que es el parámetro que queremos estimar prob_sosp <- 0.98 * pct / 100 + 0.001 * (1 - pct / 100) log_prob <- n_sosp * log(prob_sosp) + (n - n_sosp) * log(1- prob_sosp) log_prob } log_verosimilitud_pct } La verosimilitud es una función de \\(p\\). log_verosim <- crear_log_verosim(n = 2000, n_sosp = 4) A continuación la mostramos de manera gráfica. No se ve muy claro dónde ocurre el máximo, pero podemos ampliar cerca de cero la misma gráfica: Vemos que alrededor de 0.1% maximiza la probabilidad de haber observado 4 transacciones sospechosas. Notamos sin embargo que varios valores alrededor de este valor tienen probabilidad similar, así que también son consistentes con los datos (por ejemplo, valores como 0.05 o 0.15 tienen probabilidad similar). Tendremos que considerar esto para evaluar la incertidumbre en nuestra estimación. Obsérvese adicionalmente que si no tomáramos en cuenta las probabilidades de falsos negativos y falsos positivos la estimación simple daría \\(4/2000 = 0.002\\) (0.2%), que es dos veces más grande que nuestra estimación puntual por máxima verosimilitud. Ejemplo. Este es un ejemplo donde mostramos que cuando el soporte de las densidades teóricas es acotado hay que tener cuidado en la definición de la verosimilitud. En este caso, el soporte de la variable aleatoria es el párametro de interés. Supongamos que nuestros datos son generados por medio de una distribución uniforme en el intervalo \\([0,b].\\) Contamos con una muestra de \\(n\\) observaciones generadas de manera independiente \\(X_i \\sim U[0,b]\\) para \\(i= 1, \\ldots, n.\\) Sin embargo, no conocemos el valor de \\(b\\). ¿Cómo es la función de log verosimilitud \\({\\mathcal L}_n(b)\\) para este caso? Nótese que cuando el parámetro \\(b\\) es menor que alguna \\(x_i\\), tenemos que \\({\\mathcal L}_n(b) = 0\\): la verosimilitud es cero si tomamos una \\(b\\) más chica que algún dato, pues este valor es incosistente del todo con los datos observados. En otro caso, \\[{\\mathcal L}_n(b) = \\frac{1}{b^n},\\] pues la función de densidad de una uniforme en \\([0,b]\\) es igual a \\(1/b\\) en el intervalo \\([0,b]\\), y 0 en otro caso. Podemos escribir entonces: crear_verosim <- function(x){ n <- length(x) verosim <- function(b){ indicadora <- ifelse(all(x <= b), 1, 0) indicadora / b^n } } Ahora podemos hacer máxima verosimilitud para un ejemplo: set.seed(234) x <- runif(10, 0, 3) verosim <- crear_verosim(x) res_opt <- optimize(verosim, c(-1000, 1000), maximum = TRUE) res_opt$maximum ## [1] 2.788167 Y nótese que, como esperaríamos, este valor es el máximo de la muestra: max(x) ## [1] 2.788158 La gráfica de la función de verosimilitud es: tibble(b = seq(-1, 5, 0.001)) %>% mutate(verosim_1 = map_dbl(b, ~ verosim(.x))) %>% ggplot() + geom_line(aes(x = b, y = verosim_1)) + geom_rug(data = tibble(x = x), aes(x = x), colour = "red") Podemos escribir en una fórmula como: \\[\\begin{align} \\mathcal{L}(b; x_1, \\ldots, x_n) = \\prod_{i = 1}^n 1_{[0,b]}(x_i) \\frac1b. \\end{align}\\] Y podríamos resolver analíticamente como sigue: Si consideramos \\[ \\hat b_{\\textsf{MLE}} = x_{\\max} = \\max\\{x_i\\},\\] notemos que cualquier valor observado necesariamente satisface \\[x_i \\leq \\hat b_{\\textsf{MLE}},\\] y por lo tanto todas las funciones indicadoras están encendidas. El valor de la verosimilitud es igual a \\[\\mathcal{L}(\\hat b_{\\textsf{MLE}}; x_1, \\ldots, x_n) = \\left(\\frac{1}{x_{\\max}}\\right)^n \\geq \\left (\\frac1b\\right )^n\\] para cualquier \\(b\\geq x_{\\max}\\). Como la verosimilitud para \\(b<x_{\\max}\\) es igual a cero, esto demuestra que el máximo de la muestra es el estimador de máxima verosimilitud de \\(b\\). Observación. Este ejemplo también tiene dificultades numéricas, pues la verosimilitud presenta discontinuidades y regiones con derivada igual a cero, y la mayoria de los algoritmos numéricos no tienen garantías buenas de covergencia al máximo en estos casos. Si aplicamos sin cuidado descenso en gradiente, por ejemplo, podríamos comenzar incorrectamente en un valor \\(b_0 < x_{\\max}\\) y el algoritmo no avanzaría al máximo. Máxima verosimilitud para más de un parámetro Si nuestro modelo contiene más de un parámetro desconocido podemos también usar máxima verosimilitud. En este caso, optimizamos sobre todos los parámetros usando cálculo o alguna rutina numérica. Ejemplo. Considera el caso de \\(n\\) muestras iid de un modelo Gaussiano. Es decir, \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2).\\) Consideremos que ambos parámetros son desconocidos y nos gustaria encontrar el \\(\\textsf{MLE}\\). Para este problema denotamos \\(\\theta \\in \\mathbb{R}^2\\), donde \\(\\theta_1 = \\mu\\) y \\(\\theta_2 = \\sigma^2.\\) La función de verosimiltud se puede calcular (ignorando algunas constantes multiplicativas) como \\[\\begin{align} \\mathcal{L}_n(\\theta) &= \\prod_{i = 1}^n \\frac{1}{\\sigma} \\, \\exp\\left( - \\frac{(x_i - \\mu)^2}{2\\sigma^2}\\right) \\\\ &= \\theta_2^{-\\frac{n}{2}}\\exp\\left( - \\frac{1}{2 \\theta_2} \\sum_{i = 1}^n (x_i - \\theta_1)^2 \\right). \\end{align}\\] A continuación mostramos la representación gráfica de la función de verosimilitud de este ejemplo. Notamos lo mismo que para los ejemplos anteriores. Conforme más datos tenemos, más nos acercamos a los valores reales que no conocemos. Ejemplo. Como ejercicio, podemos encontrar los estimadores de máxima verosimilitud cuando tenemos una muestra \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2).\\) (puedes derivar e igualar el cero para encontrar el mínimo). También podemos resolver numéricamente, por ejemplo: Supongamos que tenemos la siguiente muestra: set.seed(41852) muestra <- rnorm(150, mean = 1, sd = 2) La función generadora de la log verosimilitud para una muestra es (ve la expresión del ejercicio anterior y calcula su logaritmo), y generamos la función de verosimilitud para nuestra muestra: crear_log_p <- function(x){ log_p <- function(pars){ media = pars[1] desv_est = pars[2] # ve la ecuación del ejercicio anterior z <- (x - media) / desv_est log_verosim <- -(log(desv_est) + 0.5 * mean(z ^ 2)) log_verosim } log_p } log_p <- crear_log_p(muestra) Ahora optimizamos: res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mv <- tibble(parametro = c("media", "sigma"), estimador = res$par) %>% column_to_rownames(var = "parametro") est_mv ## estimador ## media 1.136001 ## sigma 1.838421 Verifica que el estimador de la media y de la desviación estándar es el que esperábamos (y que puedes derivar analíticamente): n <- length(muestra) sd_n <- function(x) sqrt(mean((x - mean(x))^2)) c(media = mean(muestra), sigma = sd_n(muestra)) %>% round(4) ## media sigma ## 1.1364 1.8392 Ejemplo. Supongamos que en una población de estudiantes tenemos dos tipos: unos llenaron un examen de opción múltiple al azar (1 de 5), y otros contestaron las preguntas intentando sacar una buena calificación. Suponemos que una vez que conocemos el tipo de estudiante, todas las preguntas tienen la misma probabilidad de ser contestadas correctamente, de manera independiente. El modelo teórico está representado por la siguiente simulación: sim_formas <- function(p_azar, p_corr){ tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } Y una muestra se ve como sigue: set.seed(12) muestra <- map_dbl(1:200, ~ sim_formas(0.3, 0.75)) qplot(muestra) Supongamos que no conocemos la probabildad de contestar correctamente ni la proporción de estudiantes que contestó al azar. ¿Como estimamos estas dos cantidades? Escribimos la verosimilitud: crear_log_p <- function(x){ log_p <- function(pars){ p_azar = pars[1] p_corr = pars[2] sum(log(p_azar * dbinom(x, 10, 1/5) + (1 - p_azar) * dbinom(x, 10, p_corr))) } log_p } Creamos la función de verosimilitud con los datos log_p <- crear_log_p(muestra) y optimizamos res <- optim(c(0.5, 0.5), log_p, control = list(fnscale = -1)) res$par ## [1] 0.2827061 0.7413276 En este caso, obtenemos estimaciones razonables de ambos parámetros. Nota: dependiendo de los datos, este problema puede estar mal condicionado. Por ejemplo, ¿qué pasa si la probabilidad de acertar cuando se contesta bien está cercano al azar? La siguiente pregunta qué nos interesa hacer es: ¿cómo estimamos la variabilidad de estos estimadores? Más adelante veremos una respuesta basada en teoría, pero también podemos resolver este problema usando el bootstrap. Referencias "],["bootstrap-paramétrico.html", "Sección 7 Bootstrap paramétrico Ventajas y desventajas de bootstrap paramétrico Verificando los supuestos distribucionales Modelos mal identificados", " Sección 7 Bootstrap paramétrico Cuando nuestras observaciones provienen de un modelo teórico parametrizado con algunos parámetros que queremos estimar, y utilizamos máxima verosimilitud para hacer nuestra estimación, no es adecuado aplicar directamente el bootstrap no paramétrico que vimos en las secciones anteriores. Sin embargo, suponiendo que el modelo paramétrico que estamos usando es apropiado, podemos remuestrear de tal modelo para estimar la varianza de nuestros estimadores. Este proceso se llama el bootstrap paramétrico. Antes de hacer una definición precisa, veamos cómo calcularíamos error estándar para los estimadores de máxima verosimilitud de la normal que vimos en la sección anterior. Ejemplo (sección máxima verosimilitud). Como ejercicio, podemos encontrar los estimadores de máxima verosimilitud cuando tenemos una muestra \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\mu, \\sigma^2)\\) (puedes derivar e igualar a cero para encontrar el mínimo). También podemos resolver numéricamente. Supongamos que tenemos la siguiente muestra: set.seed(41852) muestra <- rnorm(150, mean = 1, sd = 2) La función generadora de la log-verosimilitud para una muestra es (ve la expresión del ejercicio anterior y calcula su logaritmo), y generamos la función de verosimilitud para nuestra muestra: crear_log_p <- function(x){ log_p <- function(pars){ media = pars[1] desv_est = pars[2] # ve la ecuación del ejercicio anterior z <- (x - media) / desv_est log_verosim <- -(log(desv_est) + 0.5 * mean(z^2)) log_verosim } log_p } log_p <- crear_log_p(muestra) Ahora optimizamos (revisa que el método converge): res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mle <- tibble(parametro = c("media", "sigma"), estimador = res$par) |> column_to_rownames(var = "parametro") Una vez que tenemos nuestros estimadores puntuales, est_mle ## estimador ## media 1.136001 ## sigma 1.838421 Sustituimos estos parámetros en la distribución normal y simulamos una muestra del mismo tamaño que la original: simular_modelo <- function(n, media, sigma){ rnorm(n, media, sigma) } muestra_bootstrap <- simular_modelo(length(muestra), est_mle["media", "estimador"], est_mle["sigma", "estimador"]) head(muestra_bootstrap) ## [1] 1.8583885 2.2084326 2.5852895 2.5174462 -0.7428032 0.5995989 Una vez que tenemos esta muestra bootstrap recalculamos los estimadores de máxima verosimlitud. Esto se hace optimizando: # creamos nueva verosimilitud para muestra bootstrap log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0, 0.5), log_p_boot, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res_boot$convergence ## [1] 0 est_mle_boot <- tibble(parametro = c("media", "sigma"), estimador = res_boot$par) |> column_to_rownames(var = "parametro") est_mle_boot ## estimador ## media 1.235914 ## sigma 1.710042 Y esta es nuestra replicación bootstrap de los estimadores de máxima verosimilitud. La idea es la misma que el bootstrap no paramétrico, con la ventaja de que estamos simulando del modelo que suponemos es el correcto, es decir, estamos usando información adicional que no teníamos en el bootstrap no paramétrico. Ahora es necesario repetir un número grande de veces. Nótese que esta función envuelve el proceso de remuestreo, cálculo de la función de verosimilitud y optimización: rep_boot <- function(rep, crear_log_p, est_mle, n){ muestra_bootstrap <- simular_modelo(length(muestra), est_mle["media", "estimador"], est_mle["sigma", "estimador"]) log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0, 0.5), log_p_boot, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") try(if(res_boot$convergence != 0) stop("No se alcanzó convergencia.")) tibble(parametro = c("media", "sigma"), estimador_boot = res_boot$par) } reps_boot <- map_dfr(1:5000, ~ rep_boot(.x, crear_log_p, est_mle, n = length(muestra)), rep = ".id") reps_boot ## # A tibble: 10,000 × 2 ## parametro estimador_boot ## <chr> <dbl> ## 1 media 0.797 ## 2 sigma 1.90 ## 3 media 1.23 ## 4 sigma 1.96 ## 5 media 1.14 ## 6 sigma 1.89 ## 7 media 1.33 ## 8 sigma 1.73 ## 9 media 1.19 ## 10 sigma 1.73 ## # ℹ 9,990 more rows Ya ahora podemos estimar error estándar: error_est <- reps_boot |> group_by(parametro) |> summarise(ee_boot = sd(estimador_boot)) error_est ## # A tibble: 2 × 2 ## parametro ee_boot ## <chr> <dbl> ## 1 media 0.150 ## 2 sigma 0.106 Así que nuestra estimación final sería: bind_cols(est_mle, error_est) |> mutate(across(where(is.numeric), round, 3)) |> select(parametro, estimador, ee_boot) ## parametro estimador ee_boot ## media media 1.136 0.150 ## sigma sigma 1.838 0.106 Si usamos la rutina estándar de R (dejaremos para después explicar cómo calcula los errores estándar esta rutina —no es con bootstrap): broom::tidy(MASS::fitdistr(muestra, "normal")) ## # A tibble: 2 × 3 ## term estimate std.error ## <chr> <dbl> <dbl> ## 1 mean 1.14 0.150 ## 2 sd 1.84 0.106 Podemos revisar también la normalidad aproximada de las distribuciones bootstrap para construir nuestros intervalos: ggplot(reps_boot, aes(sample = estimador_boot)) + geom_qq() + geom_qq_line(colour = "red") + facet_wrap(~parametro, scales = "free_y") La distribuciones son aproximadamente normales. Nótese que esto no siempre sucede, especialmente con parámetros de dispersión como \\(\\sigma\\). Ejemplo. Supongamos que tenemos una muestra más chica. Repasa los pasos para asegurarte que entiendes el procedimiento: set.seed(4182) muestra <- rnorm(6, mean = 1, sd = 2) # función de verosimilitud log_p <- crear_log_p(muestra) # máxima verosimilitud res <- optim(c(0, 0.5), log_p, control = list(fnscale = -1, maxit = 1000), method = "Nelder-Mead") res$convergence ## [1] 0 est_mle <- tibble(parametro = c("media", "sigma"), estimador = res$par) |> column_to_rownames(var = "parametro") est_mle ## estimador ## media 0.3982829 ## sigma 2.3988969 Hacemos bootstrap paramétrico reps_boot <- map_dfr(1:5000, ~ rep_boot(.x, crear_log_p, est_mle, n = length(muestra)), .id = "rep") reps_boot ## # A tibble: 10,000 × 3 ## rep parametro estimador_boot ## <chr> <chr> <dbl> ## 1 1 media 0.789 ## 2 1 sigma 0.945 ## 3 2 media -0.103 ## 4 2 sigma 1.37 ## 5 3 media 1.96 ## 6 3 sigma 1.70 ## 7 4 media 1.55 ## 8 4 sigma 2.28 ## 9 5 media -0.228 ## 10 5 sigma 1.73 ## # ℹ 9,990 more rows ggplot(reps_boot, aes(sample = estimador_boot)) + geom_qq() + geom_qq_line(colour = "red") + facet_wrap(~parametro, scales = "free_y") ggplot(reps_boot, aes(x = estimador_boot)) + geom_histogram() +facet_wrap(~parametro) Donde vemos que la distribución de \\(\\sigma\\) es asimétrica pues en algunos casos obtenemos estimaciones muy cercanas a cero. Podemos usar intervalos de percentiles. Ejercicio (extra). Con más de un parámetro, podemos preguntarnos cómo dependen las estimaciones individuales - en algunos casos pueden estar correlacionadas. Podemos examinar este comportamiendo visualizando las replicaciones bootstrap ggplot(reps_boot |> pivot_wider(names_from = parametro, values_from = estimador_boot), aes(x = media, y = sigma)) + geom_point(alpha = 0.5) + coord_equal() Esta es nuestra aproximación a la distribución de remuestreo de nuestro par de estadísticas \\((\\mu_{\\mathsf{MLE}}, \\sigma_{\\mathsf{MLE}})\\). En este caso, parecen ser independientes (lo cual es posible demostrar). Bootstrap paramétrico. Supongamos que tenemos una muestra iid \\(X_1,X_2,\\ldots, X_n \\sim f(x;\\theta)\\) de un modelo paramétrico, y un estimador de máxima verosimilitud \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) para \\(\\theta\\). El error estándar estimado para \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) por medio del bootstrap paramétrico se calcula como sigue: Se calcula \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) para la muestra observada Se simula una muestra iid de tamaño \\(n\\) de \\(f(x; \\hat{\\theta}_{\\mathsf{MLE}})\\) (muestra bootstrap) Se recalcula el estimador de máxima verosimilitud para la muestra bootstrap \\(\\hat{\\theta^*}_{\\mathsf{MLE}}\\) Se repiten 2-3 una cantidad grande de veces (1000 - 10000) Se calcula la desviación estándar de los valores \\(\\hat{\\theta^*}_{\\mathsf{MLE}}\\) obtenidos. Este es el error estándar estimado para el estimador \\(\\hat{\\theta}_{\\mathsf{MLE}}\\) Ventajas y desventajas de bootstrap paramétrico Ventaja: el bootstrap paramétrico puede dar estimadores más precisos e intervalos más angostos y bien calibrados que el no paramétrico, siempre y cuando el modelo teórico sea razonable. Desventaja: Es necesario decidir el modelo teórico, que tendrá cierto grado de desajuste vs. el proceso generador real de los datos. Si el ajuste es muy malo, los resultados tienen poca utilidad. Para el no paramétrico no es necesario hacer supuestos teóricos. Ventaja: el bootstrap paramétrico puede ser más escalable que el no paramétrico, pues no es necesario cargar y remuestrear los datos originales, y tenemos mejoras adicionales cuando tenemos expresiones explícitas para los estimadores de máxima verosimilitud (como en el caso normal, donde es innecesario hacer optimización numérica). Desventaja: el bootstrap paramétrico es conceptualmente más complicado que el no paramétrico, y como vimos arriba, sus supuestos pueden ser más frágiles que los del no-paramétrico. Verificando los supuestos distribucionales Como hemos discutido antes, podemos hacer pruebas de hipótesis para revisar si una muestra dada proviene de una distribución conocida. Sin embargo, la herramienta más común es la de los qq-plots, donde podemos juzgar fácilmente el tamaño de las desviaciones y si estas tienen implicaciones prácticas importantes. El proceso es como sigue: si \\(X_1,X_,\\ldots, X_n\\) es una muestra de \\(f(x;\\theta)\\), calculamos el estimador de máxima verosimilitud \\(\\theta_{\\mathsf{MLE}}\\) con los datos observados. Enchufamos \\(\\hat{f} = f(x;\\theta_{\\mathsf{MLE}})\\), y hacemos una gráfica de los cuantiles teóricos de \\(\\hat{f}\\) contra los cuantiles muestrales. Ejemplo. Consideramos la siguiente muestra: set.seed(32) muestra <- rgamma(150, 0.4, 1) qplot(muestra) Y queremos usar un modelo exponencial. Encontramos los estimadores de maxima verosimilitud est_mle <- MASS::fitdistr(muestra, "exponential") rate_mle <- est_mle$estimate rate_mle ## rate ## 2.76054 g_exp <- ggplot(tibble(muestra = muestra), aes(sample = muestra)) + geom_qq(distribution = stats::qexp, dparams = list(rate = rate_mle)) + geom_abline() + labs(subtitle = "Gráfica de cuantiles exponenciales") g_exp Donde vemos que el desajuste es considerable, y los datos tienen una cola derecha considerablemente más larga que la de exponencial (datos son casi dos veces más grande de lo que esperaríamos), y la cola izquierda está más comprimida en los datos que en una exponencial. Sin embargo, si ajustamos una gamma: est_mle <- MASS::fitdistr(muestra, "gamma")$estimate g_gamma <- ggplot(tibble(muestra = muestra), aes(sample = muestra)) + geom_qq(distribution = stats::qgamma, dparams = list(shape = est_mle[1], rate = est_mle[2])) + geom_abline() + labs(subtitle = "Gráfica de cuantiles gamma") g_exp + g_gamma El ajuste es considerablemente mejor para la distribución gamma (puedes hacer el protocolo rorschach para afinar tu diagnóstico de este tipo de gráficas). Ejempĺo. Examinamos un modelo teórico para las cuentas totales del conjunto de datos de propinas. En primer lugar: Separamos comida y cena, pues sabemos que las cuentas tienden a ser más grandes en las cenas. En lugar de modelar la cuenta total, modelamos el gasto por persona, es decir, la cuenta total dividida por el numero de personas. Grupos grandes pueden producir colas largas que no tenemos necesidad de modelar de manera probabilística, pues conocemos el número de personas. En este caso intentaremos un modelo lognormal, es decir, el logaritmo de los valores observados se comporta aproximadamente normal. Puedes también intentar con una distribución gamma. Separamos por Cena y Comida, dividimos entre número de personas y probamos ajustando un modelo para cada horario: propinas <- read_csv("data/propinas.csv") |> mutate(cuenta_persona = cuenta_total / num_personas) propinas_mle <- propinas |> group_by(momento) |> summarise(est_mle = list(tidy(MASS::fitdistr(cuenta_persona, "lognormal")))) |> unnest(est_mle) propinas_mle ## # A tibble: 4 × 4 ## momento term estimate std.error ## <chr> <chr> <dbl> <dbl> ## 1 Cena meanlog 2.03 0.0273 ## 2 Cena sdlog 0.362 0.0193 ## 3 Comida meanlog 1.94 0.0366 ## 4 Comida sdlog 0.302 0.0259 Ojo: estos parámetros están en escala logarítmica. Puedes revisar aquí para ver cómo calcular media y desviación estándar de las distribuciones originales. Ahora verificamos el ajuste: g_1 <- ggplot(propinas |> filter(momento == "Cena"), aes(sample = cuenta_persona)) + geom_qq(dparams = list(mean = propinas_mle$estimate[1], sd = propinas_mle$estimate[2]), distribution = stats::qlnorm) + ylim(c(0, 20)) + geom_abline() + labs(subtitle = "Cena") g_2 <- ggplot(propinas |> filter(momento == "Comida"), aes(sample = cuenta_persona)) + geom_qq(dparams = list(mean = propinas_mle$estimate[3], sd = propinas_mle$estimate[4]), distribution = stats::qlnorm) + ylim(c(0, 20)) + geom_abline() + labs(subtitle = "Comida") g_1 + g_2 El ajuste es bueno, aunque podríamos revisar la cola de la derecha en la Comida: ¿por qué existen esos valores relativamente grandes (alrededor de 25% más altos de lo que esperaríamos). ¿Tiene sentido ajustar dos distribuciones con parámetros separados? ¿Crees que estas dos distribuciones podrían compartir algún parámetro? Para esto puedes revisar el error estándar de los estimadores de máxima verosimilitud que mostramos arriba. ¿Qué ventajas verías en usar menos parámetros? ¿Cómo implementarías la estimación? ¿Qué pasa si intentas ajustar un modelo normal a estos datos? Modelos mal identificados Para algunos modelos y algunos parámetros, puede suceder que existan varias configuraciones muy diferentes de los parámetros que sean consistentes con los datos (en términos de verosimilitud, tienen verosimilitud alta similar), y en estos casos decimos que el modelo (con los datos observados) está mal identificado. Esto presenta problemas múltiples: optimizar es más difícil, hay incertidumbre grande en la estimación, y los parámetros se acoplan, haciendo difícil su interpretación. Ejemplo. Consideremos el ejemplo donde queríamos estimar dos proporciones: la proporción de examenes contestados al azar y la tasa de correctos. Vamos a suponer que la probabilidad de tener respuesta correcta dado que el examen no fue contestado al azar no es muy lejano a 1/5, que es la probabilidad de acertar a al azar. Aquí está la función para simular y la log verosimilitud correspondiente. Aquí vamos a ver un problema más difícil, así que usaremos la transformación logit para las proporciones, y no obtener resultados fuera del rango 0-1 al optimizar: inv_logit <- function(theta){ exp(theta) / (1 + exp(theta)) } logit <- function(p){ log(p / (1-p)) } # Simular datos sim_formas <- function(probs){ p_azar <- probs[1] p_corr <- probs[2] tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } simular_modelo <- function(n, params){ muestra <- map_dbl(1:n, ~ sim_formas(probs = inv_logit(params))) muestra } # log verosimilitud crear_log_p <- function(x){ log_p <- function(pars){ p_azar = inv_logit(pars[1]) p_corr = inv_logit(pars[2]) sum(log(p_azar * dbinom(x, 10, 1/5) + (1 - p_azar) * dbinom(x, 10, p_corr))) } log_p } # simular datos set.seed(12) muestra <- simular_modelo(2000, params = logit(c(0.3, 0.29))) qplot(muestra) log_p <- crear_log_p(muestra) res <- optim(c(0.0, 0.0), log_p, control = list(fnscale = -1)) res$convergence ## [1] 0 est_mle <- res$par names(est_mle) <- c("p_azar_logit", "p_corr_logit") est_mle ## p_azar_logit p_corr_logit ## -0.9194029 -0.8896454 probs_mle <- inv_logit(est_mle) names(probs_mle) <- c("p_azar", "p_corr") probs_mle ## p_azar p_corr ## 0.2850796 0.2911830 En primer lugar, parece ser que nuestras estimaciones son menos precias. Vamos a hacer bootstrap paramétrico: rep_boot <- function(rep, simular, crear_log_p, pars, n){ muestra_bootstrap <- simular(n, pars) log_p_boot <- crear_log_p(muestra_bootstrap) # optimizamos res_boot <- optim(c(0.0, 0.0), log_p_boot, control = list(fnscale = -1)) try(if(res_boot$convergence != 0) stop("No se alcanzó convergencia.")) est_mle_boot <- res_boot$par names(est_mle_boot) <- names(pars) est_mle_boot["rep"] <- rep est_mle_boot["convergence"] <- res_boot$convergence est_mle_boot } set.seed(8934) reps_boot <- map(1:500, ~ rep_boot(.x, simular_modelo, crear_log_p, est_mle, n = length(muestra))) |> bind_rows() reps_boot |> mutate(across(everything(), round, 2)) |> head() ## # A tibble: 6 × 4 ## p_azar_logit p_corr_logit rep convergence ## <dbl> <dbl> <dbl> <dbl> ## 1 -1.14 -0.92 1 0 ## 2 -1.11 -0.85 2 0 ## 3 -1.17 -0.95 3 0 ## 4 -2.74 -1.01 4 0 ## 5 -1.05 -0.93 5 0 ## 6 -0.91 -0.87 6 0 El optimizador encontró resultados que no tienen sentido: ggplot(reps_boot, aes(x = inv_logit(p_azar_logit), y = inv_logit(p_corr_logit), colour = factor(convergence))) + geom_point(show.legend = FALSE) + xlab("p_azar") + ylab("p_corr") Y notamos un problema grave: Tenemos mucha variación en nuestros estimadores, y la correlación entre las estimaciones es alta. Esto deberíamos haberlo esperado, pues como las probabilidades de contestar correctamente son muy similares a las de contestar al azar: Existen muchas combinaciones de parámetros que son consistentes con los datos. Decimos entonces que este modelo está mal identificado con estos datos. La mala identificación, como vemos, es una propiedad tanto de modelo como datos. ¿Qué conclusiones acerca del examen obtienes al ver estas simulaciones bootstrap? ¿Cómo se deberían reportar estos resultados? Qué pasa en este ejemplo si la \\(p_{corr}\\) es más grande, o el tamaño de muestra es más grande? Repite el ejercicio con los parámetros del primer ejemplo (\\(p_{azar} = 0.3, p_{corr}=0.75\\)) y el mismo tamaño de muestra. ¿Qué sucede en este caso? En el caso extremo, decimos que el modelo no está indentificado, y eso generalmente sucede por un problema en el planteamiento del modelo, independientemente de los datos. ¿Puedes imaginar un modelo así? "],["propiedades-teóricas-de-mle.html", "Sección 8 Propiedades teóricas de MLE Consistencia Equivarianza del \\(\\textsf{MLE}\\) Normalidad asintótica Optimalidad del \\(\\textsf{MLE}\\)", " Sección 8 Propiedades teóricas de MLE El método de máxima verosimiltud es uno de los métodos más utilizados en la inferencia estadística paramétrica. En esta sección estudiaremos las propiedades teóricas que cumplen los estimadores de máxima verosimilitud (\\(\\textsf{MLE}\\)) y que han ayudado en su casi adopción universal. Estas propiedades de los \\(\\textsf{MLE}\\) son válidas siempre y cuando el modelo \\(f(x; \\theta)\\) satisfaga ciertas condiciones de regularidad. En particular veremos las condiciones para que los estimadores de máxima verosimilitud sean: consistentes, asintóticamente normales, asintóticamente insesgados, asintóticamente eficientes, y equivariantes. Los estimadores \\(\\textsf{MLE}\\) en ocasiones son malinterpretados como una estimación puntual en la inferencia, y por ende, incapaces de cuantificar incertidumbre. A lo largo de estas notas hemos visto cómo extraer intervalos de confianza por medio de simulación y por lo tanto incorporar incertidumbre en la estimación. Sin embargo, hay otros maneras de reportar incertidumbre para \\(\\textsf{MLE}\\). Y hablaremos de ello en esta sección. A lo largo de esta sección asumiremos muestras de la forma \\[\\begin{align} X_1, \\ldots, X_n \\overset{\\text{iid}}{\\sim} f(x; \\theta^*), \\end{align}\\] donde \\(\\theta^*\\) es el valor verdadero —que suponemos desconocido pero fijo— del parámetro \\(\\theta \\in \\Theta\\), y sea \\(\\hat \\theta_n\\) el estimador de máxima verosimilitud de \\(\\theta.\\) Ejemplo Usaremos este ejemplo para ilustrar los diferentes puntos teóricos a lo largo de esta sección. Consideremos el caso de una muestra de variables binarias que registran el éxito o fracaso de un experimento. Es decir, \\(X_1, \\ldots, X_n \\sim \\textsf{Bernoulli}(p),\\) donde el párametro desconocido es el procentaje de éxitos. Éste último denotado por \\(p.\\) Este ejemplo lo hemos estudiado en secciones pasadas, y sabemos que el \\(\\textsf{MLE}\\) es \\[\\begin{align} \\hat p_n = \\frac{S_n}{n} = \\bar X_n, \\end{align}\\] donde \\(S_n= \\sum_i X_i\\) es el número total de éxitos en la muestra. La figura siguiente ilustra el estimador \\(\\hat p_n\\) como función del número de observaciones en nuestra muestra. Podemos apreciar cómo el promedio parece estabilizarse alrededor del verdadero valor de \\(p^* = 0.25\\) cuando tenemos una cantidad suficientemente grande de observaciones. Como es de esperarse, diferentes muestras tendrán diferentes valores de \\(n\\) dónde las trayectorias parezca que se haya estabilizado (Ver figura siguiente). Sin embargo, se puede notar que este comportamiento parece estar controlado y son raras las trayectorias que se encuentran más lejos. Los conceptos siguientes nos permitirán cuantificar el porcentaje de trayectorias que se mantienen cercanas a \\(p^*,\\) en el caso límite de un número grande de observaciones, cuando trabajemos con estimadores de máxima verosimilitud. Más aún, nos permitirán cracterizar la distribución para dicho límite y aprenderemos de otras propiedades bajo este supuesto asintótico. Consistencia Es prudente pensar que para un estimador, lo que nos interesa es que conforme más información tengamos, más cerca esté del valor desconocido. Esta propiedad la representamos por medio del concepto de consistencia. Para hablar de esta propiedad necesitamos definir un tipo de convergencia para una secuencia de variables aleatorias, convergencia en probabilidad. Definición. Una sucesión de variables aleatorias \\(X_n\\) converge en probabilidad a la variable aleatoria \\(X,\\) lo cual denotamos por \\(X_n \\overset{P}{\\rightarrow} X\\), si para toda \\(\\epsilon \\gt 0\\), \\[\\lim_{n \\rightarrow \\infty} \\mathbb{P}(|X_n - X| > \\epsilon) = 0.\\] Ahora, definimos un estimador consistente como: Definición. Un estimador \\(\\tilde \\theta_n\\) es consistente si converge en probabilidad a \\(\\theta^*.\\) Donde \\(\\theta^*\\) denota el verdadero valor del parámetro, que asumimos fijo. En particular, los estimadores \\(\\textsf{MLE}\\) son consistentes. Teorema. Sea \\(X_n \\sim f(X; \\theta^*),\\) una muestra iid, tal que \\(f(X; \\theta)\\) cumple con ciertas condiciones de regularidad. Entonces, \\(\\hat \\theta_n,\\) el estimador de máxima verosimilitud, converge en probabilidad a \\(\\theta^*.\\) Es decir, \\(\\hat \\theta_n\\) es consistente. La demostración de este teorema la pueden encontrar en Wasserman (2013). Ejemplo El estimador \\(\\hat p_n\\) es consistente. Esto quiere decir que el estimador se vuelve más preciso conforme obtengamos más información. En general esta es una propiedad que los estimadores deben satisfacer para ser útiles en la práctica. La figura siguiente muestra el estimador \\(\\hat p_n\\) como función del número de observaciones utilizado. Distintas curvas corresponden a distintas realizaciones de muestras obtenidas del modelo (\\(B = 500\\)). Nota que la banda definida por \\(\\epsilon\\) se puede hacer tan pequeña como se requiera, lo único que sucederá es que necesitaremos un mayor número de observaciones para garantizar que las trayectorias de los estimadores \\(\\hat p_n\\) se mantengan dentro de las bandas con alta probabilidad. Equivarianza del \\(\\textsf{MLE}\\) Muchas veces nos interesa reparametrizar la función de verosimilitud con el motivo de simplificar el problema de optimización asociado, o simplemente por conveniencia interpretativa. Por ejemplo, si el parámetro de interés es tal que \\(\\theta \\in [a, b],\\) entonces encontrar el \\(\\textsf{MLE}\\) se traduce en optimizar la log-verosimilitud en el espacio restringido al intervalo \\([a,b].\\) En este caso, los métodos tradicionales de búsqueda local por descenso en gradiente podrían tener problemas de estabilidad cuando la búsqueda se realice cerca de las cotas. El concepto de equivarianza nos dice que si el cambio de coordenadas parametrales está definida, y si este cambio de variable se realiza por medio de una función bien comportada (derivable y cuya derivada no es cero), entonces la solución de encontrar el \\(\\textsf{MLE}\\) en las coordenadas originales y transformar, es igual a realizar la inferencia en las coordenadas fáciles. Teorema. Sea \\(\\tau = g(\\theta)\\) una función de \\(\\theta\\) bien comportada. Entonces si \\(\\hat \\theta_n\\) es el \\(\\textsf{MLE}\\) de \\(\\theta,\\) entonces \\(\\hat \\tau_n = g(\\hat \\theta_n)\\) es el \\(\\textsf{MLE}\\) de \\(\\tau.\\) Ejemplo El concepto de equivarianza lo ilustraremos para nuestro ejemplo de esta sección. En particular la parametrización la realizamos por cuestiones de interpretación como un factor de riesgo. Como hemos visto estimador \\(\\hat p_n\\) es equivariante. Es importante mencionar que esta propiedad es general para cualquier tamaño de muestra. Es decir, no descansa en supuestos de muestras grandes. Supongamos que nos interesa estimar el momio de éxitos (bastante común en casas de apuestas). El momio está definido como \\[ \\theta = \\frac{p}{1-p},\\] y podemos rescribir la función de verosimilitud en términos de este parámetro. Sustituyendo \\(p = \\frac{\\theta}{1+\\theta}\\) en \\(\\mathcal{L}_n(p)\\) obtenemos \\[\\begin{align} \\mathcal{L}_n(\\theta) = \\left( \\frac{\\theta}{1 + \\theta} \\right)^{S_n} \\left(\\frac{1}{1 + \\theta} \\right)^{n - S_n}, \\end{align}\\] cuya función encuentra su máximo en \\[\\begin{align} \\hat \\theta_n = \\frac{\\bar X_n}{ 1 - \\bar X_n}. \\end{align}\\] Comprueba que el estimador de arriba para \\(\\theta\\) es el MLE. Normalidad asintótica Está propiedad nos permite caracterizar la distribución asintótica del MLE. Es decir, nos permite caracterizar la incertidumbre asociada una muestra suficientemente grande por medio de una distribución Gaussiana. Esto es, bajo ciertas condiciones de regularidad, \\[\\hat \\theta_n \\overset{.}{\\sim} \\mathsf{N}( \\theta^*, \\mathsf{ee}^2),\\] donde \\(\\mathsf{ee}\\) denota el error estándar del \\(\\textsf{MLE},\\) \\(\\mathsf{ee} = \\mathsf{ee}(\\hat \\theta_n) = \\sqrt{\\mathbb{V}(\\hat \\theta_n)}\\). Esta distribución se puede caracterizar de manera aproximada por métodos analíticos. Para esto necesitamos las siguientes definiciones. Definición. La función de score está definida como \\[\\begin{align} s(X; \\theta) = \\frac{\\partial \\log f(X; \\theta)}{\\partial \\theta}. \\end{align}\\] La información de Fisher está definida como \\[\\begin{align} I_n(\\theta) &= \\mathbb{V}\\left( \\sum_{i = 1}^ns(X_i; \\theta) \\right) \\\\ &= \\sum_{i = 1}^n \\mathbb{V} \\left(s(X_i; \\theta) \\right) \\end{align}\\] Estas cantidades nos permiten evaluar qué tan fácil será identificar el mejor modelo dentro de la familia parámetrica \\(f(X; \\theta)\\). La función de score nos dice qué tanto cambia locamente la distribución cuando cambiamos el valor del parámetro. Calcular la varianza, nos habla de la dispersión de dicho cambio a lo largo del soporte de la variable aleatoria \\(X.\\) Si \\(I_n(\\theta)\\) es grande entonces el cambio de la distribución es muy importante. Esto quiere decir que la distribución es muy diferente de las distribuciones cercanas que se generen al evaluar en \\(\\theta\\)s diferentes. Por lo tanto, si \\(I_n(\\theta)\\) es grande, la distribución será fácil de identificar cuando hagamos observaciones. La información de Fisher también nos permite caracterizar de forma analítica la varianza asíntotica del \\(\\textsf{MLE}\\) pues la aproximación \\(\\mathsf{ee}^2 \\approx \\frac{1}{I_n(\\theta^*)}\\) es válida. El siguiente resultado utiliza la propiedad de la función de score: \\(\\mathbb{E}[s(X; \\theta)] = 0,\\) que implica que \\(\\mathbb{V} \\left(s(X_i; \\theta) \\right) = \\mathbb{E}[s^2(X; \\theta)],\\) y permite a su vez un cómputo más sencillo de la información de Fisher. Teorema. El cálculo de la información de Fisher para una muestra de tamaño \\(n\\) se puede calcular de manera simplificada como \\(I_n(\\theta) = n \\, I(\\theta).\\) Por otro lado, tenemos la siguiente igualdad \\[ I(\\theta) = - \\mathbb{E}\\left( \\frac{\\partial^2 \\log f(X; \\theta)}{\\partial \\theta^2} \\right).\\] Con estas herramientas podemos formular el teorema siguiente. Teorema. Bajo ciertas condiciones de regularidad se satisface que \\(\\mathsf{ee} \\approx \\sqrt{1/I_n(\\theta^*)}\\) y \\[ \\hat \\theta_n \\overset{d}{\\rightarrow} \\mathsf{N}( \\theta^*, \\mathsf{ee}^2).\\] El resultado anterior es teóricamente interesante y nos asegura un comportamiento controlado conforme tengamos más observaciones disponibles. Sin embargo, no es práctico pues no conocemos \\(\\theta^*\\) en la práctica y por consiguiente no conoceríamos la varianza. Sin embargo, también podemos aplicar el principio de plug-in y caracterizar la varianza de la distribución asintótica por medio de \\[\\hat{\\mathsf{ee}} = \\sqrt{1/I_n(\\hat \\theta_n)}.\\] Esto último nos permite constuir intervalos de confianza, por ejemplo al 95%, a través de \\[ \\hat \\theta_n \\pm 2 \\, \\hat{\\mathsf{ee}}.\\] Asimismo, el teorema de Normalidad asintótica nos permite establecer que el \\(\\textsf{MLE}\\) es asíntoticamente insesgado. Es decir, \\[\\lim_{n \\rightarrow \\infty}\\mathbb{E}[\\hat \\theta_n] = \\theta^*.\\] Definición. Sea una muestra \\(X_1, \\ldots, X_n \\overset{iid}{\\sim} f(X; \\theta^*)\\). Un estimador \\(\\tilde \\theta_n\\) es insesgado si satisface que \\[\\mathbb{E}[\\tilde \\theta_n] =\\theta^*.\\] El sesgo del estimador es precisamente la diferencia: \\(\\textsf{Sesgo} = \\mathbb{E}[\\tilde \\theta_n] - \\theta^*.\\) Ejemplo: Información de Fisher En el caso Bernoulli obtenemos \\(I_n(\\theta) = \\frac{n}{\\theta(1-\\theta)}\\), si \\(n = 20\\) podemos comparar con \\(\\theta=0.5, 0.7, 0.8\\), library(patchwork) # Verosimilitud X_1,...,X_n ~ Bernoulli(theta) L_bernoulli <- function(n, S){ function(theta){ theta ^ S * (1 - theta) ^ (n - S) } } xy <- data.frame(x = 0:1) l_b1 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 10)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 10") + ylim(0, 5e-05) l_b2 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 14)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 14") + ylim(0, 5e-05) l_b3 <- ggplot(xy, aes(x = x)) + stat_function(fun = L_bernoulli(n = 20, S = 16)) + xlab(expression(theta)) + ylab(expression(L(theta))) + labs(title = "Verosimilitud", subtitle = "n=20, S = 19") + ylim(0, 5e-05) l_b1 + l_b2 + l_b3 Ejemplo: Normalidad Regresando a nuestro ejemplo. Veremos empiricamente que el estimador \\(\\hat \\theta_n\\) es asintóticamente normal. Esta propiedad la hemos visto anteriormente para un caso muy particular. Lo vimos en el TLC para el caso de promedios, \\(\\bar X_n,\\) que en nuestro ejemplo corresponde a \\(\\hat p_n\\). Como hemos visto, esta propiedad la satisface cualquier otro estimador que sea máximo verosímil. Por ejemplo, podemos utilizar el \\(\\mathsf{MLE}\\) de los momios. La figura que sigue muestra la distribución de \\(\\hat \\theta_n\\) para distintas remuestras \\((B = 500)\\) con distintos valores de \\(n.\\) El gráfico anterior valida empíricamente la distribución asintótica para casos de muchas observaciones. A continuación ilustraremos cómo explotar este resultado para obtener intervalos de confianza. Para el caso de \\(\\hat p_n\\) hemos visto que el error estándar se calcula analíticamente como \\[\\textsf{ee}_p^2 = \\mathbb{V}(\\hat p_n) = \\mathbb{V}\\left(\\frac1n \\sum_{i = 1}^n x_i\\right) = \\frac{p^* (1 - p^*)}{n}.\\] Éste empata con el valor del error estándar asintótico \\[\\textsf{ee}_p^2 \\approx \\sqrt{\\frac{1}{I_n(p^*)}},\\] pues la información de Fisher es igual a \\[I_n(p) = n \\, I(p) = \\frac{n}{p ( 1- p)}.\\] En este caso podemos utilizar el estimador plug-in, \\(\\hat{\\textsf{ee}}_p = \\textsf{ee}_p(\\hat p_n).\\) Para estimar el momio, \\(\\theta,\\) el cálculo no es tan fácil pues tendríamos que calcular de manera analítica la varianza de un cociente \\[\\textsf{ee}_\\theta^2 = \\mathbb{V}\\left( \\frac{\\hat p_n}{1-\\hat p_n}\\right).\\] Utilizando la distirbución asintótica, el error estándar se puede calcular mediante \\[\\textsf{ee}_\\theta \\approx \\sqrt{\\frac{1}{I_n(\\theta^*)}} = \\sqrt{\\frac{\\theta (1 + \\theta)^2 }{n}}.\\] A continuación mostramos los errores estándar para nuestro ejemplo utilizando la distribución asintótica y por medio de la distribución de bootstrap. Como es de esperarse, ambos coinciden para muestras relativamente grandes. # Genero muestra muestras <- tibble(tamanos = 2**seq(4,7)) %>% mutate(obs = map(tamanos, ~rbernoulli(., p = p_true))) calcula_momio <- function(x){ x / (1 - x) } calcula_ee_momio <- function(x){ sqrt(((1+x)**2) * x) } # Calculo MLE muestras_est <- muestras %>% group_by(tamanos) %>% mutate(media_hat = map_dbl(obs, mean), media_ee = sqrt(media_hat * (1 - media_hat)/tamanos), momio_hat = calcula_momio(media_hat), momio_ee = calcula_ee_momio(momio_hat)/sqrt(tamanos)) # Calculo por bootstrap muestras_boot <- muestras_est %>% group_by(tamanos) %>% mutate(sims_muestras = map(tamanos, ~rerun(1000, sample(muestras %>% filter(tamanos == ..1) %>% unnest(obs) %>% pull(obs), size = ., replace = TRUE))), sims_medias = map(sims_muestras, ~map_dbl(., mean)), sims_momios = map(sims_medias, ~map_dbl(., calcula_momio)), media_boot = map_dbl(sims_medias, mean), momio_boot = map_dbl(sims_momios, mean), media_ee_boot = map_dbl(sims_medias, sd), momio_ee_boot = map_dbl(sims_momios, sd) ) ## # A tibble: 4 × 5 ## # Groups: tamanos [4] ## tamanos momio_hat momio_boot momio_ee momio_ee_boot ## <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 16 0.333 0.367 0.192 0.236 ## 2 32 0.333 0.342 0.136 0.140 ## 3 64 0.123 0.123 0.0492 0.0498 ## 4 128 0.407 0.417 0.0793 0.0800 Comprueba las fórmulas para los errores estándar tanto para la probabilidad de éxito como para los momios. El método delta El ejercicio anterior nos sugiere una pregunta natural: Cómo establecer la distribución asintótica de un estimador cuando ya se conoce la de una pre-imagen de él? Es decir, si ya conocemos la distribución de \\(\\theta,\\) podemos establecer la distribución de \\(\\tau = g(\\theta)?\\) La respuesta es afirmativa y la enunciamos por medio de un teorema. El resultado se conoce como el método delta. Teorema. Si \\(\\tau = g(\\theta)\\) es una función diferenciable y \\(g'(\\theta) \\neq 0\\), entonces \\[\\hat \\tau_n \\overset{d}{\\rightarrow} \\mathsf{N}( \\tau^*, \\hat{\\mathsf{ee}}^2_\\tau),\\] donde \\(\\hat \\tau_n = g(\\hat \\theta_n)\\) y \\[\\hat{\\mathsf{ee}}_\\tau = \\bigg| g'(\\hat \\theta_n) \\bigg| \\times \\hat{\\mathsf{ee}}_\\theta(\\hat \\theta_n).\\] Por ejemplo, este resultado lo podemos utilizar para nuestro experimento de Bernoullis. Pues \\(g(p) = \\frac{p}{1-p}\\) es una función diferenciable y por lo tanto \\[\\hat{\\mathsf{ee}}_\\theta = \\sqrt{\\frac1n} \\times \\left[ \\hat p_n^{1/2} (1-\\hat p_n)^{-3/2}\\right].\\] Comprueba la fórmula del método delta para el momio en función de la fracción de éxitos, y también comprueba que de el mismo resultado analítico que habías calculado en el ejercicio anterior. Optimalidad del \\(\\textsf{MLE}\\) Consideremos el caso de una muestra iid \\(X_1, \\ldots, X_n \\sim \\mathsf{N}(\\theta, \\sigma^2).\\) Y consideremos dos estimadores para \\(\\theta.\\) El primero será la media muestral \\(\\bar X_n\\) y el segundo la mediana muestral, la cual denotaremos por \\(\\tilde \\theta_n.\\) Sabemos que ambos son insesgados. Por lo tanto, en promedio emiten estimaciones correctas. Pero ¿cómo escogemos cual utilizar? Un criterio para comparar estimadores es el error cuadrático medio (\\(\\textsf{ECM}\\), por sus siglas en inglés). Definición. El error cuadrático medio de un estimador \\(\\tilde \\theta_n\\) se calcula como \\[\\textsf{ECM}[\\tilde \\theta_n] = \\mathbb{E}[(\\tilde \\theta_n - \\theta^*)^2].\\] Por lo tanto, el \\(\\textsf{ECM}\\) mide la distancia promedio entre el estimador y el valor verdadero valor del parámetro. La siguiente igualdad es bastante útil para comparar dos estimadores. \\[\\textsf{ECM}[\\tilde \\theta_n] = \\mathbb{V}\\left(\\tilde \\theta_n\\right) + \\textsf{Sesgo}\\left[\\tilde \\theta_n\\right]^2.\\] Por lo tanto si dos estimadores son insesgados, uno es más eficiente que el otro si su varianza es menor. La media sabemos que es el \\(\\textsf{MLE}\\) y por el TCL tenemos que \\[\\sqrt{n} \\left( \\bar X_n - \\theta \\right) \\overset{d}{\\rightarrow} \\mathsf{N}( 0, \\sigma^2).\\] La mediana, en contraste, tiene una distribución asintótica \\[\\sqrt{n} \\left( \\tilde X_n - \\theta \\right) \\overset{d}{\\rightarrow} \\mathsf{N}\\left( 0, \\sigma^2 \\frac{\\pi}{2}\\right),\\] es decir tiene una varianza ligeramente mayor. Por lo tanto, decimos que la mediana tiene una eficiencia relativa con respecto a la media del \\(.63 \\% (\\approx 2/\\pi)\\). Es decir, la mediana sólo utliza una fracción de los datos comparado con la media. El siguiente teorema, la desigualdad de Cramer-Rao, nos permite establecer esta resultado de manera mas general para cualquier estimador insesgado. Teorema. Sea \\(\\tilde \\theta_n\\) cualquier estimador insesgado de \\(\\theta\\) cuyo valor verdadero es \\(\\theta^*,\\) entonces \\[\\begin{align} \\mathbb{V}(\\tilde \\theta_n) \\geq \\frac{1}{n I(\\theta^*)}. \\end{align}\\] Un estimador insesgado que satisfaga esta desigualdad se dice que es eficiente. Nota que el lado derecho de la desigualdad es precisamente la varianza asintótica del \\(\\textsf{MLE}.\\) Por lo tanto, éste es asintóticamente eficiente. Es importante hacer enfásis en que la optimalidad del \\(\\textsf{MLE}\\) es un resultado asintótico. Es decir, sólo se satisface cuando tenemos un número suficiente de observaciones. Qué tan grande debe ser el tamaño de muestra varia de problema a problema. Es por esto que para muestras de tamaño finito se prefieren estimadores que minimicen el \\(\\textsf{ECM},\\) como cuando hacemos regresión ridge o utilizamos el estimador James–Stein para un vector de medias. Referencias "],["más-de-pruebas-de-hipótesis-e-intervalos.html", "Sección 9 Más de pruebas de hipótesis e intervalos Prueba de Wald Observación: pruebas \\(t\\) y práctica estadística Prueba de Wald para dos medias o proporciones Datos pareados Pruebas de cociente de verosimilitud Otro tipo de pruebas Errores tipo I y tipo II Consideraciones prácticas Pruebas múltiples", " Sección 9 Más de pruebas de hipótesis e intervalos En esta sección veremos enfoques más clásicos para analizar una prueba de hipótesis, en particular veremos situaciones donde podemos hacer algunos supuestos teóricos acerca de la distribución de las poblaciones. Esta es una sección complementaria para entender prácticas estadísticas usuales: recuerda que discutimos antes que hacer estimación por intervalos generalmente es más útil que hacer pruebas de hipótesis, y adicionalmente, tenemos también la técnica de pruebas de permutaciones que podemos aplicar en muchos de los casos que discutiremos a continuación. El enfoque básico es el mismo que cuando vimos pruebas de permutaciones: calculamos una estadística de prueba de los datos y luego, con una distribución de referencia (asociada a la hipótesis nula), calculamos un valor-\\(p\\). Si el valor-\\(p\\) es chico, entonces los resultados observados no pueden explicarse fácilmente por variación muestral, y rechazamos la hipótesis nula. Con esta idea básica, y supuestos distribucionales acerca de las poblaciones, podemos construir pruebas que requieren menos cómputo. La desventaja es que hay que checar con cuidado los supuestos distribucionales que hagamos. Si los supuestos son incorrectos, las valores-\\(p\\) no tienen mucho sentido y son difíciles de interpretar. Para esta sección seguiremos más a Wasserman (2013) (capítulo 10), pero puedes revisar también Chihara and Hesterberg (2018) (capítulo 8). Prueba de Wald Como hemos visto, existe normalidad asintótica en varios estimadores que hemos considerado, como medias y proporciones muestrales. También vimos que estimadores de máxima verosimilitud cumplen muchas veces un teorema central del límite. Así que supongamos que tenemos una estadística \\(\\hat{\\theta}_n\\) que estima \\(\\theta\\) y es asintóticamente insesgada y normal. Denotamos por \\(\\hat{\\textsf{ee}}\\) una estimación de su error estándar —hay distintas maneras de hacerlo: por ejemplo, con simulación (bootstrap), o por medios analíticos (teoría). Recuerda que el error estándar de una estadística es la desviación estándar de su distribución de muestreo. Si nos interesa probar la hipótesis de que \\(\\theta = 125\\), por ejemplo, y \\(\\hat{\\theta}_n\\) es aproximadamente normal, entonces podemos construir una distribución de referencia aproximada como sigue: Si la nula es cierta, entonces la distribución de muestreo de \\(\\hat{\\theta}\\) es aproximadamente \\(\\mathsf{N}(125, \\hat{\\textsf{ee}})\\). Esto implica que la siguiente estadística \\(W\\) es aproximadamente normal estándar bajo la nula: \\[W = \\frac{\\hat{\\theta} - 125}{\\hat{\\textsf{ee}}} \\sim \\mathsf{N}(0,1)\\] Por lo que valores lejanos de \\([-2,2]\\), por ejemplo, dan evidencia en contra de la hipótesis nula. Como \\(W\\) no depende de ningún parámetro desconocido, podemos usarla como distribución de referencia para comparar el valor de \\(W\\) que obtuvimos en la muestra. Si observamos para nuestra muestra un valor \\(W=w\\) entonces, el valor-\\(p\\) (dos colas) de esta prueba es, aproximadamente, \\[\\mathsf{valor-}p \\approx P(|Z| > |w|) = 2(1 - \\Phi(|w|))\\] donde \\(Z\\sim \\mathsf{N}(0,1)\\) y \\(\\Phi\\) es su función de distribución acumulada. Ejemplo: media muestral. La media nacional de las escuelas de enlace está alrededor de 454 (matemáticas en 6o. grado). Tomamos una muestra de 180 escuelas del Estado de México, y queremos saber si la media obtenida es consistente o no con la media nacional. Ya que estamos usando como estimador una media de una muestra iid, podemos estimar el error estándar de la media con \\[\\hat{\\textsf{ee}} = s / \\sqrt{n}\\] Obtenemos: set.seed(29) muestra_edomex <- read_csv("data/enlace.csv") |> filter(estado == "ESTADO DE MEXICO") |> sample_n(180) resumen <- muestra_edomex |> summarise(media = mean(mate_6), s = sd(mate_6), n = n()) |> mutate(ee = s / sqrt(n)) resumen ## # A tibble: 1 × 4 ## media s n ee ## <dbl> <dbl> <int> <dbl> ## 1 456. 155. 180 11.5 La hipótesis nula es que la media poblacional del Estado de México es igual a 454. Calculamos el valor-\\(p\\) usando la prueba de Wald: dif <- (resumen |> pull(media)) - 454 ee <- resumen |> pull(ee) w <- dif / ee p <- 2 * (1 - pt(abs(w), 179)) p ## [1] 0.8413082 y vemos que esta muestra es consistente con la media nacional. No tenemos evidencia en contra de que la media del estado de México es muy similar a la nacional. Repite esta prueba con una muestra de Chiapas. ¿Qué resultado obtienes? Tenemos entonces: Prueba de Wald. Consideramos probar la hipótesis nula \\(H_0: \\theta = \\theta_0\\) contra la alternativa \\(H_1: \\theta \\neq \\theta_0\\). Suponemos que \\(\\hat{\\theta}_n\\) es asintóticamente normal e insesgada, de modo que bajo la hipótesis nula \\[\\frac{\\hat{\\theta}_n - \\theta_0}{\\hat{\\textsf{ee}}} \\sim \\mathsf{N}(0,1).\\] Entonces el valor-\\(p\\) de la prueba de Wald para esta hipótesis nula es \\[\\mathsf{valor-}p \\approx P(|Z| > |w|) = 2(1 - \\Phi(|w|)).\\] Ejemplo. Podemos hacer la prueba de Wald para proporciones con el estimador usual \\(\\hat{p}_n\\) que estima una proporción poblacional \\(p\\). En este caso, utilizamos la estimación usual del error estándar de \\(\\hat{p}_n\\), que está dada por \\[\\hat{\\textsf{ee}} = \\sqrt{\\frac{\\hat{p}_n(1-\\hat{p}_n)}{n}}.\\] Supongamos por ejemplo que en nuestros datos observamos que en \\(n=80\\) muestras independientes, tenemos \\(x=47\\) éxitos. ¿Es esto consistente con la hipótesis nula \\(p = 0.5\\)? Calcuamos primero: p_hat <- 47 / 80 ee <- sqrt(p_hat * (1 - p_hat) / 80) y la estadística \\(W\\) de prueba es: w <- (p_hat - 0.5) / ee w ## [1] 1.58978 Calculamos su valor p: valor_p <- 2 * (1 - pnorm(abs(w))) valor_p ## [1] 0.1118843 Y vemos que en este caso tenemos evidencia baja de que la proporción poblacional es distinta de 0.5. Observación: pruebas \\(t\\) y práctica estadística Con más supuestos distribucionales podemos hacer otros tipos de pruebas donde no requerimos hacer supuestos asintóticos. Por ejemplo, si suponemos que la muestra obtenida \\(X_1,\\ldots, X_n\\) proviene de una distribución normal \\(\\mathsf{N}(\\mu, \\sigma)\\) (cosa que es necesario verificar), entonces es posible demostrar que la estadística \\[T = \\frac{\\bar{X} - \\mu}{S / \\sqrt{n}}\\] tiene una distribución exacta que es \\(t\\) de Student con \\(n-1\\) grados de libertad, y no depende de otros parámetros, de manera que podemos usarla como distribución de referencia y podemos calcular valores \\(p\\) exactos (revisa la sección 8.1 de Chihara and Hesterberg (2018)). La diferencia con usar una prueba de Wald está en que aquí consideramos también la variablidad del error estándar estimado, lo que correctamente sugiere que esperamos variaciones proporcionalmente más grandes en \\(T\\) comparado con lo que sucede si no consideramos esta variación (como en la prueba de Wald). Sin embargo: Si la muestra \\(n\\) es grande, la distribución \\(t\\) de Student con \\(n-1\\) grados de libertad es muy similar a la normal estándar, de manera que la aproximación de Wald es apropiada. Cuando la muestra \\(n\\) es chica, es difícil validar el supuesto de normalidad, a menos que tengamos alguna información adicional acerca de la distribución poblacional. La prueba tiene cierta robustez a desviaciones de normalidad de las observaciones, pero si el sesgo es muy grande, por ejemplo, el supuesto es incorrecto y da valores \\(p\\) distorsionados. Puedes ver aquí, o el apéndice B.11 de Chihara and Hesterberg (2018) para ver descripciones de la distribución \\(t\\) y cómo se compara con una normal estándar dependiendo de los grados de libertad. En muchas ocasiones, en la práctica es común no checar supuestos y saltar directamente a hacer pruebas \\(t\\), lo cual no es muy seguro. Si tenemos duda de esos supuestos, podemos hacer pruebas gráficas o de permutaciones, si son apropiadas. Prueba de Wald para dos medias o proporciones Cuando tenemos dos muestras extraidas de manera independiente de dos poblaciones distintas, y queremos ver si la hipótesis de medias poblacionales iguales es consistente con los datos, podemos usar también una prueba de Wald. Sea \\(\\bar{X}_1\\) y \\(\\bar{X}_2\\) las medias muestrales correspondientes. Si la hipótesis de normalidad aplica para ambas distribuciones muestrales (normalidad asintótica), la variable \\[\\hat{\\delta} = \\bar{X}_1 - \\bar{X}_2\\] es aproximadamente normal con media \\(\\mathsf{N}(\\mu_1 - \\mu_2, \\textsf{ee})\\), donde \\(\\mu_1\\) y \\(\\mu_2\\) son las medias poblacionales correspondientes, y donde el error estándar de \\(\\hat{\\delta}\\) es la raíz de la suma de los cuadrados de los errores estándar de \\(\\bar{X}\\) y \\(\\bar{Y}\\): \\[ \\textsf{ee} = \\sqrt{\\textsf{ee}_1^2 + \\textsf{ee}_{2}^2}.\\] Se sigue entonces que: \\[\\textsf{ee} =\\sqrt{\\frac{\\sigma_1^2}{n_1}+\\frac{\\sigma_2^2}{n_2} }\\] (Nota: usa probabilidad para explicar por qué es cierto esto). De esto se deduce que bajo la hipótesis nula de igualdad de medias \\(\\mu_1 = \\mu_2\\), tenemos que la estadística de Wald \\[W = \\frac{\\hat{\\delta} - 0}{\\sqrt{\\frac{s_1^2}{n_1}+\\frac{s_2^2}{n_2}} } \\sim \\mathsf{N}(0,1)\\] es aproximamente normal estándar. Procedemos entonces a calcular el valor \\(p\\) usando la función de distribución acumulada de la normal estándar. En el caso particular de proporciones, podemos simplificar, como hicimos arriba, a \\[W = \\frac{\\hat{p}_1 - \\hat{p}_2}{\\sqrt{\\frac{\\hat{p}_1(1-\\hat{p}_1)}{n_1}+\\frac{\\hat{p}_2(1-\\hat{p}_2)}{n_2}} } \\sim \\mathsf{N}(0,1)\\] Haz una prueba comparando las medias en enlace de la Ciudad de México vs Estado de México. ¿Hay evidencia de que tienen distintas medias? Ejemplo (Wasserman (2013)). Supongamos tenemos dos conjuntos de prueba para evaluar algoritmos de predicción, de tamaños \\(n_1=100\\) y \\(n_2=250\\) respectivamente, tenemos dos algoritmos para generar predicciones de clase (digamos positivo y negativo). Usaremos el primer conjunto para evaluar el algoritmo 1 y el segundo para evaluar el algoritmo 2. El algoritmo 1 corre en 1 hora, y el algoritmo 2 tarda 24 horas. Supón que obtenemos que la tasa de clasificación correcta del primer algoritmo es \\(\\hat{p}_1 = 0.85\\), y la tasa del segundo es de \\(\\hat{p}_2 = 0.91\\). ¿Estos datos son consistentes con la hipótesis de que los algoritmos tienen desempeño muy similar? Es decir, queremos probar la hipótesis \\(p_1 = p_2\\). Calculamos la estadística de Wald: n_1 <- 100 n_2 <- 250 p_hat_1 <- 0.86 p_hat_2 <- 0.90 ee <- sqrt(p_hat_1 * (1 - p_hat_1) / n_1 + p_hat_2 * (1 - p_hat_2) / n_2) delta = p_hat_1 - p_hat_2 w <- delta / ee w ## [1] -1.011443 que da un valor p de: 2 * (1 - pnorm(abs(w))) ## [1] 0.3118042 Y vemos que valor-\\(p\\) es grande, de forma que los datos son consistentes con la hipótesis de que los algoritmos tienen desempeño similar. ¿Cómo tomaríamos nuestra decisión final? Si la diferencia entre 1 hora y 24 horas no es muy importante, entonces preferíamos usar el algoritmo 2. Sin embargo, si el costo de 24 horas es más alto que 1 hora de corrida, los datos no tienen indicios fuertes de que vayamos a perder en desempeño, y podriamos seleccionar el algoritmo 1. Datos pareados Las pruebas que acabamos de ver para comparar medias requieren poblaciones independientes. Si las dos muestras están pareadas (es decir, son dos mediciones en una misma muestra), podemos tomar considerar las diferencias \\(D_i = X_i - Y_i\\) y utilizar la prueba para una sola muestra con la media \\(\\bar{D}\\). Esta es una prueba de Wald pareada. Ejemplo (Wasserman (2013)). Ahora supongamos que utilizamos la misma muestra de tamaño \\(n=300\\) para probar los dos algoritmos. En este caso, no debemos hacer la prueba para medias de muestras independientes. Sin embargo, esto podemos ponerlo en términos de una prueba para una sola muestra. Tenemos las observaciones \\(X_1,\\ldots, X_n\\) y \\(Y_1,\\dots, Y_n\\), donde \\(X_i=1\\) si el algoritmo 1 clasifica correctamente, y 0 en otro caso. Igualmente, \\(Y_i=1\\) si el algoritmo 2 clasifica correctamente, y 0 en otro caso. Definimos \\[D_i= X_i - Y_i\\] Y \\(D_1,\\ldots, D_n\\) es una muestra iid. Ahora observemos que la media \\(\\bar{D}\\) tiene valor esperado \\(p_1 - p_2\\), donde \\(p_1\\) y \\(p_2\\) son las tasas de correctos del algoritmo 1 y del algoritmo 2 respectivamente. Podemos hacer una prueba de Wald como al principio de la sección: \\[W = \\frac{\\bar{D} - 0}{{\\textsf{ee}}}\\] Y notemos que el error estándar no se calcula como en el ejemplo anterior. Podríamos usar bootstrap para estimarlo, pero en este caso podemos usar el estimador usual \\[\\hat{\\textsf{ee}} = S / \\sqrt{n}\\] donde \\[S = \\frac{1}{n}\\sum_{i=1}^n (D_i - \\bar{D})^2\\] y nótese que necesitamos las decisiones indiviudales de cada algoritmo para cada caso, en contraste al ejemplo anterior de muestras independientes donde los errores estándar se calculaban de manera independiente. Esto tiene sentido, pues la variablidad de \\(\\bar{D}\\) depende de cómo están correlacionados los aciertos de los dos algoritmos. Supongamos por ejemplo que los datos que obtenemos son: datos_clasif |> head() ## # A tibble: 6 × 3 ## caso x y ## <chr> <dbl> <dbl> ## 1 1 1 1 ## 2 2 0 1 ## 3 3 0 1 ## 4 4 0 1 ## 5 5 0 1 ## 6 6 1 0 Como explicamos arriba, nos interesa la diferencia. Calculamos \\(d\\): datos_clasif <- datos_clasif |> mutate(d = x - y) datos_clasif |> head() ## # A tibble: 6 × 4 ## caso x y d ## <chr> <dbl> <dbl> <dbl> ## 1 1 1 1 0 ## 2 2 0 1 -1 ## 3 3 0 1 -1 ## 4 4 0 1 -1 ## 5 5 0 1 -1 ## 6 6 1 0 1 datos_clasif |> summarise(sd_x = sd(x), sd_y = sd(y), sd_d = sd(d)) ## # A tibble: 1 × 3 ## sd_x sd_y sd_d ## <dbl> <dbl> <dbl> ## 1 0.393 0.309 0.539 Y ahora calculamos la media de \\(d\\) (y tasa de correctos de cada clasificador:) medias_tbl <- datos_clasif |> summarise(across(where(is.numeric), mean, .names = "{col}_hat")) d_hat <- pull(medias_tbl, d_hat) medias_tbl ## # A tibble: 1 × 3 ## x_hat y_hat d_hat ## <dbl> <dbl> <dbl> ## 1 0.81 0.893 -0.0833 Ahora necesitamos calcular el error estándar. Como explicamos arriba, hacemos ee <- datos_clasif |> mutate(d_hat = mean(d)) |> mutate(dif_2 = (d - d_hat)) |> summarise(ee = sd(dif_2) / sqrt(n())) |> pull(ee) ee ## [1] 0.03112829 Y ahora podemos calcular la estadística \\(W\\) y el valor p correspondiente: w <- d_hat / ee valor_p <- 2 * (1 - pnorm(abs(w))) c(w = w, valor_p = valor_p) |> round(3) ## w valor_p ## -2.677 0.007 Y vemos que tenemos evidencia considerable de que el desempeño no es el mismo: el algoritmo 2 parece ser mejor. ¿Qué pasaría si incorrectamente usaras la prueba de dos muestras para este ejemplo? ¿Qué cosa cambia en la fórmula de la estadística de Wald? Pruebas de cociente de verosimilitud Otra técnica clásica para hacer pruebas de hipótesis es el de cociente de verosimilitudes. Con esta técnica podemos hacer pruebas que involucren varios parámetros, y podemos contrastar hipótesis nulas contra alternativas especificas. Para aplicar este tipo de pruebas es necesario hacer supuestos distribucionales (modelos probabilísticos), pues estas pruebas se basan en la función de verosimilitud \\(\\mathcal{L}(\\theta; x_1,\\ldots, x_n)\\). Ejemplo. Supongamos que tenemos la hipótesis nula de que una moneda es justa (\\(p =0.5\\) de sol). En 120 tiros de la moneda (que suponemos independientes), observamos 75 soles. Recordemos la función de log-verosimilitud para el modelo binomial (ignorando constantes que no dependen de \\(p\\)) es \\[\\ell(p) = 75 \\log(p) + (120 - 75)\\log(1-p) \\] Primero calculamos el estimador de máxima verosimilitud de \\(p\\), que es \\(\\hat{p} = 75/120 = 0.625\\). Evaluamos la verosimilitud \\[\\ell(\\hat{p}) = \\ell(0.625) = 75\\log(0.625) + 45\\log(0.375) = -79.388\\] - Ahora evaluamos la verosimlitud según la hipótesis nula, donde asumimos que \\(p = 0.5\\): \\[\\ell(p_0) = \\ell(0.5) = 75\\log(0.5) + 45\\log(0.5) = -83.177\\] - Finalmente, contrastamos estos dos números con una estadística que denotamos con \\(\\lambda\\): \\[\\lambda = 2\\left[\\ell(\\hat{p}) - \\ell(p_0)\\right] = 2[\\ell(0.625)- \\ell(0.5)] = 2(3.79)=7.58\\] A \\(\\lambda\\) se le llama la estadística de cociente de verosimilitud. Tomamos la diferencia de log verosimilitudes, que es los mismo que tomar el logaritmo del cociente de verosimilitudes, y de ahí el nombre de la prueba. Nótese que cuando este número \\(\\lambda\\) es muy grande, esto implica que la hipótesis nula es menos creíble, o menos consistente con los datos, pues la nula tiene mucho menos verosimilitud de lo que los datos indican. Por otro lado, cuando este valor es cercano a 0, entonces tenemos menos evidencia en contra de la hipótesis nula. Esto se explica en la siguiente gráfica: log_verosim <- function(p){ 75 * log(p) + (120 - 75) * log(1 - p) } verosim_tbl <- tibble(p = seq(0.4, 0.7, 0.01)) |> mutate(log_verosim = log_verosim(p)) ggplot(verosim_tbl, aes(x = p, y = log_verosim)) + geom_line() + geom_segment(x = 75/120, xend = 75/120, y = -130, yend = log_verosim(75/120), colour = "red") + geom_segment(x = 0.5, xend = 0.5, y = -130, yend = log_verosim(0.5), colour = "gray") + geom_errorbar(aes(x = 0.5, ymin = log_verosim(0.5), ymax = log_verosim(75/120)), colour = "orange", width = 0.05) + annotate("text", x = 0.48, y = -81.5, label = "3.79") + annotate("text", x = 0.515, y = -91, label ="nula", colour = "gray20") + annotate("text", x = 0.665, y = -91, label ="max verosímil", colour = "red") + labs(subtitle = expression(paste(lambda, "=2(3.79)=7.58"))) Este método puede generalizarse para que no solo aplique a hipótesis nulas donde \\(\\theta = \\theta_0\\), sino en general, \\(\\theta \\in \\Theta_0\\). Por ejemplo, podemos construir pruebas para \\(\\theta < 0.4\\). Definición. Consideramos la hipótesis nula \\(\\theta= \\theta_0\\). La estadística del cociente de verosimilitudes está dada por: \\[\\lambda = 2\\log\\left( \\frac{\\max_{\\theta}\\mathcal{L}(\\theta)}{\\max_{\\theta=\\theta_0}\\mathcal{L}(\\theta)} \\right ) = 2\\log\\left( \\frac{\\mathcal{L}(\\hat{\\theta})}{\\mathcal{L}(\\theta_0)} \\right)\\] donde \\(\\hat{\\theta}\\) es el estimador de máxima verosimilitud. Para construir una prueba asociada, como siempre, necesitamos una distribución de referencia. Esto podemos hacerlo con simulación, o usando resultados asintóticos. Distribución de referencia para pruebas de cocientes Para nuestro ejemplo anterior, podemos simular datos bajo la hipótesis nula, y ver cómo se distribuye la estadística \\(\\lambda\\): Ejemplo. Simulamos bajo la hipótesis nula como sigue: n_volados <- 120 # número de volados simulados_nula <- rbinom(4000, n_volados, p = 0.5) lambda <- function(n, x, p_0 = 0.5){ # estimador de max verosim p_mv <- x / n # log verosimilitud bajo mv log_p_mv <- x * log(p_mv) + (n - x) * log(1 - p_mv) # log verosimllitud bajo nula log_p_nula <- x * log(p_0) + (n - x) * log(1 - p_0) lambda <- 2*(log_p_mv - log_p_nula) lambda } lambda_obs <- lambda(n_volados, 75, 0.5) sims_tbl <- tibble(sim_x = simulados_nula) |> mutate(lambda = map_dbl(sim_x, ~ lambda(n_volados, .x, p_0 = 0.5))) ggplot(sims_tbl, aes(x = lambda)) + geom_histogram(binwidth = 0.7) + geom_vline(xintercept = lambda_obs, color = "red") Con esta aproximación a la distribución de referencia podemos calcular el valor p en nuestro ejemplo anterior: valor_p <- mean(sims_tbl$lambda >= lambda_obs) valor_p ## [1] 0.00675 y observamos que tenemos evidencia fuerte en contra de la hipótesis nula: la moneda no está balanceada. Ejemplo. Este ejemplo es un poco artificial, pero lo usamos para entender mejor las pruebas de cocientes de verosimlitud. Supongamos que tenemos una muestra de \\(\\mathsf{N}(\\mu, 1)\\), y queremos probar si \\(\\mu = 8\\). Asumimos que el supuesto de normalidad y desviación estándar iugal a 1 se cumplen. set.seed(3341) n_muestra <- 100 muestra_1 <- rnorm(n_muestra, 7.9, 1) crear_log_p <- function(x){ # crear log verosim para dos muestras normales independientes. log_p <- function(params){ mu <- params[1] log_vero <- dnorm(x, mean = mu, sd = 1, log = TRUE) |> sum() log_vero } } lambda_calc <- function(muestra, crear_log_p){ log_p <- crear_log_p(muestra) res <- optim(c(0), log_p, control = list(fnscale = -1)) lambda_mv <- log_p(res$par) lambda_nula <- log_p(8.0) lambda <- 2 * (lambda_mv - lambda_nula) lambda } lambda <- lambda_calc(muestra_1, crear_log_p) lambda ## [1] 2.101775 Ahora construimos con simulación la distribución de referencia usando simulaciones bajo la nula sims_nula <- map(1:10000, ~ rnorm(n_muestra, 8, 1)) lambda_nula_sim <- map_dbl(sims_nula, ~ lambda_calc(.x, crear_log_p)) tibble(lambda = lambda_nula_sim) |> ggplot(aes(x = lambda)) + geom_histogram() + geom_vline(xintercept = lambda, colour = "red") valor_p <- mean(lambda_nula_sim >= lambda) valor_p ## [1] 0.1537 Estos datos muestran consistencia con la hipótesis \\(\\mu = 8\\). Discusión: Nota en los dos ejemplos anteriores la similitud entre las distribuciones de referencia. En ambos casos, estas distribuciones resultan ser aproximadamente \\(\\chi\\)-cuadrada con 1 grado de libertad (ji-cuadrada). Podemos checar para el último ejemplo: teorica <- tibble(x = seq(0.1, 10, 0.01)) |> mutate(f_chi_1 = dchisq(x, df = 1)) tibble(lambda = lambda_nula_sim) |> ggplot() + geom_histogram(aes(x = lambda, y = ..density..), binwidth = 0.1) + geom_line(data = teorica, aes(x = x, y = f_chi_1), colour = "red") O mejor, con una gráfica de cuantiles de las simulaciones vs la téorica: tibble(lambda = lambda_nula_sim) |> ggplot(aes(sample = lambda)) + geom_qq(distribution = stats::qchisq, dparams = list(df = 1)) + geom_qq_line(distribution = stats::qchisq, dparams = list(df = 1)) Este resultado asintótico no es trivial, y se usa comúnmente para calcular valores \\(p\\). Discutiremos más este punto más adelante. Otro tipo de pruebas Con cocientes de verosimlitud podemos diseñar pruebas para contrastar condiciones que sólo un subconjunto de parámetros cumple. Ejemplo. Supongamos que queremos hacer una prueba de igualdad de medias \\(\\mu_1 = \\mu_2\\) para dos poblaciones normales \\(\\mathsf{N}(\\mu_1, \\sigma_1)\\) y \\(\\mathsf{N}(\\mu_2, \\sigma_2)\\), donde extraemos las muestras de manera independiente, y no conocemos las desviaciones estándar. Obtenemos dos muestras (que supondremos provienen de distribuciones normales, pues ese es nuestro supuesto) set.seed(223) muestra_1 <- rnorm(80, 0.8, 0.2) muestra_2 <- rnorm(120, 0.8, 0.4) Necesitamos: 1) calcular el valor de la estadística \\(\\lambda\\) de cociente de verosimilitudes, 2) Calcular la distribución de referencia para \\(\\lambda\\) bajo la hipótesis nula y finalmente 3) Ver qué tan extremo es el valor obtenido de \\(\\lambda\\) en relación a la distribución de referencia. crear_log_p <- function(x, y){ # crear log verosim para dos muestras normales independientes. log_p <- function(params){ mu_1 <- params[1] mu_2 <- params[2] sigma_1 <- params[3] sigma_2 <- params[4] log_vero_1 <- dnorm(x, mean = mu_1, sd = sigma_1, log = TRUE) |> sum() log_vero_2 <- dnorm(y, mean = mu_2, sd = sigma_2, log = TRUE) |> sum() log_vero <- log_vero_1 + log_vero_2 #se suman por independiencia log_vero } } log_p <- crear_log_p(muestra_1, muestra_2) crear_log_p_nula <- function(x, y){ log_p <- function(params){ # misma media mu <- params[1] sigma_1 <- params[2] sigma_2 <- params[3] log_vero_1 <- dnorm(x, mean = mu, sd = sigma_1, log = TRUE) |> sum() log_vero_2 <- dnorm(y, mean = mu, sd = sigma_2, log = TRUE) |> sum() log_vero <- log_vero_1 + log_vero_2 #se suman por independiencia log_vero } } log_p_nula <- crear_log_p_nula(muestra_1, muestra_2) Ahora tenemos el problema de que no conocemos las sigma. Estas deben ser estimadas para después calcular el cociente de verosimilitud: res <- optim(c(0, 0, 1, 1), log_p, method = "Nelder-Mead", control = list(fnscale = -1)) res$convergence ## [1] 0 est_mv <- res$par names(est_mv) <- c("mu_1", "mu_2", "sigma_1", "sigma_2") est_mv ## mu_1 mu_2 sigma_1 sigma_2 ## 0.8153471 0.7819913 0.1987545 0.3940484 Y tenemos lambda_1 <- log_p(est_mv) lambda_1 ## [1] -42.76723 Ahora calculamos el máximo bajo el supuesto de la hipótesis nula: res <- optim(c(0, 1, 1), log_p_nula, method = "Nelder-Mead", control = list(fnscale = -1)) res$convergence ## [1] 0 est_mv_nula <- res$par names(est_mv) <- c("mu", "sigma_1", "sigma_2") est_mv_nula ## [1] 0.8062091 0.1989438 0.3948603 y evaluamos lambda_2 <- log_p_nula(est_mv_nula) lambda_2 ## [1] -43.07902 Finalmente, nuestra estadística \\(\\lambda\\) es lambda <- 2 * (lambda_1 - lambda_2) lambda ## [1] 0.6235661 Y ahora necesitamos calcular un valor-\\(p\\). El problema que tenemos en este punto es que bajo la hipótesis nula no están determinados todos los parámetros, así que no podemos simular de manera simple muestras para obtener la distribución de referencia. Podemos sin embargo usar bootstrap paramétrico usando los estimadores de máxima verosimilitud bajo la nula simular_boot <- function(n_1, n_2, est_mv_nula){ x <- rnorm(n_1, est_mv_nula[1], est_mv_nula[2]) y <- rnorm(n_2, est_mv_nula[1], est_mv_nula[3]) list(x = x, y = y) } lambda_nula_sim <- function(est_mv_nula){ muestras <- simular_boot(80, 120, est_mv_nula) x <- muestras$x y <- muestras$y log_p <- crear_log_p(x, y) log_p_nula <- crear_log_p_nula(x, y) est_1 <- optim(c(0,0,1,1), log_p, control = list(fnscale = -1)) est_2 <- optim(c(0,1,1), log_p_nula, control = list(fnscale = -1)) lambda <- 2*(log_p(est_1$par) - log_p_nula(est_2$par)) lambda } lambda_sim <- map_dbl(1:2000, ~ lambda_nula_sim(est_mv_nula = est_mv_nula)) Y graficamos la distribución de referencia junto con el valor de \\(\\lambda\\) que obtuvimos: tibble(lambda = lambda_sim) |> ggplot(aes(x = lambda)) + geom_histogram() + geom_vline(xintercept = lambda, colour = "red") Y claramente los datos son consistentes con medias iguales. El valor-\\(p\\) es mean(lambda_sim > lambda) ## [1] 0.4275 Verificamos una vez más que la distribución de referencia es cercana a una \\(\\chi\\)-cuadrada con un grado de libertad. tibble(lambda = lambda_sim) |> ggplot(aes(sample = lambda)) + geom_qq(distribution = stats::qchisq, dparams = list(df = 1)) + geom_qq_line(distribution = stats::qchisq, dparams = list(df = 1)) Esta es la definición generalizada de las pruebas de cociente de verosimilitudes Definición. Consideramos la hipótesis nula \\(\\theta \\in \\Theta_0\\). La estadística del cociente de verosimilitudes está dada por: \\[\\lambda = 2\\log\\left( \\frac{\\max_{\\theta}\\mathcal{L}(\\theta)}{\\max_{\\theta\\in\\Theta_0}\\mathcal{L}(\\theta)} \\right ) = 2\\log\\left( \\frac{ \\mathcal{L}(\\hat{\\theta})}{\\mathcal{L}(\\hat{\\theta}_0)} \\right)\\] donde \\(\\hat{\\theta}\\) es el estimador de máxima verosimilitud de \\(\\theta\\) y \\(\\hat{\\theta}_0\\) es el estimador de máxima verosimilitud de \\(\\theta\\) cuando restringimos a que \\(\\theta \\in \\Theta_0\\). En nuestro ejemplo anterior, el espacio \\(\\Theta_0\\) era \\(\\{ (\\mu,\\mu,\\sigma_1, \\sigma_2)\\}\\), que es un subconjunto de \\(\\{ (\\mu_1,\\mu_2,\\sigma_1, \\sigma_2)\\}\\). Nótese que el espacio \\(\\Theta_0\\) tiene tres parámetros libres, mientras que el espacio total tiene 4. Aunque podemos usar el bootstrap paramétrico para construir distribuciones de referencia para estas pruebas y calcular un valor-\\(p\\), el siguiente teorema, cuya demostración no es trivial, explica las observaciones que hicimos arriba. Este teorema enuncia la estrategia del enfoque clásico, que utiliza una aproximación asintótica. Valores p para pruebas de cocientes de verosimilitud. Supongamos que \\(\\theta = (\\theta_1,\\theta_2, \\ldots, \\theta_p)\\). Sea \\[\\Theta_0 = \\{\\theta : \\theta_1 = a_1, \\theta_2 = a_2, \\dots, \\theta_q = a_q \\},\\] es decir la hipótesis \\(\\theta \\in \\Theta_0\\) es que los primeros \\(q\\) parámetros de \\(\\theta\\) estan fijos en algún valor. Los otros parámetros no se consideran en esta prueba. Si \\(\\lambda\\) es la estadística de cociente de verosimilitudes de esta prueba, entonces, bajo la nula \\(\\theta \\in \\Theta_0\\) tenemos que la distribución de \\(\\lambda\\) es asintóticamente \\(\\chi\\)-cuadrada con \\(q\\) grados de libertad, denotada por \\(\\chi^2_q\\). El valor-\\(p\\) para esta prueba es \\[P(\\chi^2_{q} > \\lambda)\\] Observaciones: Para hacer cálculos con la distribución \\(\\chi\\)-cuadrada usamos rutinas numéricas (por ejemplo la función pchisq en R). Nótese que \\(p\\) es la dimensión del espacio \\(\\Theta\\) (\\(p\\) parámetros), y que \\(p-q\\) es la dimensión del espacio \\(\\Theta_0\\) (pues \\(q\\) parámetros están fijos), de modo que los grados de libertad son la dimensión de \\(\\Theta\\) menos la dimensión de \\(\\Theta_0\\). En nuestro primer ejemplo (proporción de éxitos) solo teníamos un parámetro. El espacio \\(\\Theta_0\\) es de dimensión 0, así que los grados de libertad son \\(1 = 1 - 0\\) En este último ejemplo donde probamos igualdad de medias, el espacio \\(\\Theta\\) tiene dimensión 4, y el espacio \\(\\Theta_0\\) es de dimensión 3 (tres parámetros libres), por lo tanto los grados de libertad son \\(1 = 4 -3\\). Ejemplo En nuestro ejemplo de prueba de igualdad de medias, usaríamos pchisq(lambda, df =1, lower.tail = FALSE) ## [1] 0.4297252 que es similar al que obtuvimos con la estrategia del bootstrap paramétrico. Errores tipo I y tipo II En algunas ocasiones, en lugar de solamente calcular un valor-\\(p\\) queremos tomar una decisión asociada a distintas hipótesis que consideramos posibles. Por ejemplo, nuestra hipótesis nula podría ser Hipótesis nula \\(H_0\\): Una medicina nueva que estamos probando no es efectiva en reducir el colesterol en pacientes. Y queremos contrastar con una alternativa: Hipótesis alternativa \\(H_A\\): la medicina nueva reduce los niveles de colesterol en los pacientes. La decisión que está detrás de estas pruebas es: si no podemos rechazar la nula, la medicina no sale al mercado. Si rechazamos la nula, entonces la medicina es aprobada para salir al mercado. Para diseñar esta prueba, procedemos como sigue: Definimos cómo recolectar datos \\(X\\) de interés Definimos una estádistica \\(T(X)\\) de los datos. Definimos una región de rechazo \\(R\\) de valores tales que si \\(T(X)\\in R\\), entonces rechazaremos la hipótesis nula (e implícitamente tomaríamos la decisión asociada a la alternativa). Ejecutamos la prueba observando datos \\(X=x\\), calculando \\(T(x)\\), y checando si \\(T(x) \\in R\\). Si esto sucede entonces decimos que rechazamos la hipótesis nula, y tomamos la decisión asociada a la alternativa. Ejemplo. Si tenemos la hipótesis nula \\(p_1=0.5\\) para una proporción, y al alternativa es \\(p_1\\neq 0.5\\), podemos usar la estadística de Wald \\(T(x) = \\frac{\\hat{p_1} - 0.5}{\\hat{\\textsf{ee}}}\\). Podríamos definir la región de rechazo como \\(R = \\{T(x) : |T(x)| > 3 \\}\\) (rechazamos si en valor absoluto la estadística de Wald es mayor que 3). Cuando diseñamos una prueba de este tipo, quisiéramos minimizar dos tipos de errores: Rechazar la hipótesis nula \\(H_0\\) cuando es cierta: Error tipo I No rechazar la hipótesis nula \\(H_0\\) cuando \\(H_0\\) es falsa: Error tipo II La gravedad de cada error depende del problema. En nuestro ejemplo de la medicina, por ejemplo: Un error tipo II resultaría en una medicina efectiva que no sale al mercado, lo que tiene consecuencias financieras (para la farmaceútica) y costos de oportunidad en salud (para la población). Por otra parte, Un error tipo I resultaría en salir al mercado con una medicina que no es efectiva. Esto tiene costos de oportunidad financieros que pueden ser grandes para la sociedad. Todos estos costos dependen, por ejempĺo, de qué tan grave es la enfermedad, qué tan costosa es la medicina, y así sucesivamente. En el enfoque más clásico, los errores tipo I y tipo II generalmente no se balancean según su severidad o probabilidad. En lugar de eso, generalmente se establece un límite para la probabilidad de cometer un error del tipo I (usualmente 5%, por una tradición que no tiene mucho fundamento) En vista de este ejemplo simple, y las observaciones de arriba: Reducir una decisión compleja a una prueba de hipótesis con resultados binarios (rechazar o no) es generalmente erróneo. Las pruebas de hipótesis se usan muchas veces incorrectamente cuando lo más apropiado es usar estimación por intervalos o algo similar que cuantifique la incertidumbre de las estimaciones. Consulta por ejemplo el comunicado de la ASA acerca de p-values y pruebas de hipótesis En el caso de la medicina, por ejemplo, realmente no nos interesa que la medicina sea mejor que un placebo. Nos importa que tenga un efecto considerable en los pacientes. Si estimamos este efecto, incluyendo incertidumbre, tenemos una mejor herramienta para hacer análisis costo-beneficio y tomar la decisión más apropiada. Como dijimos, típicamente se selecciona la región de rechazo de forma que bajo la hipótesis nula la probabilidad de cometer un error tipo I está acotada. Definición. Supongamos que los datos \\(X_1,X_2,\\ldots, X_n\\) provienen de una distribución \\(F_\\theta\\), donde no conocemos \\(\\theta\\). Supongamos que la hipótesis nula es que \\(\\theta = \\theta_0\\) (que llamamos una hipótesis simple). La función de potencia de una prueba con región de rechazo \\(R\\) se define como la probabilidad de rechazar para cada posible valor del parámetro \\(\\theta\\) \\[\\beta(\\theta) = P_\\theta (X\\in R).\\] El tamaño de una prueba se define como el valor \\[\\alpha = \\beta(\\theta_0),\\] es decir, la probabilidad de rechazar la nula (\\(\\theta = \\theta_0\\)) erróneamente. Observación. Esto se generaliza para hipótesis compuestas, donde la nula es que el parámetro \\(\\theta\\) está en un cierto conjunto \\(\\Theta_0\\). Por ejemplo, una hipótesis nula puede ser \\(\\theta < 0.5\\). En este caso, \\(\\alpha\\) se define como el valor más grande que \\(\\beta(\\theta)\\) toma cuando \\(\\theta\\) está en \\(\\Theta_0\\), es decir, la probabilidad de rechazo más grande cuando la hipótesis nula se cumple. Decimos que una prueba tiene nivel de significancia de \\(\\alpha\\) si su tamaño es menor o igual a \\(\\alpha\\). Decimos que la potencia de una prueba es la probabilidad de, correctamente, rechazar la hipótesis nula cuando la alterna es verdadera: \\[\\beta(\\theta_a) = P_{\\theta_a} (X \\in R).\\] Observación: Sería deseable encontrar la prueba con mayor potencia bajo \\(H_a\\), entre todas las pruebas con tamaño \\(\\alpha\\). Esto no es trivial y no siempre existe. Observación: El valor \\(p\\) es el menor tamaño con el que podemos rechazar \\(H_0\\). Ejemplo (Chihara and Hesterberg (2018)) Supongamos que las calificaciones de Enlace de alumnos en México se distribuye aproximadamente como una normal con media 515 y desviación estándar de 120. En una ciudad particular, se quiere decidir si es neceario pedir fondos porque la media de la ciudad es más baja que la nacional. Nuestra hipótesis nula es \\(H_0: \\mu \\geq 515\\) y la alternativa es \\(\\mu < 515\\), así que si rechazamos la nula se pedirían los fondos. Supondremos que la distribución de calificaciones en la ciudad es también aproximadamente normal con desviación estándar de 130. Se plantea tomar una muestra de 100 alumnos, y rechazar si la media muestral \\(\\bar{X}\\) es menor que 505. ¿Cuál es la probabilidad \\(\\alpha\\) de tener un error de tipo I? La función de potencia es \\[\\beta(\\mu) = P_\\mu(\\bar{X} < 505)\\] Restando la media \\(\\mu\\) y estandarizando obtenemos \\[\\beta(\\mu) = P \\left (\\frac{\\bar{X} - \\mu}{130/\\sqrt{100}} < \\frac{505 -\\mu}{130/\\sqrt{100}} \\right )\\] así que \\[\\beta(\\mu) = \\Phi \\left (\\frac{505 -\\mu}{130/\\sqrt{100}}\\right ),\\] donde \\(\\Phi\\) es la función acumulada de la normal estándar. La gráfica de la función potencia es entonces potencia_tbl <- tibble(mu = seq(450, 550, 0.5)) |> mutate(beta = pnorm((505 - mu)/13)) |> # probabilidad de rechazar mutate(nula_verdadera = factor(mu >= 515)) # nula verdadera ggplot(potencia_tbl, aes(x = mu, y = beta, colour = nula_verdadera)) + geom_line() Es decir, si la media \\(\\mu\\) de la ciudad es muy baja, con mucha seguridad rechazamos. Si es relativamente alta entonces no rechazamos. El tamaño de la prueba es el mayor valor de probabilidad de rechazo que se obtiene sobre los valores \\(\\mu\\geq 515\\) (la nula). Podemos calcularlo analíticamente como sigue: Si \\(\\mu \\geq 515\\), entonces \\[\\beta(\\mu) \\leq \\beta(515) = \\Phi\\left (\\frac{505 -515}{130/\\sqrt{100}}\\right ) = \\Phi( - 10 / 13) = \\Phi(-0.7692)\\] que es igual a pnorm(-0.7692) ## [1] 0.2208873 Y este es el tamaño de la prueba. En otras palabras: si la ciudad no está por debajo de la media nacional, hay una probabilidad de 22% de que erróneamente se pidan fondos (al rechazar \\(H_0\\)). Ejemplo Supongamos que los que programan el presupuesto deciden que se requiere tener una probabilidad de a lo más 5% de rechazar erróneamente la hipótesis nula (es decir, pedir fondos cuando en realidad su media no está debajo de la nacional) para poder recibir fondos. ¿Cuál es la región de rechazo que podríamos escoger? En el caso anterior usamos la región \\(\\bar{X}<505\\). Si el tamaño de muestra está fijo en \\(n=100\\) (por presupuesto), entonces tenemos que escoger un punto de corte más extremo. Si la región de rechazo es \\(\\bar{X} < C)\\) entonces tenemos, siguiendo los cálculos anteriores, que \\[0.05 = \\alpha = \\Phi \\left ( \\frac{C -515}{130/\\sqrt{100}}\\right) = \\Phi \\left( \\frac{C- 515}{13} \\right)\\] Buscamos el cuantil 0.05 de la normal estándar, que es z_alpha <- qnorm(0.05) z_alpha ## [1] -1.644854 Y entonces requerimos que \\[\\frac{C- 515}{13} = -1.6448.\\] Despejando obtenemos C <- 13*z_alpha + 515 C ## [1] 493.6169 Así que podemos usar la región \\(\\bar{X} < 493.5\\), que es más estricta que la anterior de \\(\\bar{X} < 505\\). Considera la potencia de la prueba \\(\\beta(\\mu)\\) que vimos arriba. Discute y corre algunos ejemplos para contestar las siguientes preguntas: Recuerda la definición: ¿qué significa \\(\\beta(\\mu)\\)? ¿Qué pasa con la potencia cuando \\(\\mu\\) está más lejos de los valores de la hipótesis nula? ¿Qué pasa con la potencia cuando hay menos variabilidad en la población? ¿Y cuando la muestra es más grande? ¿Qué pasa si hacemos más chico el nivel de significancia? Consideraciones prácticas Algunos recordatorios de lo que hemos visto: Rechazar la nula no quiere decir que la nula es falsa, ni que encotramos un “efecto”. Un valor-\\(p\\) chico tampoco quiere decir que la nula es falsa. Lo que quiere decir es que la nula es poco consistente con los datos que observamos, o que es muy poco probable que la nula produzca los datos que observamos. Rechazar la nula (encontrar un efecto “significativo”) no quiere decir que el efecto tiene importancia práctica. Si la potencia es alta (por ejemplo cuando el tamaño de muestra es grande), puede ser que la discrepancia de los datos con la nula es despreciable, entonces para fines prácticos podríamos trabajar bajo el supuesto de la nula. Por eso en general preferimos hacer estimación que pruebas de hipótesis para entender o resumir los datos y tamaños de las discrepancias. Adicionalmente, muchas de las hipótesis nulas que generalmente se utilizan se pueden rechazar sin datos (por ejemplo, igualdad de proporciones en dos poblaciones reales). Lo que importa es qué tan diferentes son, y qué tan bien podemos estimar sus diferencias. En la literatura, muchas veces parece que “encontrar una cosa interesante” es rechazar una hipótesis nulas con nivel 5% de significancia. Es más importante entender cómo se diseñó el estudio, cómo se recogieron los datos, cuáles fueron las decisiones de análisis que pasar el mítico nivel de 5% Cuando la potencia es baja (por ejemplo porque el tamaño de muestra es muy chico), tenemos que observar diferencias muy grandes para rechazar. Si probamos algo poco factible (por ejemplo, que la vitamina \\(C\\) aumenta la estatura a los adultos), entonces los rechazos generalmente se deben a variabilidad en la muestra (error tipo II). Cuando diseñamos y presentamos resultados de un estudio o análisis, es mejor pensar en describir los datos y su variabilidad, y mostrar estimaciones incluyendo fuentes de incertidumbre, en lugar de intentar resumir con un valor-\\(p\\) o con el resultado de una prueba de hipótesis. Pruebas múltiples En algunas ocasiones se hacen muchas pruebas para “filtrar” las cosas que son interesantes y las que no. Por ejemplo, cuando comparamos miles de genes entre dos muestras (la nula es que son similares). Si cada prueba se conduce a un nivel \\(\\alpha\\), la probablilidad de tener al menos un rechazo falso (un error tipo I) es considerablemente más alta que \\(\\alpha\\). Por ejemplo, si repetimos una prueba de hipótesis con nivel \\(\\alpha\\) con muestras independientes, la probabilidad de tener al menos un rechazo falso es \\(1-(1-\\alpha)^n\\), que es muy cercano a uno si \\(n\\) es grande (¿cómo derivas esta fórmula?). Por ejemplo, si \\(\\alpha = 0.05\\) y \\(n = 100\\), con más de 99% probabilidad tendremos al menos un rechazo falso, o un “hallazgo” falso. Sin \\(n\\) es muy grande, varios de los hallazgos que encontremos serán debidos a variabilidad muestral. Puedes ver en (Wasserman 2013), sección 10.7 métodos conservadores como corrección de Bonferroni (sólo rechazar cuando el valor-\\(p\\) es menor a \\(0.05/n\\)), o la técnica más moderna de control de tasa de descubrimientos falsos (FDR). Cuando estamos en una situación como esta (que es más retadora en cuanto a análisis), sin embargo, sugerimos usar estimaciones que tomen cuenta todos los datos con regularización apropiada: por ejemplo, en lugar de trabajar con cada muestra por separado, intentamos construir un modelo para el proceso completo de muestreo. Una posibilidad son modelos jerárquicos bayesianos. Ver por ejemplo (Gelman, Hill, and Yajima 2012). Referencias "],["introducción-a-inferencia-bayesiana-1.html", "Sección 10 Introducción a inferencia bayesiana Un primer ejemplo completo de inferencia bayesiana Ejemplo: estimando una proporción Ejemplo: observaciones uniformes Probabilidad a priori Análisis conjugado Pasos de un análisis de datos bayesiano Verificación predictiva posterior Predicción", " Sección 10 Introducción a inferencia bayesiana Para esta sección seguiremos principalmente Kruschke (2015). Adicionalmente puedes ver la sección correspondiente de Chihara and Hesterberg (2018). En las secciones anteriores estudiamos el método de máxima verosimilitud y métodos de remuestreo. Esto lo hemos hecho para estimar parámetros, y cuantificar la incertidumbre qué tenemos acerca de valores poblacionales. La inferencia bayesiana tiene objetivos similares. Igual que en máxima verosimilitud, la inferencia bayesiana comienza con modelos probabilísticos y observaciones. En contraste con máxima verosimilitud, la inferencia bayesiana está diseñada para incorporar información previa o de expertos que tengamos acerca de los parámetros de interés. La inferencia bayesiana cubre como caso particular métodos basados en máxima verosimilitud. 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: 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. 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. Es decir, 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. 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. 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 # 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, n_volados, 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, proceso generador de datos 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 Consideremos ahora el problema de estimar una proporción \\(\\theta\\) de una población dada usando una muestra iid \\(X_1,X_2,\\ldots, X_n\\) de variables Bernoulli. Ya sabemos calcular la verosimilitud (el modelo de los datos): \\[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: 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 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 \\[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}\\] 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: 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: sims |> group_by(dist) |> summarise(theta_hat = mean(theta) |> round(3)) ## # A tibble: 2 × 2 ## dist theta_hat ## <chr> <dbl> ## 1 inicial 0.5 ## 2 posterior 0.61 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: 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. Puedes experimentar en esta shiny app con diferentes iniciales, número de volados y observación de éxitos. 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: qbeta(0.025, shape1 = 22, shape2 = 14) |> round(2) ## [1] 0.45 qbeta(0.975, shape1 = 22, shape2 = 14) |> round(2) ## [1] 0.76 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 si \\(\\alpha = 1.1\\) el cuantil 99% es: alpha <- 1.1 (300/(0.01)^(1/alpha)) ## [1] 19738 es decir, alrededor de 20 millones de números. Creemos que es 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: loteria_tbl <- read_csv("data/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: 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: sims_pareto_inicial <- tibble( theta = rpareto(20000, 300, 1.1 ), dist = "inicial") Y con los datos de la muestra, simulamos de la posterior: 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. Regresaremos más adelante a este problema. Si obtenemos percentiles, obtenemos el intervalo 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 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 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, pues la posterior no tiene un forma reconocible. Tendremos que usar otras estrategias de simulación para ejemplos como este (Monte Carlo por medio de Cadenas de Markov, que veremos más adelante). 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. Análisis conjugado Los dos ejemplos que hemos visto arriba son ejemplos de análisis conjugado: (Beta-bernoulli) Si las observaciones \\(X_i\\) son \\(\\mathsf{Bernoulli}(p)\\) (\\(n\\) fija) queremos estimar \\(p\\), y tomamos como distribución inicial para \\(p\\) una \\(\\mathsf{Beta}(a,b)\\), entonces la posterior para \\(p\\) cuando \\(S_n=k\\) es \\(\\mathsf{Beta}(k + a, n - k + b)\\), donde \\(S_n = X_1 + X_2 +\\cdots +X_n\\). Y más en general: (Beta-binomial) Si las observaciones \\(X_i, i=1,2,\\ldots, m\\) son \\(\\mathsf{Binomial}(n_i, p)\\) (\\(n_i\\)’s fijas) independientes, queremos estimar \\(p\\), y tomamos como distribución inicial para \\(p\\) una \\(\\mathsf{Beta}(a,b)\\), entonces la posterior para \\(p\\) cuando \\(S_m=k\\) es \\(\\mathsf{Beta}(k + a, n - k + b)\\), donde \\(S_m = X_1 + X_2 +\\cdots +X_m\\) y \\(n= n_1+n_2+\\cdots+n_m\\) También aplicamos: (Uniforme-Pareto) Si el modelo de datos \\(X_i\\) es uniforme \\(\\mathsf{U}[0,\\theta]\\) (\\(n\\) fija), queremos estimar \\(\\theta\\), y tomamos como distribución inicial para \\(\\theta\\) una Pareto \\((\\theta_0, \\alpha)\\), entonces la posterior para \\(p\\) si el máximo de las \\(X_i\\)’s es igual a \\(M\\) es Pareto con parámetros \\((\\max\\{\\theta_0, M\\}, \\alpha + n)\\). Nótese que en estos casos, dada una forma de la verosimilitud, tenemos una familia conocida de iniciales tales que las posteriores están en la misma familia. Estos modelos son convenientes porque podemos hacer simulaciones de la posterior de manera fácil, o usar sus propiedades teóricas. Otro ejemplo típico es el modelo normal-normal: (Normal-normal) Si \\(X_i\\sim \\mathsf{N}(\\mu,\\sigma)\\), con \\(\\sigma\\) conocida, y tomamos como distribución inicial para \\(\\mu \\sim \\mathsf{N}(\\mu_0,\\sigma_0)\\), y definimos la precisión \\(\\tau\\) como el inverso de la varianza \\(\\sigma^2\\), entonces la posterior de \\(\\mu\\) es Normal con media \\((1-\\lambda) \\mu_0 + \\lambda\\overline{x}\\), y precisión \\(\\tau_0 + n\\tau\\), donde \\(\\lambda = \\frac{n\\tau}{\\tau_0 + n\\tau}\\) Completa cuadrados para mostrar las fórmulas del modelo normal-normal con varianza conocida. Más útil es el siguiente modelo: (Normal-Gamma inverso) Sean \\(X_i\\sim \\mathsf{N}(\\mu, \\sigma)\\). Queremos estimar \\(\\mu\\) y \\(\\sigma\\). Tomamos como distribuciones iniciales (dadas por 4 parámetros: \\(\\mu_0, n_0, \\alpha,\\beta\\)): \\(\\tau = \\frac{1}{\\sigma^2} \\sim \\mathsf{Gamma}(\\alpha,\\beta)\\) \\(\\mu|\\sigma\\) es normal con media \\(\\mu_0\\) y varianza \\(\\sigma^2 / {n_0}\\) , y \\(p(\\mu, \\sigma) = p(\\mu|\\sigma)p(\\sigma)\\) Entonces la posterior es: \\(\\tau|x\\) es \\(\\mathsf{Gamma}(\\alpha', \\beta')\\), con \\(\\alpha' = \\alpha + n/2\\), \\(\\beta' = \\beta + \\frac{1}{2}\\sum_{i=1}^{n}(x_{i} - \\bar{x})^2 + \\frac{nn_0}{n+n_0}\\frac{({\\bar{x}}-\\mu_{0})^2}{2}\\) \\(\\mu|\\sigma,x\\) es normal con media \\(\\mu' = \\frac{n_0\\mu_{0}+n{\\bar{x}}}{n_0 +n}\\) y varianza \\(\\sigma^2/({n_0 +n})\\). \\(p(\\mu,\\sigma|x) = p(\\mu|x,\\sigma)p(\\sigma|x)\\) Observaciones Nótese que este último ejemplo tiene más de un parámetro. En estos casos, el objeto de interés es la posterior conjunta de los parámetros \\(p(\\theta_1,\\theta_2,\\cdots, \\theta_p|x)\\). Este último ejemplo es relativamente simple pues por la selección de iniciales, para simular de la conjunta de \\(\\mu\\) y \\(\\tau\\) podemos simular primero \\(\\tau\\) (o \\(\\sigma\\)), y después usar este valor para simular de \\(\\mu\\): el par de valores resultantes son una simulación de la conjunta. Los parámetros \\(\\alpha,\\beta\\) para la inicial de \\(\\tau\\) pueden interpretarse como sigue: \\(\\sqrt{\\beta/\\alpha}\\) es un valor “típico” a priori para la varianza poblacional, y \\(a\\) indica qué tan seguros estamos de este valor típico. Nótese que para que funcionen las fórmulas de la manera más simple, escogimos una dependencia a priori entre la media y la precisión: \\(\\tau = \\sigma^{-2}\\) indica la escala de variabilidad que hay en la población, la incial de la media tiene varianza \\(\\sigma^2/n_0\\). Si la escala de variabilidad de la población es más grande, tenemos más incertidumbre acerca de la localización de la media. Aunque esto tiene sentido en algunas aplicaciones, y por convenviencia usamos esta familia conjugada, muchas veces es preferible otro tipo de especificaciones para las iniciales: por ejemplo, la media normal y la desviación estándar uniforme, o media normal, con iniciales independientes. Sin embargo, estos casos no son tratables con análisis conjugado (veremos más adelante cómo tratarlos con MCMC). 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\\). Como está el modelo, esta inicial debe estar dada para la precisión \\(\\tau\\), pero podemos simular para ver cómo se ve nuestra inicial para la desviación estándar. En la población general la desviación estándar es alrededor de 7 centímetros # Comenzamos seleccionando un valor que creemos típico para la desviación estándar sigma_0 <- 7 # seleccionamos un valor para a, por ejemplo: si es más chico sigma tendrá más # disperisón a <- 3 # ponemos 7 = sqrt(b/a) -> b = a * 64 b <- a * sigma_0 ^ 2 c(a = a, b = b) ## a b ## 3 147 Ahora simulamos para calcular cuantiles tau <- rgamma(1000, a, b) quantile(tau, c(0.05, 0.95)) ## 5% 95% ## 0.005781607 0.042170161 sigma <- 1 / sqrt(tau) mean(sigma) ## [1] 8.002706 quantile(sigma, c(0.05, 0.95)) ## 5% 95% ## 4.869653 13.151520 Que es dispersión considerable: con poca probabilidad la desviación estándar es menor a 4 centímetros, y también creemos que es poco creíble la desviación estándar sea de más de 13 centímetros. 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\\): mu_0 <- 175 # valor medio de inicial n_0 <- 5 # cuánta concentración en la inicial tau <- rgamma(1000, a,b) sigma <- 1/sqrt(tau) mu <- map_dbl(sigma, ~ rnorm(1, mu_0, .x / sqrt(n_0))) quantile(mu, c(0.05, 0.5, 0.95)) ## 5% 50% 95% ## 168.7275 174.8412 180.7905 Que consideramos un rango en el que con alta probabilidad debe estar la media poblacional de los cantantes. Podemos checar nuestros supuestos simulando posibles muestras usando sólo nuestra información previa: simular_normal_invgamma <- function(n, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular media tau <- rgamma(1, a, b) sigma <- 1 / sqrt(tau) mu <- rnorm(1, mu_0, sigma/sqrt(n_0)) # simular sigma rnorm(n, mu, sigma) } set.seed(3461) sims_tbl <- tibble(rep = 1:20) |> mutate(estatura = map(rep, ~ simular_normal_invgamma(500, c(mu_0, n_0, a, b)))) |> unnest(cols = c(estatura)) ggplot(sims_tbl, aes(x = estatura)) + geom_histogram() + facet_wrap(~ rep) + geom_vline(xintercept = c(150, 180), colour = "red") 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 140, que deberían ser menos probables). Ahora podemos usar los datos para calcular nuestras posteriores. 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 Los cálculos son un poco tediosos, pero podemos construir una función apropiada: calcular_pars_posterior <- function(x, pars_inicial){ # iniciales mu_0 <- pars_inicial[1] n_0 <- pars_inicial[2] a_0 <- pars_inicial[3] b_0 <- pars_inicial[4] # muestra n <- length(x) media <- mean(x) S2 <- sum((x - media)^2) # sigma post a_1 <- a_0 + 0.5 * n b_1 <- b_0 + 0.5 * S2 + 0.5 * (n * n_0) / (n + n_0) * (media - mu_0)^2 # posterior mu mu_1 <- (n_0 * mu_0 + n * media) / (n + n_0) n_1 <- n + n_0 c(mu_1, n_1, a_1, b_1) } pars_posterior <- calcular_pars_posterior(cantantes$estatura_cm, c(mu_0, n_0, a, b)) pars_posterior ## [1] 175.8 25.0 13.0 509.0 ¿Cómo se ve nuestra posterior comparada con la inicial? Podemos hacer simulaciones: sim_params <- function(m, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular sigmas sims <- tibble(tau = rgamma(m, a, b)) |> mutate(sigma = 1 / sqrt(tau)) # simular mu sims <- sims |> mutate(mu = rnorm(m, mu_0, sigma / sqrt(n_0))) sims } sims_inicial <- sim_params(5000, c(mu_0, n_0, a, b)) |> mutate(dist = "inicial") sims_posterior <- sim_params(5000, pars_posterior) |> mutate(dist = "posterior") sims <- bind_rows(sims_inicial, sims_posterior) ggplot(sims, aes(x = mu, y = sigma, colour = dist)) + geom_point(alpha = 0.4) 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. medias_post <- sims |> filter(dist == "posterior") |> select(-dist) |> summarise(across(everything(), mean)) ggplot(sims |> filter(dist == "posterior"), aes(x = mu, y = sigma)) + geom_point(colour = "#00BFC4") + geom_point(data = medias_post, size = 5, colour = "black") + coord_equal() Podemos construir intervalos creíbles del 90% para estos dos parámetros, por ejemplo haciendo intervalos de percentiles: f <- c(0.05, 0.5, 0.95) sims |> pivot_longer(cols = mu:sigma, names_to = "parametro") |> group_by(dist, parametro) |> reframe(cuantil = quantile(value, f) |> round(1), f = f) |> pivot_wider(names_from = f, values_from = cuantil) ## # A tibble: 4 × 5 ## dist parametro `0.05` `0.5` `0.95` ## <chr> <chr> <dbl> <dbl> <dbl> ## 1 inicial mu 169. 175. 181. ## 2 inicial sigma 4.8 7.4 13.3 ## 3 posterior mu 174. 176. 178. ## 4 posterior sigma 5.1 6.3 8.2 Como comparación, los estimadores de máxima verosimlitud son 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. 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. Elicitando probablidades subjetivas (opcional) No siempre es fácil elicitar probabilidades subjetivas de manera que capturemos el verdadero conocimiento de dominio que tenemos. Una manera clásica de hacerlo es con apuestas Considera una pregunta sencilla que puede afectar a un viajero: ¿Qué tanto crees que habrá una tormenta que ocasionará el cierre de la autopista México-Acapulco en el puente del \\(20\\) de noviembre? Como respuesta debes dar un número entre \\(0\\) y \\(1\\) que refleje tus creencias. Una manera de seleccionar dicho número es calibrar las creencias en relación a otros eventos cuyas probabilidades son claras. Como evento de comparación considera una experimento donde hay canicas en una urna: \\(5\\) rojas y \\(5\\) blancas. Seleccionamos una canica al azar. Usaremos esta urna como comparación para considerar la tormenta en la autopista. Ahora, considera el siguiente par de apuestas de las cuales puedes elegir una: A. Obtienes \\(\\$1000\\) si hay una tormenta que ocasiona el cierre de la autopista el próximo \\(20\\) de noviembre. B. Obtienes \\(\\$1000\\) si seleccionas una canica roja de la urna que contiene \\(5\\) canicas rojas y \\(5\\) blancas. Si prefieres la apuesta B, quiere decir que consideras que la probabilidad de tormenta es menor a \\(0.5\\), por lo que al menos sabes que tu creencia subjetiva de una la probabilidad de tormenta es menor a \\(0.5\\). Podemos continuar con el proceso para tener una mejor estimación de la creencia subjetiva. A. Obtienes \\(\\$1000\\) si hay una tormenta que ocasiona el cierre de la autopista el próximo \\(20\\) de noviembre. C. Obtienes \\(\\$1000\\) si seleccionas una canica roja de la urna que contiene \\(1\\) canica roja y \\(9\\) blancas. Si ahora seleccionas la apuesta \\(A\\), esto querría decir que consideras que la probabilidad de que ocurra una tormenta es mayor a \\(0.10\\). Si consideramos ambas comparaciones tenemos que tu probabilidad subjetiva se ubica entre \\(0.1\\) y \\(0.5\\). 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 observaciones, producidas simulando 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. Y ahora simulamos otra muestra muestra_sim <- simular_normal_invgamma(20, pars_posterior) muestra_sim |> round(0) ## [1] 167 181 184 181 167 167 172 170 177 172 169 174 182 184 176 171 175 176 168 ## [20] 181 Podemos simular varias muestras y hacer una prueba de lineup: library(nullabor) set.seed(9921) sims_obs <- tibble(.n = 1:19) |> mutate(estatura_cm = map(.n, ~ simular_normal_invgamma(20, pars_posterior))) |> unnest(estatura_cm) pos <- sample(1:20, 1) lineup_tbl <- lineup(true = cantantes |> select(estatura_cm), samples = sims_obs, 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? 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: 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: 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. Predicción Cuando queremos hacer predicciones particulares acerca de datos que observemos en el futuro, también podemos usar la posterior predictiva. En este caso, tenemos que considerar La variabilidad que produce la incertidumbre en la estimación de los parámetros La variabilidad de las observaciones dados los parámetros. Es decir, tenemos que simular sobre todos las combinaciones factibles de los parámetros. Ejemplo: cantantes Si un nuevo tenor llega a un coro, ¿cómo hacemos una predicción de su estatura? Como siempre, quisiéramos obtener un intervalo que exprese nuestra incertidumbre acerca del valor que vamos a observar. Entonces haríamos: sims_posterior <- sim_params(50000, pars_posterior) |> mutate(y_pred = rnorm(n(), mu, sigma)) sims_posterior |> head() ## # A tibble: 6 × 4 ## tau sigma mu y_pred ## <dbl> <dbl> <dbl> <dbl> ## 1 0.0286 5.91 175. 181. ## 2 0.0200 7.07 177. 178. ## 3 0.0257 6.23 176. 170. ## 4 0.0344 5.39 176. 174. ## 5 0.0297 5.80 175. 169. ## 6 0.0282 5.96 177. 170. f <- c(0.025, 0.5, 0.975) sims_posterior |> summarise(f = f, y_pred = quantile(y_pred, f)) ## # A tibble: 3 × 2 ## f y_pred ## <dbl> <dbl> ## 1 0.025 163. ## 2 0.5 176. ## 3 0.975 189. Y con esto obtenemos el intervalo (163, 189), al 95%, para una nueva observación. Nótese que este intervalo no puede construirse con una simulación particular de la posterior de los parámetros, pues sería demasiado corto. Es posible demostrar que en este caso, la posterior predictiva tiene una forma conocida: La posterior predictiva para el modelo normal-gamma inverso es una distribución \\(t\\) con \\(2\\alpha'\\) grados de libertad, centrada en \\(\\mu'\\), y con escala \\(s^2 = \\frac{\\beta'}{\\alpha'}\\frac{n + n_0 + 1}{n +n_0}\\) mu_post <- pars_posterior[1] n_post <- pars_posterior[2] alpha_post <- pars_posterior[3] beta_post <- pars_posterior[4] s <- sqrt(beta_post/alpha_post) * sqrt((n_post + 1)/n_post) qt(c(0.025, 0.5, 0.975), 2 * alpha_post) * s + mu_post ## [1] 162.6832 175.8000 188.9168 Calcula la posterior predictiva del modelo Beta-Bernoulli y Beta-Binomial. (Más difícil) Calcula la posterior predictiva del modelo Poisson-Gamma. Ejemplo: posterior predictiva de Pareto-Uniforme. La posterior predictiva del modelo Pareto-Uniforme no tiene un nombre estándar, pero podemos aproximarla usando simulación. Usando los mismos datos del ejercicio de la lotería, haríamos: 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 posterior de los parámetros lim_inf_post <- max(c(300, muestra_loteria$numero)) k_posterior <- nrow(muestra_loteria) + 1.1 sims_pareto_posterior <- tibble( theta = rpareto(100000, lim_inf_post, k_posterior)) # Simulamos una observación para cada una de las anteriores: sims_post_pred <- sims_pareto_posterior |> mutate(x_pred = map_dbl(theta, ~ runif(1, 0, .x))) # Graficamos ggplot(sims_post_pred, aes(x = x_pred)) + geom_histogram(binwidth = 50) + geom_vline(xintercept = lim_inf_post, colour = "red") Que es una mezcla de una uniforme con una Pareto. Referencias "],["calibración-bayesiana-y-regularización.html", "Sección 11 Calibración bayesiana y Regularización Enfoque bayesiano y frecuentista Ejemplo: estimación de una proporción Intervalos de Agresti-Coull Incorporando información inicial Inferencia bayesiana y regularización Ejemplo: modelo normal y estaturas Ejemplo: estimación de proporciones Teoría de decisión Riesgo de Bayes", " Sección 11 Calibración bayesiana y Regularización El enfoque bayesiano se puede formalizar coherentemente en términos de probabilidades subjetivas, y como vimos, esta es una fortaleza del enfoque bayesiano. En la práctica, sin embargo, muchas veces puede ser difícil argumentar en términos exclusivos de probabilidad subjetiva, aunque hagamos los esfuerzos apropiados para incorporar la totalidad de información que distintos actores involucrados pueden tener. Consideremos, por ejemplo, que INEGI produjera un intervalo creíble del 95% para el ingreso mediano de los hogares de México. Aún cuando nuestra metodología sea transparente y correctamente informada, algunos investigadores interesados puede ser que tengan recelo en usar esta información, y quizá preferirían hacer estimaciones propias. Esto restaría valor al trabajo cuidadoso que pusimos en nuestras estimaciones oficiales. Por otra parte, el enfoque frecuentista provee de ciertas garantías mínimas para la utilización de las estimaciones, que no dependen de la interpretación subjetiva de la probabilidad, sino de las propiedades del muestreo. Consideremos la cobertura de los intervalos de confianza: Bajo ciertos supuestos de nuestros modelos, la probabilidad de que un intervalo de confianza del 95% cubra al verdadero valor poblacional es del 95%. Esta probabilidad es sobre las distintas muestras que se pueden obtener según el diseño del muestreo. Los intervalos creíbles en principio no tienen por qué cumplir esta propiedad, pero consideramos que en la práctica es una garantía mínima que deberían cumplir. El enfoque resultante se llama bayesiano calibrado, Little (2011) . La idea es seguir el enfoque bayesiano usual para construir nuestras estimaciones, pero verificar hasta donde sea posible que los intervalos resultantes satisfacen alguna garantía frecuentista básica. Observación. checar que la cobertura real es similar a la nominal es importante en los dos enfoques: frecuentista y bayesiano. Los intervalos frecuentistas, como hemos visto, generalmente son aproximados, y por lo tanto no cumplen automáticamente esta propiedad de calibración. Enfoque bayesiano y frecuentista Los métodos estadísticos clásicos toman el punto de vista frecuentista y se basa en los siguientes puntos (Wasserman (2013)): La probabilidad se interpreta como un límite de frecuencias relativas, donde las probabilidades son propiedades objetivas en el mundo real. En un modelo, los parámetros son constantes fijas (desconocidas). Como consecuencia, no se pueden realizar afirmaciones probabilísticas útiles en relación a éstos. Los procedimientos estadísticos deben diseñarse con el objetivo de tener propiedades frecuentistas bien definidas. Por ejemplo, un intervalo de confianza del \\(95\\%\\) debe contener el verdadero valor del parámetro con frecuencia límite de al menos el \\(95\\%\\). En contraste, el acercamiento Bayesiano muchas veces se describe por los siguientes postulados: La probabilidad describe grados de creencia, no frecuencias limite. Como tal uno puede hacer afirmaciones probabilísticas acerca de muchas cosas y no solo datos sujetos a variabilidad aleatoria. Por ejemplo, puedo decir: “La probabilidad de que Einstein tomara una taza de té el primero de agosto de \\(1948\\)” es \\(0.35\\), esto no hace referencia a ninguna frecuencia relativa sino que refleja la certeza que yo tengo de que la proposición sea verdadera. Podemos hacer afirmaciones probabilísticas de parámetros. Podemos hacer inferencia de un parámetro \\(\\theta\\) por medio de distribuciones de probabilidad. Las inferencias como estimaciones puntuales y estimaciones de intervalos se pueden extraer de dicha distribución. Finalmente, en el enfoque bayesiano calibrado (Little (2011)): Usamos el enfoque bayesiano para modelar y hacer afirmaciones probabilísticas de los parámetros. Buscamos cumplir las garantías frecuentistas del inciso 3). Ejemplo: estimación de una proporción Recordamos nuestro problema de estimación de una proporcion \\(\\theta\\). Usando la distribución inicial \\(p(\\theta)\\sim \\mathsf{Beta}(2,2)\\), y la verosimilitud estándar binomial, vimos que la posterior cuando observamos \\(k\\) éxitos es \\[p(\\theta|k) \\sim \\mathsf{Beta}(k + 2, n - k + 2)\\]. La media posterior es \\[\\frac{k + 2}{n + 4} \\] que podemos interpretar como: agrega 2 éxitos y 2 fracasos a los datos observados y calcula la proporción de éxitos. Un intervalo posterior de credibilidad del 95% se calcula encontrando los cuantiles 0.025 y 0.975 de una \\(\\mathsf{Beta}(k + 2, n - k + 2)\\) \\[I_a = \\left [q_{0.025}(k+2, n+4), q_{0.975}(k+2, n+4)\\right ]\\] Que compararemos con el intervalo usual de Wald: si \\(\\hat{\\theta} = \\frac{k}{n}\\), entonces \\[I_w = \\left [\\hat{\\theta} - 2 \\sqrt{\\frac{\\hat{\\theta}(1-\\hat{\\theta})}{n}}, \\hat{\\theta} + 2 \\sqrt{\\frac{\\hat{\\theta}(1-\\hat{\\theta})}{n}}\\right]\\] ¿Cómo podemos comparar la calibración de estos dos intervalos? Nominalmente, deben tener cobertura de 95%. Hagamos un ejercicio de simulación para distintos tamaños de muestra \\(n\\) y posibles valores \\(\\theta\\in (0,1)\\): set.seed(332) simular_muestras <- function(M, n, p){ k = rbinom(M, n, p) tibble(rep = 1:M, n = n, p = p, k = k) } intervalo_wald <- function(n, k){ p_hat <- k / n ee_hat <- sqrt(p_hat * (1 - p_hat) / n) tibble(inf = p_hat - 2 * ee_hat, sup = p_hat + 2 * ee_hat) } intervalo_bayes <- function(n, k, a = 2, b = 2){ a <- k + a b <- n - k + b tibble(inf = qbeta(0.025, a, b), sup = qbeta(0.975, a, b)) } set.seed(812) ejemplo <- simular_muestras(5, 20, 0.4) ejemplo |> mutate(intervalo = intervalo_wald(n, k)) |> pull(intervalo) |> bind_cols(ejemplo) |> select(-rep) ## # A tibble: 5 × 5 ## inf sup n p k ## <dbl> <dbl> <dbl> <dbl> <int> ## 1 0.0211 0.379 20 0.4 4 ## 2 0.228 0.672 20 0.4 9 ## 3 0.276 0.724 20 0.4 10 ## 4 0.228 0.672 20 0.4 9 ## 5 0.137 0.563 20 0.4 7 ejemplo |> mutate(intervalo = intervalo_bayes(n, k)) |> pull(intervalo) |> bind_cols(ejemplo) |> select(-rep) ## # A tibble: 5 × 5 ## inf sup n p k ## <dbl> <dbl> <dbl> <dbl> <int> ## 1 0.102 0.437 20 0.4 4 ## 2 0.268 0.655 20 0.4 9 ## 3 0.306 0.694 20 0.4 10 ## 4 0.268 0.655 20 0.4 9 ## 5 0.197 0.573 20 0.4 7 ¿Cuáles de estos intervalos cubren al verdadero valor? Nótese que no podemos descalificar a ningún método por no cubrir una vez. Es fácil producir un intervalo con 100% de cobertura: (0,1). Pero no nos informa dónde es probable que esté el parámetro. Sin embargo, podemos checar la cobertura frecuentista haciendo una cantidad grande de simulaciones: parametros <- crossing(n = c(5, 10, 30, 60, 100, 400), p = c(0.01, 0.015, 0.02, 0.025, 0.03, 0.035, 0.04, 0.05, 0.07, 0.1, 0.15)) set.seed(2343) # simulaciones simulaciones <- parametros |> mutate(muestra = map2(n, p, ~ simular_muestras(50000, .x, .y) |> select(rep, k))) |> unnest(muestra) # calcular_cobertura calcular_cobertura <- function(simulaciones, construir_intervalo){ # nombre de función intervalo_nombre <- substitute(construir_intervalo) |> as.character() cobertura_tbl <- simulaciones |> mutate(intervalo = construir_intervalo(n, k)) |> pull(intervalo) |> bind_cols(simulaciones) |> mutate(cubre = p >= inf & p <= sup) |> group_by(n, p) |> summarise(cobertura = mean(cubre), long_media = mean(sup - inf)) cobertura_tbl |> mutate(tipo = intervalo_nombre) } cobertura_wald <- calcular_cobertura(simulaciones, intervalo_wald) cobertura_wald ## # A tibble: 66 × 5 ## # Groups: n [6] ## n p cobertura long_media tipo ## <dbl> <dbl> <dbl> <dbl> <chr> ## 1 5 0.01 0.0483 0.0347 intervalo_wald ## 2 5 0.015 0.0733 0.0527 intervalo_wald ## 3 5 0.02 0.0954 0.0689 intervalo_wald ## 4 5 0.025 0.119 0.0862 intervalo_wald ## 5 5 0.03 0.140 0.102 intervalo_wald ## 6 5 0.035 0.165 0.120 intervalo_wald ## 7 5 0.04 0.187 0.137 intervalo_wald ## 8 5 0.05 0.227 0.167 intervalo_wald ## 9 5 0.07 0.299 0.223 intervalo_wald ## 10 5 0.1 0.398 0.303 intervalo_wald ## # ℹ 56 more rows graficar_cobertura <- function(cobertura_tbl){ ggplot(cobertura_tbl, aes(x = p, y = cobertura, colour = tipo)) + geom_hline(yintercept = 0.95, colour = "black") + geom_line() + geom_point() + facet_wrap(~n) + ylim(0, 1) } cobertura_wald |> graficar_cobertura() La cobertura real es mucho más baja que la nominal en muchos casos, especialmente cuando la \\(p\\) es baja y \\(n\\) es chica. Pero incluso para muestras relativamente grandes (100), la cobertura es mala si \\(p\\) es chica. Ahora probamos nuestro método alternativo: cobertura_bayes <- calcular_cobertura(simulaciones, intervalo_bayes) bind_rows(cobertura_wald, cobertura_bayes) |> mutate(tipo = factor(tipo, levels = c('intervalo_wald', 'intervalo_bayes'))) |> graficar_cobertura() Y vemos que en general el intervalo de Bayes es superior al de Wald, en sentido de que su cobertura real es más cercana a la nominal. El caso donde fallan los dos es para muestras muy chicas \\(n=5, 10\\), con probabilidades de éxito chicas \\(p\\leq 0.02\\). Sin embargo, si tenemos información previa acerca del tamaño de la proporción que estamos estimando, es posible obtener buena calibración con el método bayesiano. En este caso particular, tenemos argumentos frecuentistas para utilizar el método bayesiano. Por ejemplo, si el INEGI utilizara estos intervalos creíbles, un análisis de calibración de este tipo sostendría esa decisión. Intervalos de Agresti-Coull Un método intermedio que se usa para obtener mejores intervalos cuando estimamos proporciones es el siguiente: Agregar dos 1’s y dos 0’s a los datos. Utilizar el método de Wald con estos datos modificados. intervalo_agresti_coull <- function(n, k){ p_hat <- (k + 2)/ (n + 4) ee_hat <- sqrt(p_hat * (1 - p_hat) / n) tibble(inf = p_hat - 2 * ee_hat, sup = p_hat + 2 * ee_hat) } cobertura_ac <- calcular_cobertura(simulaciones, intervalo_agresti_coull) bind_rows(cobertura_wald, cobertura_bayes, cobertura_ac) |> mutate(tipo = factor(tipo, levels = c('intervalo_wald', 'intervalo_bayes', 'intervalo_agresti_coull'))) |> graficar_cobertura() Que tiende a ser demasiado conservador para proporciones chicas: graficar_cobertura(cobertura_ac) + ylim(c(0.9, 1)) Conclusión 1: Los intervalos de Agresti-Coull son una buena alternativa para estimar proporciones como sustituto de los intervalos clásicos de Wald, aunque tienden a ser muy conservadores para muestras chicas Idealmente podemos utilizar un método bayesiano pues normalmente tenemos información inicial acerca de las proporciones que queremos estimar. Incorporando información inicial Nótese que generalmente tenemos información acerca de la cantidad que queremos estimar: por ejemplo, que proporción de visitantes de un sitio web compra algo (usualmente muy baja, menos de 2%), qué proporción de personas tiene diabetes tipo 1 (una proporción muy baja, menos de 1 por millar), o qué proporción de hogares tienen ingresos trimestrales mayores a 150 mil pesos (menos de %5 con alta probabilidad). En este caso, tenemos que ajustar nuestra inicial. Por ejemplo, para el problema de ingresos, podríamos usar una \\(\\mathsf{Beta}(2, 100)\\), cuyos cuantiles son: # uno de cada 100 a <- 2 b <- 100 beta_sims <- rbeta(5000, a, b) quantile(beta_sims, c(0.01, 0.05, 0.50, 0.90, 0.99)) |> round(3) ## 1% 5% 50% 90% 99% ## 0.001 0.004 0.016 0.039 0.067 qplot(beta_sims) Veamos cómo se ven los intervalos bayesianos producidos con esta inicial: crear_intervalo_bayes <- function(a, b){ intervalo_fun <- function(n, k){ a_post <- k + a b_post <- n - k + b tibble(inf = qbeta(0.025, a_post, b_post), sup = qbeta(0.975, a_post, b_post)) } intervalo_fun } intervalo_bayes_2 <- crear_intervalo_bayes(a, b) cobertura_bayes <- calcular_cobertura(simulaciones, intervalo_bayes_2) graficar_cobertura(bind_rows(cobertura_bayes, cobertura_ac) |> filter(p < 0.05)) + ylim(c(0.5, 1)) Y vemos que la calibración es similar. Notemos sin embargo que la longitud del del intervalo bayesiano es mucho menor que el de Agresti-Coull cuando la muestra es chica: ggplot(bind_rows(cobertura_bayes, cobertura_ac), aes(x = p, y = long_media, colour = tipo)) + geom_point() + facet_wrap(~n) Cuando la muestra es chica, los intervalos de bayes son similares a los iniciales, y mucho más cortos que los de Agresti-Coull. Para muestras intermedias (50-100) los intervalos bayesianos son más informativos que los de Agresti-Coull, con calibración similar, y representan aprendizaje por encima de lo que sabíamos en la inicial. Para muestras grandes, obtenemos resultados simililares. Por ejemplo: set.seed(2131) k <- rbinom(1, 50, 0.03) k ## [1] 4 intervalo_agresti_coull(50, k) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.022 0.2 es un intervalo muy grande que puede incluir valores negativos. En contraste, el intervalo bayesiano es: intervalo_bayes_2(50, k) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.015 0.076 Aún quitando valores negativos, los intervalos de Agresti-Coull son mucho más anchos. La aproximación bayesiana, entonces, utiliza información previa para dar un resultado considerablemente más informativo, con calibración similar a Agresti-Coull. ¿Aprendimos algo? Comparemos la posterior con la inicial: beta_sims_inicial <- tibble(prop = rbeta(5000, a, b), dist = "inicial") beta_sims_posterior <- tibble(prop = rbeta(5000, a + k, b + 50), dist = "posterior") bind_rows(beta_sims_inicial, beta_sims_posterior) |> ggplot(aes(x = prop, fill = dist)) + geom_histogram(alpha = 0.5, position = "identity") Donde vemos que no aprendimos mucho en este caso, pero nuestras creencias sí cambiaron en comparación con la inicial. Conclusión 2: con el enfoque bayesiano podemos obtener intervalos informativos con calibración razonable, incluso con información inicial que no es muy precisa. Los intervalos de Agresti-Coull son poco informativos para muestras chicas y/o proporciones chicas. Ejemplo: porporción de hogares de ingresos grandes Usaremos los datos de ENIGH como ejemplo (ignorando el diseño, pero es posible hacer todas las estimaciones correctamente) para estimar el porcentaje de hogares que tienen ingreso corriente de más de 150 mil pesos al trimestre. Suponemos que la muestra del enigh es la población, y tomaremos una muestra iid de esta población. Usamos la misma inicial que mostramos arriba, que es una Beta con parámetros c(a,b) ## [1] 2 100 set.seed(2521) muestra_enigh <- read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) |> sample_n(120) |> mutate(mas_150mil = ing_cor > 150000) Un intervalo de 95% es entonces k <- sum(muestra_enigh$mas_150mil) k ## [1] 3 intervalo_bayes_2(120, sum(muestra_enigh$mas_150mil)) |> round(3) ## # A tibble: 1 × 2 ## inf sup ## <dbl> <dbl> ## 1 0.007 0.046 La media posterior es prop_post <- (a + k) / (120 + b) prop_post ## [1] 0.02272727 ¿Cuál es la verdadera proporción? read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) |> mutate(mas_150mil = ing_cor > 150000) |> summarise(prop_pob = mean(mas_150mil)) ## # A tibble: 1 × 1 ## prop_pob ## <dbl> ## 1 0.0277 En este caso, nuestro intervalo cubre a la proporción poblacional. Inferencia bayesiana y regularización Como hemos visto en análisis y modelos anteriores, la posterior que usamos para hacer inferencia combina aspectos de la inicial con la verosimilitud (los datos). Una manera de ver esta combinación y sus beneficios es pensando en término de regularización de estimaciones. En las muestras hay variación. Algunas muestras particulares nos dan estimaciones de máxima verosimilitud pobres de los parámetros de interés (estimaciones ruidosas). Cuando esas estimaciones pobres están en una zona de baja probabilidad de la inicial, la estimación posterior tiende a moverse (o encogerse) hacia las zonas de alta probabilidad de la inicial. Esto filtra ruido en las estimaciones. El mecanismo resulta en una reducción del error cuadrático medio, mediante una reducción de la varianza de los estimadores (aunque quizá el sesgo aumente). Esta es una técnica poderosa, especialmente para problemas complejos donde tenemos pocos datos para cada parámetro. En general, excluímos resultados que no concuerdan con el conocimiento previo, y esto resulta en mayor precisión en las estimaciones. Ejemplo: modelo normal y estaturas Haremos un experimento donde simularemos muestras de los datos de cantantes. Usaremos el modelo normal-gamma inverso que discutimos anteriormente, con la información inicial que elicitamos. ¿Cómo se compara la estimación de máxima verosimilitud con la media posterior? # inicial para media, ver sección anterior para discusión (normal) mu_0 <- 175 n_0 <- 5 # inicial para sigma^2 (gamma inversa) a <- 3 b <- 140 Para este ejemplo chico, usaremos muestras de tamaño 5: set.seed(3413) # ver sección anterior para explicación de esta función calcular_pars_posterior <- function(x, pars_inicial){ # iniciales mu_0 <- pars_inicial[1] n_0 <- pars_inicial[2] a_0 <- pars_inicial[3] b_0 <- pars_inicial[4] # muestra n <- length(x) media <- mean(x) S2 <- sum((x - media)^2) # sigma post a_1 <- a_0 + 0.5 * n b_1 <- b_0 + 0.5 * S2 + 0.5 * (n * n_0) / (n + n_0) * (media - mu_0)^2 # posterior mu mu_1 <- (n_0 * mu_0 + n * media) / (n + n_0) n_1 <- n + n_0 c(mu_1, n_1, a_1, b_1) } Y también de la sección anterior: sim_params <- function(m, pars){ mu_0 <- pars[1] n_0 <- pars[2] a <- pars[3] b <- pars[4] # simular sigmas sims <- tibble(tau = rgamma(m, a, b)) |> mutate(sigma = 1 / sqrt(tau)) # simular mu sims <- sims |> mutate(mu = rnorm(m, mu_0, sigma / sqrt(n_0))) sims } # simular muestras y calcular medias posteriores simular_muestra <- function(rep, mu_0, n_0, a_0, b_0){ cantantes <- lattice::singer |> mutate(estatura_cm = 2.54 * height) |> filter(str_detect(voice.part, "Tenor")) |> sample_n(5, replace = FALSE) pars_posterior <- calcular_pars_posterior(cantantes$estatura_cm, c(mu_0, n_0, a_0, b_0)) medias_post <- sim_params(1000, pars_posterior) |> summarise(across(everything(), mean)) |> select(mu, sigma) media <- mean(cantantes$estatura_cm) est_mv <- c("mu" = media, "sigma" = sqrt(mean((cantantes$estatura_cm - media)^2))) bind_rows(medias_post, est_mv) |> mutate(rep = rep, tipo = c("media_post", "max_verosim")) |> pivot_longer(mu:sigma, names_to = "parametro", values_to = "estimador") } poblacion <- lattice::singer |> mutate(estatura_cm = 2.54 * height) |> filter(str_detect(voice.part, "Tenor")) |> summarise(mu = mean(estatura_cm), sigma = sd(estatura_cm)) |> pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor_pob") errores <- map(1:2000, ~ simular_muestra(.x, mu_0, n_0, a, b)) |> bind_rows() |> left_join(poblacion) |> mutate(error = (estimador - valor_pob)) ggplot(errores, aes(x = error, fill = tipo)) + geom_histogram(bins = 20, position = "identity", alpha = 0.5) + facet_wrap(~parametro) Vemos claramente que la estimación de la desviación estándar de nuestro modelo es claramente superior a la de máxima verosimilitud. En resumen: errores |> group_by(tipo, parametro) |> summarise(recm = sqrt(mean(error^2)) |> round(2)) |> arrange(parametro) ## # A tibble: 4 × 3 ## # Groups: tipo [2] ## tipo parametro recm ## <chr> <chr> <dbl> ## 1 max_verosim mu 2.85 ## 2 media_post mu 1.55 ## 3 max_verosim sigma 2.45 ## 4 media_post sigma 1.04 Obtenemos una ganancia considerable en cuanto a la estimación de la desviación estandar de esta población. Los estimadores de la media posterior son superiores a los de máxima verosimilitud en términos de error cuadrático medio. Podemos graficar las dos estimaciones, muestra a muestra, para entender cómo sucede esto: errores |> select(-error) |> pivot_wider(names_from = tipo, values_from = estimador) |> filter(parametro == "sigma") |> ggplot(aes(x = max_verosim, y = media_post)) + geom_abline(colour = "red") + geom_hline(yintercept = sqrt(b/(a - 1)), lty = 2, color = 'black') + geom_point() + labs(subtitle = "Estimación de sigma") + xlab("Estimador MV de sigma") + ylab("Media posterior de sigma") + coord_fixed() + geom_segment(aes(x = 13, y = 11, xend = 13, yend = sqrt(b/(a - 1))), colour='red', size=1, arrow =arrow(length = unit(0.5, "cm"))) + geom_segment(aes(x = .5, y = 6, xend = .5, yend = sqrt(b/(a - 1))), colour='red', size=1, arrow =arrow(length = unit(0.5, "cm"))) Nótese como estimaciones demasiado bajas o demasiada altas son contraídas hacia valores más consistentes con la inicial, lo cual resulta en menor error. El valor esperado de \\(\\sigma\\) bajo la distribución inicial se muestra como una horizontal punteada. Ejemplo: estimación de proporciones Ahora repetimos el ejercicio de la estimación de la proporción de hogares con ingresos superiores a 150 mil. # inicial a <- 2 b <- 100 qbeta(c(0.01, 0.99), a, b) ## [1] 0.001477084 0.063921446 # datos datos <- read_csv("data/conjunto_de_datos_enigh_2018_ns_csv/conjunto_de_datos_concentradohogar_enigh_2018_ns/conjunto_de_datos/conjunto_de_datos_concentradohogar_enigh_2018_ns.csv") |> select(ing_cor) # estimaciones obtener_estimados <- function(datos){ muestra_enigh <- datos |> sample_n(120) |> mutate(mas_150mil = ing_cor > 150000) k <- sum(muestra_enigh$mas_150mil) tibble(k = k, est_mv = k/120, media_post = (a + k) / (120 + b), pob = 0.02769) } estimadores_sim <- map(1:200, ~obtener_estimados(datos)) |> bind_rows() # calculo de errores error_cm <- estimadores_sim |> summarise(error_mv = sqrt(mean((est_mv - pob)^2)), error_post = sqrt(mean((media_post - pob)^2))) error_cm ## # A tibble: 1 × 2 ## error_mv error_post ## <dbl> <dbl> ## 1 0.0147 0.00928 Podemos ver claramente que las medias posteriores están encogidas hacia valores más chicos (donde la inicial tiene densidad alta) comparadas con las estimaciones de máxima verosimilitud: estimadores_sim_ag <- estimadores_sim |> group_by(k, est_mv, media_post) |> summarise(n = n()) ggplot(estimadores_sim_ag, aes(x = est_mv, media_post, size = n)) + geom_point() + geom_abline() Teoría de decisión En esta parte (que sigue a Wasserman (2013) a grandes rasgos), discutimos brevemente teoría general que nos sirve para seleccionar estimadores puntuales, y que esperemos ponga en contexto la parte anterior que acabamos de discutir. Usaremos algunos conceptos que vimos en la parte de propiedades de estimadores de máxima verosimilitud. Definimos una función de pérdida \\(L(\\theta, \\hat{\\theta}_n)\\), que mide el costo de la discrepancia entre nuestro estimador \\[\\hat{\\theta}_n = t(X_1,\\ldots, X_n) = t(X)\\] y el verdadero valor \\(\\theta\\) poblacional. Es posible considerar distintas funciones de pérdida, pero como en secciones anteriores, usaremos la pérdida cuadrática, definida por: \\[L(\\theta, \\hat{\\theta}_n) = (\\theta - \\hat{\\theta}_n)^2\\] Esta función toma distintos valores dependiendo de la muestra y del parámetro \\(\\theta\\), y necesitamos resumirla para dar una evaluación de qué tan bueno es el estimador \\(\\hat{\\theta}_n\\). Ahora que hemos considerado tanto estadística bayesiana como frecuentista, podemos pensar en resumir esta función de distintas maneras. Comenzamos pensando de manera frecuentista. En este caso, consideramos a \\(\\theta\\) como un valor fijo, y nos preguntamos qué pasaría con la pérdida con distintas muestras potenciales que podríamos observar. Definimos como antes el riesgo (frecuentista) como: \\[R(\\theta, t) = \\mathbb{E}_X\\left[ (\\theta - \\hat{\\theta}_n)^2 \\, \\big| \\, \\theta\\right]\\] donde promediamos a lo largo de las muestras posibles, con \\(\\theta\\) fijo. Esta cantidad no nos dice necesariamente cómo escoger un buen estimador para \\(\\theta\\), pues dependiendo de dónde está \\(\\theta\\) puede tomar valores distintos. Ahora vamos a pensar de manera bayesiana: en este caso, los datos serán fijos una vez que los obervemos de manera que \\(\\hat{\\theta}_n\\) está fijo, y el parámetro \\(\\theta\\) es una cantidad aleatoria con distribución inicial \\(p(\\theta)\\). Entonces consideraríamos el promedio sobre la posterior dado por: \\[\\rho(t, X) = \\mathbb{E}_{p(\\theta|X)}\\left[(\\theta - \\hat{\\theta})^2 \\, \\big | \\, X \\right]\\] que llamamos riesgo posterior. Esta cantidad se calcula con la posterior de los parámetros dados los datos, y nos dice, una vez que vimos los datos, cómo es el error de nuestro estimador. Nótese que esta cantidad no es útil para escoger un estimador bueno \\(t\\) antes de ver los datos, pero nos sirve para evaluar a un estimador dados los datos. En el primer caso, promediamos sobre posibles muestras, y en el segundo por valores posibles de \\(\\theta\\) para una muestra dada. Ejemplo: riesgo frecuentista Para observaciones bernoulli, el estimador de máxima verosimilitud es \\(\\hat{p}_1 = k /n\\), donde \\(n\\) es el tamaño de muestra y \\(k\\) el número de éxitos observados. Podemos usar también como estimador la media posterior de un modelo Beta-Bernoulli con inicial \\(a=2, b=2\\), que nos daría \\(\\hat{p}_2 = \\frac{k + 2}{n + 4}\\). Aunque podemos hacer los cálculos analíticos, aproximaremos el riesgo bajo el error cuadrático usando simulación perdida_cuad <- function(p, p_hat){ (p - p_hat)^2 } # dos estimadores t_1 <- function(n, x) x / n t_2 <- function(n, x) (x + 2) / (n + 4) estimar_riesgo <- function(n = 20, theta, perdida, reps = 10000){ x <- rbinom(reps, n, theta) # calcular estimaciones theta_1 <- t_1(n, x) theta_2 <- t_2(n, x) # calcular pérdida media_perdida <- tibble( n = n, theta = theta, estimador = c("MLE", "Posterior"), riesgo = c(mean(perdida(theta, theta_1)), mean(perdida(theta, theta_2)))) media_perdida } estimar_riesgo(n = 20, theta = 0.1, perdida = perdida_cuad) ## # A tibble: 2 × 4 ## n theta estimador riesgo ## <dbl> <dbl> <chr> <dbl> ## 1 20 0.1 MLE 0.00449 ## 2 20 0.1 Posterior 0.00755 Como dijimos, esta cantidad depende de \\(\\theta\\) que no conocemos. Así que calculamos para cada valor de \\(\\theta:\\) Las funciones de riesgo \\(R(\\theta, t_1)\\) y \\(R(\\theta, t_2)\\) (dependen de \\(\\theta\\)) se ven aproximadamente como sigue: p_seq <- seq(0, 1, 0.001) riesgo_tbl <- map(p_seq, ~ estimar_riesgo(n = 20, theta = .x, perdida = perdida_cuad)) |> bind_rows() ggplot(riesgo_tbl, aes(x = theta, y = riesgo, colour = estimador)) + geom_line() Y vemos que el riesgo depende del verdadero valor del parametro: en los extremos, el estimador de máxima verosimilitud tiene menos riesgo, pero en el centro tiene más (esto es independiente del tipo de intervalos que construyamos y su cobertura). La razón es que las estimaciones de tipo Agresti-Coull (\\(\\theta_2\\)) están contraídas hacia 0.5 (agregamos dos éxitos y dos fracasos). Esto produce sesgo en la estimación para valores extremos de \\(\\theta\\). Sin embargo, para valores centrales de \\(\\theta\\) tiene menos variabilidad (por regularización) que el estimador de máxima verosimilitud, y sufre poco de sesgo. Ejemplo: riesgo posterior Supongamos que la inicial es \\(\\theta \\sim \\mathsf{Beta}(5,3)\\) estimar_riesgo_post <- function(n = 20, x, perdida, reps = 20000){ # calcular estimaciones theta_1 <- t_1(n, x) theta_2 <- t_2(n, x) # simular de posterior theta_post <- rbeta(reps, x + 5, n - x + 3) # calcular pérdida media_perdida <- tibble( n = n, x = x, estimador = c("MLE", "Posterior"), riesgo_post= c(mean(perdida(theta_post, theta_1)), mean(perdida(theta_post, theta_2)))) media_perdida } estimar_riesgo_post(n = 20, x = 8, perdida = perdida_cuad) ## # A tibble: 2 × 4 ## n x estimador riesgo_post ## <dbl> <dbl> <chr> <dbl> ## 1 20 8 MLE 0.0127 ## 2 20 8 Posterior 0.0109 Como dijimos, esta cantidad depende de los datos \\(x\\) que no hemos observado. Así que calculamos para cada valor de \\(x\\): Las funciones de pérdida promedio \\(\\rho(x, t_1)\\) y \\(\\rho(x, t_2)\\) (dependen de \\(x\\)) se ven aproximadamente como sigue: x_seq <- seq(0, 20, 1) riesgo_post_tbl <- map(x_seq, ~ estimar_riesgo_post(n = 20, x = .x, perdida = perdida_cuad)) |> bind_rows() ggplot(riesgo_post_tbl, aes(x = x, y = riesgo_post, colour = estimador)) + geom_line() + geom_point() Donde vemos que la pérdida del estimador bayesiano es mejor para valores extremos de número de éxitos observado \\(x\\), pero tiene más riesgo posterior para valores chicos de \\(x\\). En general es mejor el estimador \\(\\theta_2\\). El estimador de máxima verosimilitud tiene más riesgo en los extremos, lo que esperaríamos porque no tenemos la regularización que aporta la posterior. Igualmente, vemos más riesgo para valores chicos de \\(x\\) que para valores grandes: esto es porque la inicial está concentrada en valores reslativamente grandes de \\(\\theta\\). Riesgo de Bayes Finalmente, podemos crear un resumen unificado considerando: Si no conocemos el valor del parámetro \\(\\theta\\), podemos promediar el riesgo frecuentista con la inicial \\(p(\\theta)\\) Si no conocemos los datos observados, podemos promediar usando datos generados por la marginal \\(p(x)\\) de \\(x\\) bajo el modelo de datos \\(p(x|\\theta)\\) y la inicial \\(p(\\theta)\\). Por la ley de la esperanza iterada, estos dos resultados son iguales. La cantidad resultante \\[r(t) = \\int R(\\theta,t) p(\\theta)\\, d\\theta = \\int r(x, t)p(x|\\theta)p(\\theta)\\, d\\theta\\, dx\\] Se llama riesgo de Bayes para el estimador \\(t\\). Ejemplo Podemos calcular marginal_tbl <- function(n = 20, m = 5000){ theta <- rbeta(m, 5, 3) x <- rbinom(m, size = n, p = theta) tibble(x = x) |> group_by(x) |> summarise(n_x = n()) } riesgo_post_tbl |> left_join(marginal_tbl()) |> group_by(estimador) |> summarise(riesgo_bayes = sum(riesgo_post * n_x) / sum(n_x)) ## # A tibble: 2 × 2 ## estimador riesgo_bayes ## <chr> <dbl> ## 1 MLE 0.0104 ## 2 Posterior 0.00833 o también theta_tbl <- tibble(theta = rbeta(50000, 5, 3) |> round(3)) |> group_by(theta) |> summarise(n_x = n()) riesgo_tbl |> left_join(theta_tbl) |> mutate(n_x = ifelse(is.na(n_x), 0, n_x)) |> group_by(estimador) |> summarise(riesgo_bayes = sum(riesgo * n_x) / sum(n_x)) ## # A tibble: 2 × 2 ## estimador riesgo_bayes ## <chr> <dbl> ## 1 MLE 0.0104 ## 2 Posterior 0.00839 Ahora consideremos cómo decidiríamos, desde el punto de vista Bayesiano, qué estimador usar: (Estimador de Bayes) Si tenemos los datos \\(X\\), escogeríamos una función \\(t_X\\) que minimice el riesgo posterior \\(\\rho(t, X)\\), y nuestro estimador es \\(\\hat{\\theta}_n = t_X (X)\\). (Regla de Bayes) Si no tenemos los datos, escogeríamos el estimador una función \\(t\\) que minimice el riesgo de Bayes \\(r(t)\\), y estimaríamos usando \\(\\hat{\\theta}_n = t(X)\\) Pero como el riesgo de Bayes es el promedio del riesgo posterior, la solución de 1 nos da la solución de 2. Es decir, el estimador que escogemos condicional a los datos \\(X\\) es el mismo que escogeríamos antes de escoger los datos, dada una distribución inicial \\(p(\\theta).\\) Por ejemplo, es posible demostrar que bajo la pérdida cuadrática, la regla de Bayes es utilizar la media posterior, bajo la pérdida absoluta, la mediana posterior, etc. Este estimador de Bayes tiene sentido desde el punto de vista frecuentista, también, porque minimiza el riesgo frecuentista promedio, suponiendo la inicial \\(p(\\theta)\\). Por ejemplo, para la pérdida cuadrática podemos usar la descomposición de sesgo y varianza y obtenemos: \\[r(t) = \\mathbb{E}[R(\\theta,t)] = \\mathbb{E}[ \\mathsf{Sesgo}_\\theta^2(t)] +\\mathbb{E}[\\mathsf{Var}_\\theta(t)] \\] Podemos ver entonces que el estimador de Bayes, en este caso la media posterior, es resultado de minimizar la suma de estas dos cantidades: por eso puede incurrir en sesgo, si ese costo se subsana con una reducción considerable de la varianza. Los estimadores insesgados que vimos en esta sección fueron subóptimos en muchos casos justamente porque son insesgados, e incurren en varianza grande. Regresa a los ejemplos anteriores donde evaluamos el desempeño de la media posterior en varios ejemplos. Muestra en las gráficas dónde ves el balance entre sesgo y varianza que cumplen cuando los comparamos con estimadores insesgados. Desde el punto de vista frecuentista, la cuestión es más complicada y hay varias maneras de proceder. En primer lugar, comenzaríamos con el riesgo frecuentista \\(R(\\theta, t)\\). Una idea es,por ejemplo, calcular el riesgo máximo: \\[R_{\\max} (t) = \\underset{\\theta}{\\max} R(\\theta, t).\\] En nuestro ejemplo de arriba el máximo se alcanza en 0.5, y tomaríamos eso evaluación de los estimadores \\(\\theta_1\\) o \\(\\theta_2\\). Buscaríamos entonces estimadores que minimicen este máximo, es decir, estimadores minimax. Pero también es posible enfocar este problema considerando sólo estimadores insesgados, lo que nos lleva por ejemplo a buscar estimadores con mínima varianza. También podemos enfocarnos en buscar estimador admisibles, que son aquellos cuyo riesgo no está dominado para toda \\(\\theta\\) por otro estimador, y así sucesivamente. Finalmente, es posible demostrar (ver Wasserman (2013)) que típicamente, para muestras grandes, el estimador de máxima verosimilitud es cercano a ser minimax y además es una regla de Bayes. Estas son buenas propiedades, pero debemos contar con que el régimen asintótico se cumpla aproximadamente. Referencias "],["métodos-de-cadenas-de-markov-monte-carlo.html", "Sección 12 Métodos de Cadenas de Markov Monte Carlo Integrales mediante subdivisiones Métodos Monte Carlo Simulando de la posterior Ejemplo de islas ¿Por qué funciona Metrópolis? Método de Metrópolis Ajustando el tamaño de salto Metrópolis con varios parámetros Muestreador de Gibbs Conclusiones y observaciones Metrópolis y Gibbs HMC y Stan Diagnósticos generales para MCMC", " Sección 12 Métodos de Cadenas de Markov Monte Carlo Hasta ahora, hemos considerado modelos bayesianos conjugados, donde la posterior tiene una forma conocida. Esto nos permitió simular directamente de la posterior usando las rutinas estándar de R, o utilizar cálculos teóricos o funciones estándar de R para calcular resúmenes de interés, como medias o medianas posteriores o intervalos de credibilidad. Sin embargo, en aplicaciones rara vez es factible este tipo de análisis tan simple, pues: Los modelos que estamos considerando son más complejos y la distribución posterior conjunta de los parámetros no tiene una forma simple conocida. Queremos usar distribuciones iniciales que no son conjugadas para utilizar correctamente nuestra información inicial. Recordamos que tenemos expresiones explícitas para la inicial \\(p(\\theta)\\) y la verosimilitud \\(p(x|\\theta)\\), así que conocemos explícitamente la posterior, módulo la constante de normalización, \\[p(\\theta|x) \\propto p(x|\\theta) \\, p(\\theta).\\] Supongamos por ejemplo que quisiéramos calcular las medias posteriores de los parámetros \\(\\theta\\). En teoría, tendríamos que calcular \\[\\hat \\theta = \\mathbb{E}[{\\theta}\\, |\\, x] = \\int \\theta \\, p(\\theta|x) \\, d\\theta\\] Entonces es necesario calcular también \\(p(x)\\), que resulta de la integral \\[p(x) = \\int p(x|\\theta) \\, p(\\theta)\\, d\\theta\\] Si no tenemos expresiones analíticas simples, tendremos que aproximar numéricamente estas integrales de alguna forma. Si la posterior tiene una forma conocida, podemos calcular cantidades de interés usando fórmulas o rutinas de simulación de distribuciones conocidas que producen muestras independientes. Cuando la posterior no tiene una forma conocida, sin embargo: Podemos intentar usar integración numérica usual. Como veremos, este enfoque no es muy escalable. Podemos usar simulaciones bajo cadenas de Markov (Markov Chain Monte Carlo, MCMC), que es un enfoque más escalable. Mucho del uso generalizado actual de la estadística bayesiana se debe a que gracias al poder de cómputo disponible y los métodos MCMC, no estamos restringidos al uso de 1 y 2, que tienen desventajas grandes. Primero mostraremos cómo el método de integración por subdivisión no es escalable. Integrales mediante subdivisiones Como tenemos una expresión analítica para el integrando, podemos intentar una rutina numérica de integración. Una vez calculada, podríamos entonces usar otra rutina numérica para calcular las medias posteriores \\(\\hat{\\theta}\\). Las rutinas usuales de integración pueden sernos útiles cuando el número de parámetros es chico. Consideremos primero el caso de 1 dimensión, y supongamos que \\(a\\leq\\theta\\leq b\\). Si dividimos el rango de \\(\\theta\\) en intervalos determinados por \\(a = \\theta^1<\\theta^2<\\cdots \\theta^M =b\\), tales que \\(\\Delta\\theta = \\theta^{i+1} -\\theta^{i}\\), podríamos aproximar con \\[p(x) \\approx \\sum_{i=1}^M p(x|\\theta^i)p(\\theta^i) \\Delta\\theta\\] Lo que requiere \\(M\\) evaluaciones del factor \\(p(x|\\theta)p(\\theta)\\). Podríamos usar por ejemplo \\(M=100\\) para tener precisión razonable. Ejemplo: estimación de una proporción Teníamos que \\(p(S_n = k|\\theta) \\propto \\theta^k(1-\\theta)^{n-k}\\) cuando observamos \\(k\\) éxitos en \\(n\\) pruebas independientes. Supongamos que nuestra inicial es \\(p(\\theta) = 2\\theta\\) (checa que es una densidad), es decir, creemos que es más probable a priori observar proporciones altas. Podemos integrar numéricamente crear_log_post <- function(n, k){ function(theta){ verosim <- k * log(theta) + (n - k) * log(1 - theta) inicial <- log(theta) log_p_factor <- verosim + inicial log_p_factor } } # observamos 3 éxitos en 4 pruebas: log_post <- crear_log_post(4, 3) prob_post <- function(x) { exp(log_post(x))} # integramos numéricamente p_x <- integrate(prob_post, lower = 0, upper = 1, subdivisions = 100L) p_x ## 0.03333333 with absolute error < 3.7e-16 Y ahora podemos calcular la media posterior: media_funcion <- function(theta){ theta * prob_post(theta) / p_x$value } integral_media <- integrate(media_funcion, lower = 0, upper = 1, subdivisions = 100L) media_post <- integral_media$value media_post ## [1] 0.7142857 Podemos verificar nuestro trabajo pues sabemos que la posterior es \\(\\mathsf{Beta}(5, 2)\\) cuya media es 5/(2+5) ## [1] 0.7142857 Y podríamos intentar una estrategia similar, por ejemplo, para calcular intervalos de credibilidad. Sin embargo, veremos abajo que este método no escala con el número de parámetros. Más de un parámetro Ahora supongamos que tenemos \\(2\\) parámetros. Dividiríamos cada parámetro en 100 intervalos, y luego tendríamos que calcular \\[p(x) \\approx \\sum_{i=1}^M \\sum_{j=1}^M p(x|\\theta_1^i, \\theta_2^j)p(\\theta_1^i, \\theta_2^j) \\Delta\\theta_1\\Delta\\theta_2\\] Y esto requeriría \\(M^2 = 10,000\\) evaluaciones de \\(p(x|\\theta)p(\\theta)\\). Si tenemos \\(p\\) parámetros, entonces tendríamos que hacer \\(M^p\\) evaluaciones de la posterior. Incluso cuando \\(p=10\\), esta estrategia es infactible, pues tendríamos que hacer más de millones de millones de millones de evaluaciones de la posterior. Si sólo tenemos esta técnica disponible, el análisis bayesiano está considerablemente restringido. Regresión bayesiana con unas 10 covariables por ejemplo, no podría hacerse. De modo que tenemos que replantearnos cómo atacar el problema de calcular o aproximar estas integrales. Métodos Monte Carlo En varias ocasiones anteriormente hemos usado el método Monte Carlo para aproximar integrales: por ejemplo, para calcular medias posteriores. Supongamos que tenemos una densidad \\(p(\\theta)\\). Integración Monte Carlo. Supongamos que queremos calcular el valor esperado de \\(g(X)\\), donde \\(X\\sim p(X\\,|\\,\\theta).\\) Es decir, la variable aleatoria \\(X\\) se distribuye de acuerdo al modelo probabilistico \\(p(X \\, | \\, \\theta),\\) de tal forma que lo que nos interesa calcular es \\[\\mathbb{E}[g(X)] = \\int g(x) p(x|\\theta)\\, dx.\\] Si tomamos una muestra \\(x^{(1)},x^{(2)}, \\ldots x^{(N)} \\overset{iid}{\\sim} p(x|\\theta)\\), entonces \\[\\mathbb{E}[g(X)] \\approx \\, \\frac1N \\, \\sum_{n = 1}^N g(x^{(n)})\\] cuando \\(N\\) es grande. Esto es simplemente una manera de escribir la ley de los grandes números, y hemos aplicado este teorema en varias ocasiones. Nos ha sido útil cuando sabemos cómo simular de distribución \\(p(\\theta | x)\\) (usando alguna rutina de R, por ejemplo, o usando un método estándar como inversión de la función de distribución acumulada). Ejemplo En este ejemplo repetimos cosas que ya hemos visto. En el caso de estimación de una proporción \\(\\theta\\), tenemos como inicial \\(p(\\theta) \\propto \\theta\\), que es \\(\\mathsf{Beta}(2,1)\\). Si observamos 3 éxitos en 4 pruebas, entonces sabemos que la posterior es \\(p(\\theta|x)\\propto \\theta^4(1-\\theta)\\), que es \\(\\mathsf{Beta}(5, 2)\\). Si queremos calcular media y segundo momento posterior para \\(\\theta\\), en teoría necesitamos calcular \\[\\mu = \\int_0^1 \\theta p(\\theta|X = 3)\\, d\\theta,\\,\\, \\mu_2=\\int_0^1 \\theta^2 p(\\theta|X = 3)\\, d\\theta\\] integramos con Monte Carlo theta <- rbeta(10000, 5, 2) media_post <- mean(theta) momento_2_post <- mean(theta^2) c(media_post, momento_2_post) ## [1] 0.7147007 0.5364443 Y podemos aproximar de esta manera cualquier cantidad de interés que esté basada en integrales, como probabilidades asociadas a \\(\\theta\\) o cuantiles asociados. Por ejemplo, podemos aproximar fácilmente \\(P(e^{\\theta}> 2|x)\\) haciendo mean(exp(theta) > 2) ## [1] 0.5959 y así sucesivamente. Este enfoque, sin embargo, es mucho más flexible y poderoso. Ejemplo: varias pruebas independientes Supongamos que probamos el nivel de gusto para 4 sabores distintos de una paleta. Usamos 4 muestras de aproximadamente 50 personas diferentes para cada sabor, y cada uno evalúa si le gustó mucho o no. Obtenemos los siguientes resultados: datos <- tibble( sabor = c("fresa", "limón", "mango", "guanábana"), n = c(50, 45, 51, 50), gusto = c(36, 35, 42, 29)) %>% mutate(prop_gust = gusto / n) datos ## # A tibble: 4 × 4 ## sabor n gusto prop_gust ## <chr> <dbl> <dbl> <dbl> ## 1 fresa 50 36 0.72 ## 2 limón 45 35 0.778 ## 3 mango 51 42 0.824 ## 4 guanábana 50 29 0.58 Usaremos como inicial \\(\\mathsf{Beta}(2, 1)\\) (pues hemos obervado cierto sesgo de cortesía en la calificación de sabores, y no es tan probable tener valores muy bajos) para todos los sabores, es decir \\(p(\\theta_i)\\) es la funcion de densidad de una \\(\\mathsf{Beta}(2, 1)\\). La inicial conjunta la definimos entonces, usando idependiencia inicial, como \\[p(\\theta_1,\\theta_2, \\theta_3,\\theta_4) = p(\\theta_1)p(\\theta_2)p(\\theta_3)p(\\theta_4).\\] Pues inicialmente establecemos que ningún parámetro da información sobre otro: saber que mango es muy gustado no nos dice nada acerca del gusto por fresa. Bajo este supuesto, y el supuesto adicional de que las muestras de cada sabor son independientes, podemos mostrar que las posteriores son independientes: \\[p(\\theta_1,\\theta_2,\\theta_3, \\theta_4|k_1,k_2,k_3,k_4) = p(\\theta_4|k_1)p(\\theta_4|k_2)p(\\theta_4|k_3)p(\\theta_4|k_4)\\] De forma que podemos trabajar individualmente con cada muestra. Calculamos los parámetros de las posteriores individuales: datos <- datos %>% mutate(a_post = gusto + 2, b_post = n - gusto + 1) datos ## # A tibble: 4 × 6 ## sabor n gusto prop_gust a_post b_post ## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 fresa 50 36 0.72 38 15 ## 2 limón 45 35 0.778 37 11 ## 3 mango 51 42 0.824 44 10 ## 4 guanábana 50 29 0.58 31 22 Ahora nos preguntamos, ¿cuál es la probabilidad posterior de que mango sea el sabor más preferido de la población? Conocemos la posterior para cada parámetro, y sabemos que los parámetros son independientes para la posterior. Eso quiere decir que podemos simular de cada parámetro independientemente para obtener simulaciones de la conjunta posterior. simular_conjunta <- function(rep, datos){ datos %>% mutate(valor_sim = map2_dbl(a_post, b_post, ~ rbeta(1, .x, .y))) %>% select(sabor, valor_sim) } simular_conjunta(1, datos) ## # A tibble: 4 × 2 ## sabor valor_sim ## <chr> <dbl> ## 1 fresa 0.886 ## 2 limón 0.729 ## 3 mango 0.701 ## 4 guanábana 0.493 # esta no es una manera muy rápida, podríamos calcular todas las # simulaciones de cada parámetro de manera vectorizada sims_posterior <- tibble(rep = 1:5000) %>% mutate(sims = map(rep, ~ simular_conjunta(.x, datos))) %>% unnest(cols = sims) sims_posterior ## # A tibble: 20,000 × 3 ## rep sabor valor_sim ## <int> <chr> <dbl> ## 1 1 fresa 0.727 ## 2 1 limón 0.823 ## 3 1 mango 0.849 ## 4 1 guanábana 0.474 ## 5 2 fresa 0.659 ## 6 2 limón 0.785 ## 7 2 mango 0.866 ## 8 2 guanábana 0.631 ## 9 3 fresa 0.553 ## 10 3 limón 0.719 ## # ℹ 19,990 more rows Y ahora podemos aproximar fácilmente la probabilidad de interés: sims_posterior %>% group_by(rep) %>% mutate(sabor = sabor[which.max(valor_sim)]) %>% group_by(sabor) %>% count() %>% ungroup() %>% mutate(prop = n / sum(n)) ## # A tibble: 4 × 3 ## sabor n prop ## <chr> <int> <dbl> ## 1 fresa 1264 0.0632 ## 2 guanábana 20 0.001 ## 3 limón 5424 0.271 ## 4 mango 13292 0.665 Y vemos que los mejores sabores son mango y limón. La probabilidad posterior de que mango sea el sabor preferido por la población es de 66%. La integral correspondiente no es trivial. ¿Cuáles son las probabilidades a priori de que cada sabor sea el preferido por la población? ¿Cuál es la integral correspondiente a las probabilidades que acabamos de calcular? ¿Qué tan fácil es hacer esta integral de manera analítica? Calcula la probabilidad de que mango sea preferido a limón? ¿Qué conclusión práctica sacas de estos resultados? Simulando de la posterior Hemos establecido que podemos contestar varias preguntas de inferencia usando simulación Monte Carlo, y que este enfoque es potencialmente escalable (en contraste con métodos de integración numérica por cuadrícula). Ahora el problema que necesitamos resolver es el siguiente: Conocemos \\(p(\\theta |x)\\) módulo una constante de integración. En general, \\(p(\\theta|x)\\) no tiene una forma reconocible que corresponda a un simulador estándar. ¿Cómo simulamos de esta posterior cuando sólo sabemos calcular \\(p(x|\\theta)p(\\theta)\\)? Hay varias maneras de hacer esto. Presentaremos los algoritmos en términos de una distribución cualquiera \\(p(\\theta) = K f(\\theta)\\), donde sólo conocemos la función \\(f(\\theta)\\). Ejemplo de islas Comenzamos revisando el ejemplo de las islas en Kruschke (2015) (7.2) para tener más intuición de cómo funciona este algoritmo. ¿Por qué funciona Metrópolis? Supongamos que un vendedor de Yakult trabaja a lo largo de una cadena de islas: Constantemente viaja entre las islas ofreciendo sus productos; Al final de un día de trabajo decide si permanece en la misma isla o se transporta a una de las \\(2\\) islas vecinas; El vendedor ignora la distribución de la población en las islas y el número total de islas; sin embargo, una vez que se encuentra en una isla puede investigar la población de la misma y también de la isla a la que se propone viajar después. El objetivo del vendedor es visitar las islas de manera proporcional a la población de cada una. Con esto en mente el vendedor utiliza el siguiente proceso: Lanza un volado, si el resultado es águila se propone ir a la isla del lado izquierdo de su ubicación actual y si es sol a la del lado derecho. Si la isla propuesta en el paso anterior tiene población mayor a la población de la isla actual, el vendedor decide viajar a ella. Si la isla vecina tiene población menor, entonces visita la isla propuesta con una probabilidad que depende de la población de las islas. Sea \\(P^*\\) la población de la isla propuesta y \\(P_{t}\\) la población de la isla actual. Entonces el vendedor cambia de isla con probabilidad \\[q_{mover}=P^*/P_{t}\\] A la larga, si el vendedor sigue la heurística anterior la probabilidad de que el vendedor este en alguna de las islas coincide con la población relativa de la isla. islas <- tibble(islas = 1:10, pob = 1:10) camina_isla <- function(i){ # i: isla actual u <- runif(1) # volado v <- ifelse(u < 0.5, i - 1, i + 1) # isla vecina (índice) if (v < 1 | v > 10) { # si estás en los extremos y el volado indica salir return(i) } p_move = ifelse(islas$pob[v] > islas$pob[i], 1, islas$pob[v] / islas$pob[i]) u2 <- runif(1) if (p_move > u2) { return(v) # isla destino } else { return(i) # me quedo en la misma isla } } pasos <- 100000 iteraciones <- numeric(pasos) iteraciones[1] <- sample(1:10, 1) # isla inicial for (j in 2:pasos) { iteraciones[j] <- camina_isla(iteraciones[j - 1]) } caminata <- tibble(pasos = 1:pasos, isla = iteraciones) plot_caminata <- ggplot(caminata[1:1000, ], aes(x = pasos, y = isla)) + geom_point(size = 0.8) + geom_path(alpha = 0.5) + coord_flip() + labs(title = "Caminata aleatoria") + scale_y_continuous(expression(theta), breaks = 1:10) + scale_x_continuous("Tiempo") plot_dist <- ggplot(caminata, aes(x = isla)) + geom_histogram() + scale_x_continuous(expression(theta), breaks = 1:10) + labs(title = "Distribución objetivo", y = expression(P(theta))) plot_caminata / plot_dist Entonces: Para aproximar la distribución objetivo debemos permitir que el vendedor recorra las islas durante una sucesión larga de pasos y registramos sus visitas. Nuestra aproximación de la distribución es justamente el registro de sus visitas. Más aún, debemos tener cuidado y excluir la porción de las visitas que se encuentran bajo la influencia de la posición inicial. Esto es, debemos excluir el periodo de calentamiento. Una vez que tenemos un registro largo de los viajes del vendedor (excluyendo el calentamiento) podemos aproximar la distribución objetivo simplemente contando el número relativo de veces que el vendedor visitó dicha isla. t <- c(1:10, 20, 50, 100, 200, 1000, 5000) plots_list <- map(t, function(i){ ggplot(caminata[1:i, ], aes(x = isla)) + geom_histogram() + labs(y = "", x = "", title = paste("t = ", i, sep = "")) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) }) wrap_plots(plots_list) Escribamos el algoritmo, para esto indexamos las islas por el valor \\(\\theta\\), es así que la isla del extremo oeste corresponde a \\(\\theta=1\\) y la población relativa de cada isla es \\(P(\\theta)\\): El vendedor se ubica en \\(\\theta^{(i)}\\) y propone moverse a la izquierda o derecha con probabilidad \\(0.5\\). El rango de los posibles valores para moverse, y la probabilidad de proponer cada uno se conoce como distribución propuesta, en nuestro ejemplo sólo toma dos valores cada uno con probabilidad \\(0.5\\). Una vez que se propone un movimiento, decidimos si aceptarlo. La decisión de aceptar se basa en el valor de la distribución objetivo en la posición propuesta, relativo al valor de la distribución objetivo en la posición actual: \\[\\alpha=\\min\\bigg\\{\\frac{P(\\theta^*)}{P(\\theta^{(i)})},1\\bigg\\},\\] donde \\(\\alpha\\) denota la probabilidad de hacer el cambio de isla. Notemos que la distribución objetivo \\(P(\\theta)\\) no necesita estar normalizada, esto es porque lo que nos interesa es el cociente \\(P(\\theta^*)/P(\\theta^{(i)})\\). Una vez que propusimos un movimiento y calculamos la probabilidad de aceptar el movimiento aceptamos o rechazamos el movimiento generando un valor de una distribución uniforme, si dicho valor es menor a la probabilidad de cambio, \\(\\alpha,\\) entonces hacemos el movimiento. Entonces, para utilizar el algoritmo necesitamos ser capaces de: Generar un valor de la distribución propuesta, que hemos denotado por \\(q,\\) (para crear \\(\\theta^*\\)). Evaluar la distribución objetivo en cualquier valor propuesto (para calcular \\(P(\\theta^*)/P(\\theta^{(i)})\\)). Generar un valor uniforme (para movernos con probabilidad \\(\\alpha\\)). Las \\(3\\) puntos anteriores nos permiten generar muestras aleatorias de la distribución objetivo, sin importar si esta está normalizada. Esta técnica es particularmente útil cuando cuando la distribución objetivo es una posterior proporcional a \\(p(x|\\theta)p(\\theta)\\). Para entender porque funciona el algoritmo de Metrópolis hace falta entender \\(2\\) puntos, primero que la distribución objetivo es estable: si la probabilidad actual de ubicarse en una posición coincide con la probabilidad en la distribución objetivo, entonces el algoritmo preserva las probabilidades. library(expm) transMat <- function(P){ # recibe vector de probabilidades (o población) T <- matrix(0, 10, 10) n <- length(P - 1) # número de estados for (j in 2:n - 1) { # llenamos por fila T[j, j - 1] <- 0.5 * min(P[j - 1] / P[j], 1) T[j, j] <- 0.5 * (1 - min(P[j - 1] / P[j], 1)) + 0.5 * (1 - min(P[j + 1] / P[j], 1)) T[j, j + 1] <- 0.5 * min(P[j + 1] / P[j], 1) } # faltan los casos j = 1 y j = n T[1, 1] <- 0.5 + 0.5 * (1 - min(P[2] / P[1], 1)) T[1, 2] <- 0.5 * min(P[2] / P[1], 1) T[n, n] <- 0.5 + 0.5 * (1 - min(P[n - 1] / P[n], 1)) T[n, n - 1] <- 0.5 * min(P[n - 1] / P[n], 1) T } T <- transMat(islas$pob) w <- c(0, 1, rep(0, 8)) t <- c(1:10, 20, 50, 100, 200, 1000, 5000) expT <- map_df(t, ~data.frame(t = ., w %*% (T %^% .))) expT_long <- expT %>% gather(theta, P, -t) %>% mutate(theta = parse_number(theta)) ggplot(expT_long, aes(x = theta, y = P)) + geom_bar(stat = "identity", fill = "darkgray") + facet_wrap(~ t) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) El segundo punto es que el proceso converge a la distribución objetivo. Podemos ver, (en nuestro ejemplo sencillo) que sin importar el punto de inicio se alcanza la distribución objetivo. inicio_p <- function(i){ w <- rep(0, 10) w[i] <- 1 t <- c(1, 10, 50, 100) exp_t <- map_df(t, ~ data.frame(t = .x, inicio = i, w %*% (T %^% .))) %>% gather(theta, P, -t, -inicio) %>% mutate(theta = parse_number(theta)) exp_t } exp_t <- map_df(c(1, 3, 5, 9), inicio_p) ggplot(exp_t, aes(x = as.numeric(theta), y = P)) + geom_bar(stat = "identity", fill = "darkgray") + facet_grid(inicio ~ t) + scale_x_continuous(expression(theta), breaks = 1:10, limits = c(0, 11)) Método de Metrópolis En el método de Metrópolis, uno de los más antiguos, comenzamos con un valor inicial de los parámetros \\(\\theta^{(0)}\\) en el soporte de \\(p(\\theta)\\), es decir \\(p(\\theta^{(0)})>0.\\) Para \\(i=1, \\ldots, M\\), hacemos: Partiendo de \\(\\theta^{(i)}\\), hacemos un salto corto en una dirección al azar para obtener una propuesta \\(\\theta^* \\sim q(\\theta \\, |\\, \\theta^{(i)}).\\) Aceptamos or rechazamos el salto: Si \\(\\alpha = \\frac{f(\\theta^*)}{f(\\theta^{(i)})} \\geq 1\\), aceptamos el salto y ponemos \\(\\theta^{(i+1)}=\\theta^*\\). Regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1.\\) Si \\(\\alpha = \\frac{f(\\theta^*)}{f(\\theta^{(i)})} < 1\\), entonces aceptamos con probabilidad \\(\\alpha\\) el salto, ponemos \\(\\theta^{(i+1)}=\\theta^*\\) y regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1\\). Si rechazamos el salto, ponemos entonces \\(\\theta^{(i+1)}=\\theta^{(i)}\\) y regresamos a 1 para la siguiente iteración \\(i\\leftarrow i + 1.\\) Requerimos también que la función que propone los saltos sea simétrica: es decir, \\(q(\\theta^*|\\theta^{(i)})\\) debe ser igual a \\(q(\\theta^{(i)}|\\theta^*)\\). Se puede modificar el algoritmo para tratar con una propuesta que no sea simétrica. Una elección común es escoger \\(q(\\theta^* |\\theta^{(i)})\\) como una \\(\\mathsf{N}(\\theta^{(i)}, \\sigma_{salto})\\). En este curso, escribiremos varios métodos de cadenas de Markov para estimación Monte Carlo (Markov Chain Monte Carlo, MCMC) desde cero para entender los básicos de cómo funciona. Sin embargo, en la práctica no hacemos esto, sino que usamos software estándar (Stan, JAGS, BUGS, etc.) para hacer este trabajo. Expertos en MCMC, métodos numéricos, y estadística a veces escriben partes de sus rutinas de simulación, y pueden lograr mejoras de desempeño considerables. Excepto para modelos simples, esto no es trivial de hacer garantizando resultados correctos. En resumen, todo el código de esta sección es de carácter ilustrativo. Utiliza implementaciones establecidas en las aplicaciones. Abajo implementamos el algoritmo con un salto de tipo normal: crear_metropolis <- function(fun_log, sigma_salto = 0.1){ # la entrada es la log posterior iterar_metropolis <- function(theta_inicial, n){ p <- length(theta_inicial) nombres <- names(theta_inicial) iteraciones <- matrix(0, nrow = n, ncol = p) colnames(iteraciones) <- nombres iteraciones[1,] <- theta_inicial for(i in 2:n){ theta <- iteraciones[i - 1, ] theta_prop <- theta + rnorm(p, 0, sigma_salto) # exp(log(p) - log(q)) = p/q cociente <- exp(fun_log(theta_prop) - fun_log(theta)) if(cociente >= 1 || runif(1,0,1) < cociente){ iteraciones[i, ] <- theta_prop } else { iteraciones[i, ] <- theta } } iteraciones_tbl <- iteraciones %>% as_tibble() %>% mutate(iter_num = row_number()) %>% select(iter_num, everything()) iteraciones_tbl } iterar_metropolis } E intentamos simular de una exponencial no normalizada: exp_no_norm <- function(x) { z <- ifelse(x > 0, exp(-0.5 * x), 0) log(z) } iterador_metro <- crear_metropolis(exp_no_norm, sigma_salto = 0.25) sims_tbl <- iterador_metro(c(theta = 0.5), 50000) ggplot(sims_tbl, aes(x = theta)) + geom_histogram() Ahora probemos con una \\(\\mathsf{Beta}(3, 2):\\) beta_no_norm <- function(x) { z <- ifelse(x > 0 && x < 1, (x^2)*(1-x), 0) log(z) } iterador_metro <- crear_metropolis(beta_no_norm, sigma_salto = 0.04) sims_metro_tbl <- iterador_metro(c(theta = 0.5), 50000) sims_indep_tbl <- tibble(iter_num = 1:30000, theta = rbeta(30000, 3, 2)) g_1 <- ggplot(sims_metro_tbl, aes(x = theta)) + geom_histogram() + labs(subtitle = "Metrópolis") g_2 <- ggplot(sims_indep_tbl, aes(x = theta)) + geom_histogram() + labs(subtitle = "rbeta") g_1 + g_2 Y vemos que esto funciona. Nótese sin embargo un aspecto de estas simulaciones que no habíamos encontrado en el curso. Aunque la distribución final de las simulaciones es muy cercana a la de la distribución que queremos simular, lo cual era nuestro propósito, las simulaciones no son extracciones independientes de esa distribución. La construcción del algoritmo muestra eso, pero podemos también graficar las simulaciones: g_metropolis <- sims_metro_tbl %>% filter(iter_num < 500) %>% ggplot(aes(x = iter_num, y = theta)) + geom_line() + labs(subtitle = "Metrópolis") g_indep <- sims_indep_tbl %>% filter(iter_num < 500) %>% ggplot(aes(x = iter_num, y = theta)) + geom_line() + labs(subtitle = "Independientes") g_metropolis + g_indep Donde vemos claramente que las simulaciones de metropolis están autocorrelacionadas: la siguiente simulación depende de la anterior. Esto define una cadena de Markov. En cualquiera de los dos casos, como vimos en los histogramas de arriba, las simulaciones “visitan” cada parte [0,1] de manera proporcional a la densidad, de manera que podemos usar ambos tipos de simulaciones para aproximar la integral o cantidad que nos interesa. Por ejemplo, la media posterior es: media_1 <- sims_metro_tbl %>% summarise(media_post = mean(theta)) %>% pull(media_post) media_2 <- sims_indep_tbl %>% summarise(media_post = mean(theta)) %>% pull(media_post) media_exacta <- 3/(3 + 2) tibble(metodo = c("sim Metrópolis", "sim Independiente", "exacto"), media_post = c(media_1, media_2, media_exacta)) ## # A tibble: 3 × 2 ## metodo media_post ## <chr> <dbl> ## 1 sim Metrópolis 0.613 ## 2 sim Independiente 0.600 ## 3 exacto 0.6 Supongamos que queremos simular de una distribución \\(p(\\theta)\\), pero sólo conocemos \\(p(\\theta)\\) módulo una constante. Bajo ciertas condiciones de regularidad: El algoritmo Metrópolis para la distribución \\(p(\\theta)\\) define una cadena de Markov cuya distribución a largo plazo es \\(p(\\theta)\\). Esto implica que si \\(\\theta^{(1)},\\theta^{(2)}, \\ldots, \\theta^{(M)}\\) es una simulación de esta cadena, y \\(M\\) es suficientemente grande La distribución de las \\(\\theta^{(i)}\\) es aproximadamente \\(p(\\theta)\\), Tenemos que \\[ \\frac1M \\sum_{m = 1}^M h(\\theta^{(m)}) \\to \\int h(\\theta)p(\\theta)\\, d\\theta\\] cuando \\(M\\to \\infty\\) Observaciones: Aunque hay distintas condiciones de regularidad que pueden funcionar, generalmente el supuesto es que la cadena de Markov construída es ergódica, y hay varias condiciones que garantizan esta propiedad. Una condición simple, por ejemplo, es que el soporte de la distribución \\(p(\\theta)\\) es un conjunto conexo del espacio de parámetros. Más crucialmente, este resultado no dice qué tan grande debe ser \\(M\\) para que la aproximación sea buena. Esto depende de cómo es \\(p(\\theta)\\), y de la distribución que se utiliza para obtener los saltos propuestos. Dependiendo de estos dos factores, la convergencia puede ser rápida (exponencial) o tan lenta que es infactible usarla. Más adelante veremos diagnósticos para descartar los peores casos de falta de convergencia. Ajustando el tamaño de salto En el algoritmo Metrópolis, generalmente es importante escoger la dispersión de la distribución que genera propuestas con cuidado. Si la dispersión de la propuesta es demasiado grande, tenderemos a rechazar mucho, y la convergencia será lenta. Si la dispersión de la propuesta es demasiado chica, tardaremos mucho tiempo en explorar las distintas partes de la distribución objetivo. Ejemplo Supongamos que queremos simular usando metróplis de una distribución \\(\\textsf{Gamma}(20, 100)\\). Abajo vemos la forma de esta distribución: sim_indep <- tibble(theta = rgamma(10000, 20, 100)) ggplot(sim_indep, aes(x = theta)) + geom_histogram() # logaritmo de densidad no normalizada log_f_dist <- function(x) 210 + dgamma(x, 20, 100, log = TRUE) # iterar iterador_metro_chico <- crear_metropolis(log_f_dist, sigma_salto = 0.001) sims_chico_tbl <- iterador_metro_chico(c(theta = 0.02), 50000) g_sim <- ggplot(sims_chico_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) dist_bplot <- ggplot(tibble(x = rgamma(10000, 20, 100)), aes(y = x, x = "a")) + geom_violin() + ylab("") + ylim(0, 0.5) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) Nótese que después de 5 mil iteraciones estamos muy lejos de tener una muestra que se aproxime a la distribución objetivo. Empezamos en un lugar bajo, y la cadena sólo ha ido lentamente hacia las zonas de alta densidad. Cualquier resumen con esta cadena estaría fuertemente sesgado al valor donde iniciamos la iteración. Decimos que la cadena todavía no mezcla en las primeras 5 mil iteraciones. Ahora vemos qué pasa si ponemos el tamaño de salto demasiado grande: set.seed(831) iterador_metro_grande <- crear_metropolis(log_f_dist, sigma_salto = 20) sims_grande_tbl <- iterador_metro_grande(c(theta = 0.02), 50000) g_sim <- ggplot(sims_grande_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) En este caso, la cadena se atora muchas veces, pues las propuestas tienen probabilidad muy baja, y tendemos a tener una tasa de rechazos muy alta. Esto quiere decir que la información que tenemos acerca de la posterior es relativamente poca, pues muchos datos son repeticiones del mismo valor. Cualquier resumen con esta cadena podría estar muy lejos del verdadero valor, pues su varianza es alta - otra corrida se “atoraría” en otros valores distintos. Nótese que cualquiera de estas cadenas, si la corremos suficientemente tiempo, nos daría resultados buenos. Sin embargo, el número de simulaciones puede ser infactible. Un valor intermedio nos dará mucho mejores resultados: set.seed(831) iterador_metro_apropiada <- crear_metropolis(log_f_dist, sigma_salto = 0.1) sims_tbl <-iterador_metro_apropiada(c(theta = 0.02), 50000) g_sim <- ggplot(sims_tbl %>% filter(iter_num < 3000), aes(x = iter_num, y = theta)) + geom_line() + ylim(c(0, 0.5)) g_sim + dist_bplot + plot_layout(widths = c(5, 1)) Donde vemos que esta cadena parece mezclar bien (está explorando la totalidad de la distribución objetivo), y también parece estar en un estado estable. Comparemos cómo saldría por ejemplo la media posterior aproximada según los tres métodos: estimaciones_media <- map_dfr( list(sims_chico_tbl, sims_grande_tbl, sims_tbl), ~ filter(.x, iter_num < 3000) %>% summarise(media = mean(theta))) %>% mutate(tipo = c("salto chico", "salto grande", "salto apropiado")) estimaciones_media %>% bind_rows(tibble(tipo = "exacta", media = 20/100)) %>% select(tipo, media) ## # A tibble: 4 × 2 ## tipo media ## <chr> <dbl> ## 1 salto chico 0.132 ## 2 salto grande 0.190 ## 3 salto apropiado 0.203 ## 4 exacta 0.2 Veamos otra corrida: set.seed(6222131) sims_chica_tbl <- iterador_metro_chico(c(theta = 0.02), 5000) sims_grande_tbl <- iterador_metro_grande(c(theta = 0.02), 5000) estimaciones_media <- map_dfr( list(sims_chica_tbl, sims_grande_tbl, sims_tbl), ~ filter(.x, iter_num < 3000) %>% summarise(media = mean(theta))) %>% mutate(tipo = c("salto chico", "salto grande", "salto apropiado")) estimaciones_media %>% bind_rows(tibble(tipo = "exacta", media = 20/100)) %>% select(tipo, media) ## # A tibble: 4 × 2 ## tipo media ## <chr> <dbl> ## 1 salto chico 0.124 ## 2 salto grande 0.229 ## 3 salto apropiado 0.203 ## 4 exacta 0.2 Repite este proceso varias veces. Verifica que: Si el tamaño de paso es muy chico, las estimaciones de la media tienen sesgo alto. Si el tamaño de paso es muy grande, las estimaciones tienen varianza alta. Si el tamaño de paso es adecuado, obtenemos buena precisión en la estimación de la media posterior. Explica estos tres casos en términos de la convergencia de las realizaciones de la cadena de Markov. Explica cómo afecta a cada caso el valor inicial de las simulaciones de Metrópolis. Repite para otra estadística, como la desviación estándar o el rangon intercuartil. Metrópolis con varios parámetros Ahora aplicaremos el algoritmo Metrópolis cuando tenemos varios parámetros. La idea es la misma, pero nuestra distribución de salto debe ser multivariada. Una selección usual es usando saltos normales independientes para cada parámetro, es decir, la normal multivariada con matriz de varianza y covarianza diagonal. Ejemplo: el modelo normal Veremos cómo simular con Metrópolis para el problema de los cantantes. Sabemos como calcular la posterior: crear_log_posterior_norm <- function(x = datos, m_0, n_0, a, b){ # calcula log_posterior log_posterior <- function(mu, sigma){ log_verosim <- sum(dnorm(x, mu, sigma, log = TRUE)) tau <- 1 / sigma^2 log_inicial <- dgamma(tau, a, b, log = TRUE) + dnorm(mu, mu_0, sigma/sqrt(n_0), log = TRUE) log_p <- log_verosim + log_inicial log_p } log_posterior } # parametros de inicial y datos a <- 3 b <- 140 mu_0 <- 175 n_0 <- 5 set.seed(3413) cantantes <- lattice::singer %>% mutate(estatura_cm = round(2.54 * height)) %>% filter(str_detect(voice.part, "Tenor")) %>% sample_n(20) Vemos cómo se ven las primeras iteraciones de nuestra cadena de Markov: log_p <- crear_log_posterior_norm(cantantes$estatura_cm, mu_0, n_0, a, b) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(823) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 172, sigma = 3), 50000) ggplot(sim_tbl %>% filter(iter_num < 100), aes(x = mu, y = sigma)) + geom_path() + geom_point() Y ahora vemos todas las simulaciones: g_normal <- ggplot(sim_tbl, aes(x = mu, y = sigma)) + geom_point(alpha = 0.05)+ coord_equal() + ylim(c(0, 14)) g_normal Y las medias posteriores son: sim_tbl %>% summarise(across(is_double, mean)) ## # A tibble: 1 × 2 ## mu sigma ## <dbl> <dbl> ## 1 176. 6.80 Ejemplo: observaciones normales, no conjugado Arriba repetimos el análisis conjugado usando Metrópolis. Aunque ya no es necesario usar el modelo conjugado, y podemos poner iniciales que sean más intuitivas y acorde con nuestro conocimiento existente. Por ejemplo, podemos poner \\(p(\\mu, \\sigma) = p(\\mu)p(\\sigma)\\), donde la densidad de \\(\\mu \\sim \\mathsf{N}(175, 2)\\) y \\(\\sigma \\sim \\mathsf{U}[2, 20].\\) Igual que antes, la verosimilitud \\(p(x|\\mu, \\sigma)\\) es normal con media \\(\\mu\\) y desviación estándar \\(\\sigma.\\) Escribimos la posterior: crear_log_posterior <- function(x, m_0, sigma_0, inf, sup){ # calcula log_posterior log_posterior <- function(mu, sigma){ log_verosim <- sum(dnorm(x, mu, sigma, log = TRUE)) log_inicial <- dunif(sigma, inf, sup, log = TRUE) + dnorm(mu, mu_0, sigma_0, log = TRUE) log_p <- log_verosim + log_inicial log_p } log_posterior } log_p <- crear_log_posterior(cantantes$estatura_cm, 175, 3, 2, 20) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(8231) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 172, sigma = 5), 50000) g_normal_2 <- ggplot(sim_tbl, aes(x = mu, y = sigma)) + geom_point(alpha = 0.05) + coord_equal() + ylim(c(0, 14)) g_normal + g_normal_2 Los resultados son similares, pero en nuestras estimaciones bajo el segundo modelo, la \\(\\sigma\\) está concentrada en valores un poco más bajos que el modelo normal-gamma inversa. Las medias posteriores son: sim_tbl %>% summarise(across(is.numeric, mean)) ## # A tibble: 1 × 3 ## iter_num mu sigma ## <dbl> <dbl> <dbl> ## 1 25000. 176. 6.54 Nótese que la inicial para el modelo normal-gamma inversa pone muy poca probabilidad para valores bajos de \\(\\sigma\\), mientras que el segundo modelo hay un 10% de probabilidad de que la \\(\\sigma\\) sea menor que 4. tau <- rgamma(5000, 3, 150) sigma <- 1/sqrt(tau) quantile(sigma, c(0.01,0.1, 0.9, 0.99)) ## 1% 10% 90% 99% ## 4.219278 5.276228 11.579358 19.038529 quantile(runif(5000, 2, 25), c(0.01,0.1, 0.9, 0.99)) ## 1% 10% 90% 99% ## 2.261297 4.254128 22.691760 24.719630 Ejemplo: exámenes Recordamos un ejemplo que vimos en la sección de máxima verosimilitud. Supongamos que en una población de estudiantes tenemos dos tipos: unos llenaron un examen de opción múltiple al azar (1 de 5), y otros contestaron las preguntas intentando sacar una buena calificación. Suponemos que una vez que conocemos el tipo de estudiante, todas las preguntas tienen la misma probabilidad de ser contestadas correctamente, de manera independiente. El modelo teórico está representado por la siguiente simulación: sim_formas <- function(p_azar, p_corr){ tipo <- rbinom(1, 1, 1 - p_azar) if(tipo==0){ # al azar x <- rbinom(1, 10, 1/5) } else { # no al azar x <- rbinom(1, 10, p_corr) } x } Y una muestra se ve como sigue: set.seed(12) muestra <- map_dbl(1:200, ~ sim_formas(0.35, 0.5)) qplot(muestra) Supongamos que no conocemos la probabildad de contestar correctamente ni la proporción de estudiantes que contestó al azar. ¿Como estimamos estas dos cantidades? La verosimilitud la escribimos en el ejercicio anterior en la sección de máxima verosimilitud, está dada, para las repuestas de un estudiante, por: \\[p(X = k|\\theta_{azar}, \\theta_{corr}) \\propto \\theta_{azar}(1/5)^k(4/5)^{10-k} + (1-\\theta_{azar})\\theta_{corr}^k(1-\\theta_{corr})^{10-k}\\] Suponiendo que todas las preguntas tienen la misma dificultad, y que los estudiantes que estudiaron son homogéneos (podemos discutir qué haríamos para introducir heterogeneidad que típicamente observaríamos). Creemos que la mayoría de los estudiantes no contesta al azar, así que pondremos como inicial \\[\\theta_{azar} \\sim \\mathsf{Beta}(1, 5)\\] qbeta(c(0.1, 0.9), 1, 5) %>% round(2) ## [1] 0.02 0.37 Ahora tenemos que pensar en la probabilidad \\(\\theta_{corr}\\) para los estudiantes que sí estudiaron. Imaginemos que lo probamos con un estudiante que sabemos que sí estudió, y obtuvo un porcentaje de correctos de 7/10, Podríamos poner entonces (vimos 10 intentos, con 3 fracasos y 7 éxitos): \\[\\theta_{corr} \\sim \\mathsf{Beta}(7, 3)\\] Finalmente, necesitamos la conjunta inicial. Pondremos \\[p(\\theta_{azar},\\theta_{corr}) = p(\\theta_{azar})p(\\theta_{corr})\\] con lo que expresamos que inicialmente no creemos que estos dos parámetros estén relacionados. Si pensáramos, por ejemplo, que cuando hacemos exámenes difíciles menos estudiantes estudian, entonces deberíamos intentar otra conjunta. Escribimos el producto de la verosimilitud con la inicial: crear_log_posterior <- function(x){ log_posterior <- function(theta_azar, theta_corr){ log_verosim <- sum(log(theta_azar * dbinom(x, 10, 1/5) + (1 - theta_azar) * dbinom(x, 10, theta_corr))) log_inicial <- dbeta(theta_azar, 1, 5, log = TRUE) + dbeta(theta_corr, 7, 3, log = TRUE) log_post <- log_verosim + log_inicial log_post } log_posterior } Creamos la función de verosimilitud con los datos log_p <- crear_log_posterior(muestra) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(8231) metro_examenes <- crear_metropolis(log_post, sigma_salto = 0.02) sim_tbl <- metro_examenes(c(theta_azar = 0.5, theta_corr = 0.5), 20000) g_1 <- ggplot(sim_tbl, aes(x = theta_azar, y = theta_corr)) + geom_point(alpha = 0.05) + coord_equal() g_1 Nótese que hay cierta correlación entre las dos proporciones, y esto produce intervalos posteriores relativamente amplios. Esto es de esperarse, pues los datos son consistentes con una proporción relativamente chica de estudiantes que contestan al azar, y tasas de correctos más altas entre los que sí estudian, y una proporción más grande de respuestas al azar con tasas de correctos más altas. f <- c(0.05, 0.5, 0.95) sim_tbl %>% pivot_longer(-iter_num, names_to = "parametro", values_to = "valor") %>% group_by(parametro) %>% summarise(cuantil = quantile(valor, f), f = f) %>% mutate(cuantil = round(cuantil, 2)) %>% pivot_wider(names_from = f, values_from = cuantil) ## # A tibble: 2 × 4 ## # Groups: parametro [2] ## parametro `0.05` `0.5` `0.95` ## <chr> <dbl> <dbl> <dbl> ## 1 theta_azar 0.3 0.38 0.45 ## 2 theta_corr 0.5 0.52 0.56 Muestreador de Gibbs El algoritmo de Metrópolis es muy general y se puede aplicar a una gran variedad de problemas. Sin embargo, afinar los parámetros de la distribución propuesta para que el algoritmo funcione correctamente puede ser complicado. El muestredor de Gibbs no necesita de una distribución propuesta y por lo tanto no requiere afinar estos parámetros. Para implementar un muestreador de Gibbs se necesita ser capaz de generar muestras de la distribución posterior condicional a cada uno de los parámetros individuales. Esto es, el muestreador de Gibbs permite generar muestras de la posterior: \\[p(\\theta_1,...,\\theta_p|x)\\] siempre y cuando podamos generar valores de todas las distribuciones condicionales: \\[\\theta_k \\sim p(\\theta_k|\\theta_1,...,\\theta_{k-1},\\theta_{k+1},...,\\theta_p,x).\\] El proceso del muestreador de Gibbs es una caminata aleatoria a lo largo del espacio de parámetros. La caminata inicia en un punto arbitrario y en cada tiempo el siguiente paso depende únicamente de la posición actual. Por tanto el muestredor de Gibbs es un proceso cadena de Markov vía Monte Carlo. La diferencia entre Gibbs y Metrópolis radica en como se deciden los pasos. Muestreador Gibbs En cada punto de la caminata se selecciona uno de los componentes del vector de parámetros (típicamente se cicla en orden): Supongamos que se selecciona el parámetro \\(k\\)-ésimo después de haber modificado los \\(k-1\\) anteriores, entonces obtenemos un nuevo valor para este parámetro generando una simulación de la distribución condicional \\[\\theta_k^{(i+1)} \\sim p(\\theta_k|\\theta_1^{(i+1)},\\ldots,\\theta_{k-1}^{(i+1)},\\theta_{k+1}^{(i)},\\ldots,\\theta_p^{(i)},x)\\] El nuevo valor \\(\\theta_k^{(i+1)}\\) junto con los valores \\(\\theta_1^{(i+1)},\\ldots,\\theta_{k-1}^{(i+1)},\\theta_{k+1}^{(i)},\\ldots,\\theta_p^{(i)}\\) constituyen la nueva posición en la caminata aleatoria. Seleccionamos una nueva componente \\(\\theta_{k+1}^{(i+1)}\\) y repetimos el proceso. El muestreador de Gibbs es útil cuando no podemos determinar de manera analítica la distribución conjunta y no se puede simular directamente de ella, pero sí podemos determinar todas las distribuciones condicionales y simular de ellas. Ejemplo: dos proporciones Supongamos que queremos evaluar el balanceo de dos dados de 20 lados que produce una fábrica. En particular, evaluar la probabilidad de tirar un 20, y quizá escoger el dado que nos de mayor probabilidad de tirar un 20. Tiramos cada dado \\(n\\) veces, y denotamos por \\(X_1\\) y \\(X_2\\) el número de 20’s que tiramos en cada ocasión. El modelo de datos está dado por \\[p(x_1, x_2|\\theta_1, \\theta_2)\\propto \\theta_1^{x_1}(1-\\theta_1)^{n - x_1}\\theta_2^{x_2}(1-\\theta_2)^{n - x_2},\\] que es el producto de dos densidades binomiales, pues suponemos que las tiradas son independientes cuando conocemos los parámetros \\(\\theta_1\\) y \\(\\theta_2\\). Ahora ponemos una inicial \\[p(\\theta_i)\\sim \\mathsf{Beta}(100, 1900)\\] y aquí están las razones de nuestra elección: media <- 1/20 k <- 2000 a <- media * k b <- (1 - media) * k c(a,b) ## [1] 100 1900 qbeta(c(0.05, 0.95), a, b) %>% round(3) ## [1] 0.042 0.058 y suponemos que \\[p(\\theta_1,\\theta_2) = p (\\theta_1)p(\\theta_2)\\] es decir, apriori saber el desempeño de un dado no nos da información adicional del otro (esto podría no ser cierto, por ejemplo, si el defecto es provocado por la impresión del número 20). Por lo tanto, la posterior es \\[p(\\theta_1,\\theta_2|x_1, x_2)\\propto \\theta_1^{x_1+100-1}(1-\\theta_1)^{n - x_1 + 1900-1}\\theta_2^{x_2+100 -1}(1-\\theta_2)^{n - x_2 + 1900-1}\\] Ahora consideramoso qué pasa cuando conocemos \\(\\theta_2\\) y los datos. Pensamos en todo lo que no sea \\(\\theta_1\\) como constante de modo que nos queda: \\[p(\\theta_1 | \\theta_2, x) \\propto \\theta_1^{x_1+100 -1}(1-\\theta_1)^{n - x_1 + 1900 -1}\\] que es \\(\\mathsf{Beta}(x_1 + 100, n - x_1 + 1900)\\), y por la misma razón, \\[p(\\theta_2 | \\theta_1, x) \\propto \\theta_2^{x_2+100-1}(1-\\theta_2)^{n - x_2 + 1900-1}\\] que también es es \\(\\mathsf{Beta}(x_1 + 100, n - x_1 + 1900)\\) De hecho, estas condicionales son fáciles de deducir de otra manera: en realidad estamos haciendo dos experimentos separados (pues suponemos que las iniciales son independientes y las pruebas también), así que podriamos usar el análisis Beta-Binomial para cada uno de ellos. En realidad no es necesario usar MCMC para este ejemplo. Usaremos esta función para hacer nuestras iteraciones de Gibbs: iterar_gibbs <- function(pasos, n, x_1, x_2){ iteraciones <- matrix(0, nrow = pasos + 1, ncol = 2) # vector guardará las simulaciones iteraciones[1, 1] <- 0.5 # valor inicial media colnames(iteraciones) <- c("theta_1", "theta_2") # Generamos la caminata aleatoria for (j in seq(2, pasos, 2)) { # theta_1 a <- x_2 + 100 - 1 b <- n - x_2 + 1900 - 1 iteraciones[j, "theta_2"] <- rbeta(1, a, b) # Actualizar theta_1 iteraciones[j, "theta_1"] <- iteraciones[j-1, "theta_1"] # theta_2 a <- x_1 + 100 - 1 b <- n - x_1 + 1900 - 1 iteraciones[j + 1, "theta_1"] <- rbeta(1, a, b) # Actualizar theta_1 iteraciones[j + 1, "theta_2"] <- iteraciones[j, "theta_2"] } iteraciones } Y supongamos que estamos comparando los dados de dos compañías: Chessex y GameScience. Tiramos cada dado 10 mil veces, y obtenemos: # Datos de https://www.awesomedice.com/blogs/news/d20-dice-randomness-test-chessex-vs-gamescience n <- 10000 x_1 <- 408 # Chessex, alrededor de 0.85 dólares por dado x_2 <- 474 # GameScience, alrededor 1.60 dólares por dado E iteramos: iteraciones <- iterar_gibbs(20000, n, x_1, x_2) %>% as_tibble() %>% mutate(iter_num = row_number()) head(iteraciones) ## # A tibble: 6 × 3 ## theta_1 theta_2 iter_num ## <dbl> <dbl> <int> ## 1 0.5 0 1 ## 2 0.5 0.0479 2 ## 3 0.0442 0.0479 3 ## 4 0.0442 0.0452 4 ## 5 0.0411 0.0452 5 ## 6 0.0411 0.0505 6 ggplot(filter(iteraciones, iter_num > 1000, iter_num< 1050), aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() g_1 <- ggplot(iteraciones, aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() g_2 <- ggplot(iteraciones %>% filter(iter_num > 10), aes(x = theta_1, y = theta_2)) + geom_path(alpha = 0.3) + geom_point() + geom_abline(colour = "red") + geom_point(data= tibble(theta_1=1/20, theta_2=1/20), colour = "red", size = 5) g_1 + g_2 Notamos el dado de Cheesex no es consistente con 1/20 de tiros de 20s, pero el dado de GameScience sí lo es. De este gráfica vemos que Cheesex está sesgado hacia abajo, así que deberíamos escoger el dado de GameScience Podemos ver directamente cómo se distribuye la diferencia \\(\\theta_1 - \\theta_2\\). Cualquier estadística es fácil de evaluar, pues simplemente la calculamos para cada simulación y después resumimos: iteraciones <- iteraciones %>% mutate(dif = theta_1 - theta_2) ggplot(iteraciones %>% filter(iter_num > 10), aes(x = dif)) + geom_histogram(bins = 100) + geom_vline(xintercept = 0, colour = "red") Y vemos que es altamente probable que el dado de Cheesex produce más 20’s que el dado de GameScience. iteraciones %>% mutate(theta_1_mayor = dif > 0) %>% summarise(prob_theta_1_mayor = mean(theta_1_mayor)) ## # A tibble: 1 × 1 ## prob_theta_1_mayor ## <dbl> ## 1 0.0215 Finalmente, verificamos nuestro modelo y cuánto aprendimos. Podemos hacerlo simulando de la inicial y comparando con la posterior: inicial_tbl <- tibble(theta_1 = rbeta(20000, 100, 1900), theta_2 = rbeta(20000, 100, 1900), dist = "inicial") posterior_tbl <- iteraciones %>% filter(iter_num > 10) %>% mutate(dist = "posterior") sims_tbl <- bind_rows(inicial_tbl, posterior_tbl) ggplot(sims_tbl, aes(x = theta_1, y = theta_2, colour = dist)) + geom_point(alpha = 0.2) donde vemos que el resultado que obtuvimos es razonablemente consistente con nuestra información inicial, y las 10 mil tiradas de dado fueron altamente informativas. ¿Qué crees que pasaría si sólo hubieramos tirado 40 veces cada dado? ¿Qué tanto habríamos aprendido? Puedes usar datos simulados y repetir este ejercicio. Puedes examinar los resultados para cada cara con los datos originales. Un modelo apropiado es el Dirichlet-Multinomial. Ejemplo: Modelo normal no conjugado Retomemos el caso de observaciones normales, supongamos que tenemos una muestra \\(X_1,...,X_n\\) de observaciones independientes e identicamente distribuidas, con \\(X_i \\sim \\mathsf{N}(\\mu, \\sigma^2)\\). Usaremos iniciales distintas al modelo anterior: \\[p(\\mu, \\sigma^2) = p(\\sigma^2)p(\\mu)\\] con \\(\\mu\\) \\(\\mathsf{N}(\\mu_0, \\sigma_0)\\) y \\(\\tau = 1/\\sigma^2\\) con distribución \\(\\mathsf{Gamma}(a,b)\\). Esto no nos da el modelo conjugado que vimos antes (nota la diferencia de la especificación de la inicial conjunta). Comenzamos por escribir \\[p(\\mu, \\sigma^2|x) \\propto \\frac{1}{{\\sigma^{n/2}}} \\exp(-\\sum\\frac{(x_i-\\mu)²}{2\\sigma^2}) \\exp(- \\frac{(\\mu - \\mu_0)^2}{2\\sigma_0^2}) \\frac{1}{(\\sigma^2)^{a + 1}}\\exp (-\\beta/\\sigma^2 )\\] Comenzamos analizando \\(p(\\mu|\\sigma^2, x)\\). Por la ecuación de arriba, e ignorando los términos que no dependen de \\(\\mu\\): \\[p(\\mu|\\sigma^2, x) \\propto \\exp [ - \\sum_i (\\frac{(\\mu - x_i)^2}{2\\sigma^2} - \\frac{(\\mu - \\mu_0)^2}{2n\\sigma_0^2})]\\] que es una distribución normal (completa cuadrados): \\[\\mu|\\sigma^2,x \\sim \\mathsf{N}\\bigg(\\frac{\\sigma^2}{\\sigma^2 + n\\sigma_0^2}\\mu_0 + \\frac{n\\sigma_0^2}{\\sigma^2 + n \\sigma_0^2}\\bar{x}, \\frac{\\sigma \\sigma_0}{\\sqrt{\\sigma^2 + n\\sigma_0^2}}\\bigg)\\] Ahora consideramos \\(p(\\sigma^2|mu,x)\\). Ignoramos en \\(p(\\mu,\\sigma^2|x)\\) los términos que *no** dependen de \\(\\sigma^2\\): \\[p(\\sigma^2|\\mu, x) \\propto \\frac{1}{\\sigma^{n/2}} \\exp(-\\sum\\frac{(x_i-\\mu)²}{2\\sigma^2}) \\frac{1}{(\\sigma^2)^{a + 1}}\\exp (-\\beta/\\sigma^2)\\] que simplificando da \\[ = \\frac{1}{\\sigma^{n/2 + a + 1}}\\exp( -\\frac{\\beta +\\frac{1}{2}\\sum(x_i - \\mu)^2}{\\sigma^2} )\\] de modo que \\[\\sigma^2|\\mu, x \\sim \\mathsf{GI}(a +n/2, b + \\frac{1}{2}\\sum(x_i -\\mu)^2)\\] Ejemplo Usaremos este muestreador para el problema de la estaturas de los tenores. Comenzamos definiendo las distribuciones iniciales: \\(\\mu \\sim \\mathsf{N}(175, 3)\\) \\(\\tau = 1/\\sigma^2 \\sim \\mathsf{GI}(3, 150)\\), esto es \\(a = 3\\) y \\(b = 150\\). Escribimos el muestreador de Gibbs. n <- 20 x <- cantantes$estatura_cm m <- 175; sigma_0 <- 3; alpha <- 3; beta <- 150 # parámetros de iniciales pasos <- 20000 iteraciones <- matrix(0, nrow = pasos + 1, ncol = 2) # vector guardará las simulaciones iteraciones[1, 1] <- 0 # valor inicial media colnames(iteraciones) <- c("mu", "sigma") # Generamos la caminata aleatoria for (j in seq(2, pasos, 2)) { # sigma^2 mu <- iteraciones[j - 1, "mu"] a <- n / 2 + alpha b <- sum((x - mu) ^ 2) / 2 + beta iteraciones[j, "sigma"] <- sqrt(1/rgamma(1, a, b)) # Actualizar sigma iteraciones[j, "mu"] <- iteraciones[j-1, "mu"] # mu sigma <- iteraciones[j, "sigma"] media <- (n * sigma_0^2 * mean(x) + sigma^2 * m) / (n * sigma_0^2 + sigma^2) varianza <- sigma^2 * sigma_0^2 / (n * sigma_0^2 + sigma^2) iteraciones[j+1, "mu"] <- rnorm(1, media, sd = sqrt(varianza)) # actualizar mu iteraciones[j+1, "sigma"] <- iteraciones[j, "sigma"] } caminata <- data.frame(pasos = 1:pasos, mu = iteraciones[1:pasos, "mu"], sigma = iteraciones[1:pasos, "sigma"]) caminata_g <- caminata %>% gather(parametro, val, mu, sigma) %>% arrange(pasos) Veamos primero algunos pasos: ggplot(filter(caminata, pasos > 1000, pasos< 1010), aes(x = mu, y = sigma)) + geom_path(alpha = 0.3) + geom_point() Donde vemos cómo en cada iteración se actualiza un solo parámetro. Una alternativa es conservar únicamente ciclos completos de la caminata u esto es lo que hacen varios programas que implementan Gibbs, sin embargo ambas cadenas (cadenas completas y conservando únicamente ciclos completos) convergen a la misma distribución posterior. Si tomamos iteraciones completas: ggplot(filter(caminata, pasos > 1000, pasos< 1020, pasos %% 2 == 0), aes(x = mu, y = sigma)) + geom_path(alpha = 0.3) + geom_point() Y ahora vemos cómo se ven las simulaciones: ggplot(filter(caminata, pasos > 1000, pasos< 10000, pasos %% 2 == 0), aes(x = mu, y = sigma)) + geom_point(alpha = 0.1) Y el diagnóstico de cada cadena: ggplot(filter(caminata_g, pasos > 15000), aes(x = pasos, y = val)) + geom_path(alpha = 0.3) + facet_wrap(~parametro, ncol = 1, scales = "free") + scale_y_continuous("") Estas cadenas parecen estar mezclando bien. Podemos resumirlas: ggplot(filter(caminata_g, pasos > 5000), aes(x = val)) + geom_histogram(fill = "gray") + facet_wrap(~parametro, ncol = 1, scales = "free") caminata_g %>% filter(pasos > 1000) %>% # eliminamos la etapa de calentamiento group_by(parametro) %>% summarise( mean(val), sd(val), median(val) ) %>% mutate(across(is_double, round, 2)) ## # A tibble: 2 × 4 ## parametro `mean(val)` `sd(val)` `median(val)` ## <chr> <dbl> <dbl> <dbl> ## 1 mu 176. 1.32 176. ## 2 sigma 6.54 0.95 6.44 Y obtenemos un resultado similar a los anteriores. Conclusiones y observaciones Metrópolis y Gibbs Una generalización del algoritmo de Metrópolis es Metrópolis-Hastings. El algoritmo de Metrópolis es como sigue: Generamos un punto inicial tal que \\(p(\\theta)>0\\). Para \\(i = 1,2,...\\) Se propone un nuevo valor \\(\\theta^*\\) con una distribución propuesta \\(g(\\theta^*|\\theta^{(i)})\\) es común que \\(g(\\theta^*|\\theta^{(i)})\\) sea una normal centrada en \\(\\theta^{(i)}\\). Calculamos la probabilidad de aceptación \\[\\alpha=\\min\\bigg\\{\\frac{p(\\theta^*)}{p(\\theta^{(i)})},1\\bigg\\},\\] y aceptamos \\(\\theta^*\\) con probabilidad \\(p_{mover}\\). Es así que el algorito requiere que podamos calcular el cociente en \\(p_{mover}\\) para todo \\(\\theta^{(i)}\\) y \\(\\theta^*\\), así como simular de la distribución propuesta \\(g(\\theta^*|\\theta^{(i)})\\), adicionalmente debemos poder generar valores uniformes para decidir si aceptar/rechazar. En el caso de Metrópolis un requerimiento adicional es que la distribución propuesta \\(g(\\theta_{a}|\\theta_b)\\) debe ser simétrica, es decir \\(g(\\theta_{a}|\\theta_b) = g(\\theta_{b}|\\theta_a)\\) para todo \\(\\theta_{a}\\), \\(\\theta_{b}\\). Metrópolis-Hastings generaliza Metrópolis, eliminando la restricción de simetría en la distribución propuesta \\(g(\\theta_{a}|\\theta_b)\\), sin embargo para corregir por esta asimetría debemos calcular \\(\\alpha\\) como sigue: \\[\\alpha=\\min\\bigg\\{ \\frac{p(\\theta^*)}{g(\\theta^*|\\theta^{(i)})} \\cdot \\frac{g(\\theta^{(i)}|\\theta^*)}{p(\\theta^{(i)})},1\\bigg\\}\\] La generalización de Metrópolis-Hastings puede resultar en algoritmos más veloces. Se puede ver Gibbs como una generalización de Metrópolis-Hastings, cuando estamos actualizando un componente de los parámetros, la distribución propuesta es la distribución posterior para ese parámetro, por tanto siempre es aceptado. Comparado con Metrópolis, Gibbs tiene la ventaja de que no se necesita afinar los parámetros de una distribución propuesta (o seleccionar siquiera una distribución propuesta). Además que no hay pérdida de simulaciones debido a rechazo. Por su parte, la desventaja debemos conocer las distribuciones condicionales y poder simular de ellas. En el caso de modelos complicados se utilizan combinaciones de Gibbs y Metrópolis. Cuando se consideran estos dos algoritmos Gibbs es un método más simple y es la primera opción para modelos condicionalmente conjugados. Sí solo podemos simular de un subconjunto de las distribuciones condicionales posteriores, entonces podemos usar Gibbs siempre que se pueda y Metrópolis unidimensional para el resto, o de manera más general separamos en bloques, un bloque se actualiza con Gibbs y otro con Metrópolis. El algoritmo de Gibbs puede atorarse cuando hay correlación alta entre los parámetros, reparametrizar puede ayudar, o se pueden usar otros algoritmos. JAGS (Just Another Gibbs Sampler), WinBUGS y OpenBUGS son programas que implementan métodos MCMC para generar simulaciones de distribuciones posteriores. Los paquetes rjags y R2jags permiten ajustar modelos en JAGS desde R. Es muy fácil utilizar estos programas pues uno simplemente debe especificar las distribuciones iniciales, la verosimilitud y los datos observados. Para aprender a usar JAGS se puede revisar la sección correspondiente en las notas de 2018, ahora nos concentraremos en el uso de Stan. HMC y Stan It appears to be quite a general principle that, whenever there is a randomized way of doing something, then there is a nonrandomized way that delivers better performance but requires more thought. -E.T. Jaynes Stan es un programa para generar muestras de una distribución posterior de los parámetros de un modelo, el nombre del programa hace referencia a Stanislaw Ulam (1904-1984) que fue pionero en los métodos de Monte Carlo. A diferencia de JAGS y BUGS, los pasos de la cadena de Markov se generan con un método llamado Monte Carlo Hamiltoniano (HMC). HMC es computacionalmente más costoso que Metrópolis o Gibbs, sin embargo, sus propuestas suelen ser más eficientes, y por consiguiente no necesita muestras tan grandes. En particular cuando se ajustan modelos grandes y complejos (por ejemplo, con variables con correlación alta) HMC supera a otros. Diagnósticos generales para MCMC Cuando generamos una muestra de la distribución posterior usando MCMC, sin importar el método (Metrópolis, Gibbs, HMC), buscamos que: Los valores simulados sean representativos de la distribución posterior. Esto implica que no deben estar influenciados por el valor inicial (arbitrario) y deben explorar todo el rango de la posterior, con suficientes retornos para evaluar cuánta masa hay en cada región. Debemos tener suficientes simulaciones de tal manera que las estimaciones sean precisas y estables. Queremos tener un método eficiente para generar las simulaciones. En la práctica intentamos cumplir lo más posible estos objetivos, pues aunque en principio los métodos MCMC garantizan que una cadena infinitamente larga logrará una representación perfecta, siempre debemos tener un criterio para cortar la cadena y evaluar la calidad de las simulaciones. Representatividad Burn-in e iteraciones iniciales- En primer lugar, en muchas ocasiones las condiciones iniciales de las cadenas están en partes del espacio de parámetros que son “atípicos” en términos de la posterior. Así que es común quitar algunas observaciones iniciales (iteraciones de burn-in) para minimizar su efecto en resúmenes posteriores. Por ejemplo, para el ejemplo de los cantantes, podemos ver que las iteraciones iniciales tienen como función principal llegar a las regiones de probabilidad posterior alta: log_p <- crear_log_posterior_norm(cantantes$estatura_cm, mu_0, n_0, a, b) log_post <- function(pars) { log_p(pars[1], pars[2]) } set.seed(823) metro_normal <- crear_metropolis(log_post, sigma_salto = 0.5) sim_tbl <- metro_normal(c(mu = 162, sigma = 1), 5000) ggplot(sim_tbl %>% filter(iter_num < 500), aes(x = mu, y = sigma)) + geom_path(alpha = 0.5) + geom_point(aes(colour = iter_num)) De modo que puede ser buena idea eliminar las primeras iteraciones. En teoría, no es necesario hacer esto si hacemos suficientes iteraciones, pues la cadena va a terminar en su estado estable explorando la posterior. En la práctica, y con pocas iteraciones, puede ayudar un poco a mejorar la precisión numérica de las cantidades que queramos calcular. sim_g <- sim_tbl %>% pivot_longer(-iter_num, names_to = "parametro", values_to = "valor") todas <- ggplot(sim_g, aes(x = iter_num, y = valor)) + geom_line(alpha = 0.5) + facet_wrap(~ parametro, ncol = 1, scales = "free_y") + labs(subtitle = "Todas las simulaciones") sin_burnin <- sim_g %>% filter(iter_num > 200) %>% ggplot(aes(x = iter_num, y = valor)) + geom_line(alpha = 0.5) + facet_wrap(~ parametro, ncol = 1, scales = "free_y") + labs(subtitle = "Quitando 200 de burn-in") todas + sin_burnin Convergencia a estado límite. Para determinar la convergencia es conveniente realizar más de una cadena: buscamos ver si realmente se ha olvidado el estado inicial, si las distribuciones de cada cadena son consistentes unas con otras, y revisar que algunas cadenas no hayan quedado atoradas en regiones inusuales del espacio de parámetros. Inicializamos las cadenas con valores al azar en rangos razonables (por ejemplo simulando de la inicial): set.seed(8513) valores_iniciales <- tibble(mu_0 = rnorm(4, 160, 20), sigma_0 = runif(4, 0, 20), cadena = 1:4) sims_tbl <- valores_iniciales %>% mutate(sims = map2(mu_0, sigma_0, ~ metro_normal(c(mu = .x, sigma = .y), 300) )) %>% unnest(sims) ggplot(sims_tbl, aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() Y este es un ejemplo donde claramente las cadenas no han alcanzado un estado estable: tienen muy distintas medias y varianzas. Por ejemplo: set.seed(83243) sims_tbl <- valores_iniciales %>% mutate(sims = map2(mu_0, sigma_0, ~ metro_normal(c(mu = .x, sigma = .y), 20000) )) %>% unnest(sims) ggplot(sims_tbl, aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() Y este resultado se ve mejor. La parte transición hacia las zonas de alta probabilidad pasa antes de unas 1000 iteraciones. Podemos hacer más simulaciones, o eliminar como burn-in las primiras iteraciones: media_g <- ggplot(sims_tbl %>% filter(iter_num > 2000), aes(x = iter_num, y = mu, colour = factor(cadena))) + geom_line() sigma_g <- ggplot(sims_tbl %>% filter(iter_num > 2000), aes(x = iter_num, y = sigma, colour = factor(cadena))) + geom_line() media_g / sigma_g Las gráficas anteriores nos ayudan a determinar si elegimos un periodo de calentamiento adecuado o si alguna cadena está alejada del resto. Una vez que las cadenas están en estado estable, podemos usar todas las simulaciones juntas para resumir: head(sims_tbl) ## # A tibble: 6 × 6 ## mu_0 sigma_0 cadena iter_num mu sigma ## <dbl> <dbl> <int> <int> <dbl> <dbl> ## 1 155. 3.16 1 1 155. 3.16 ## 2 155. 3.16 1 2 155. 3.16 ## 3 155. 3.16 1 3 155. 3.16 ## 4 155. 3.16 1 4 155. 3.16 ## 5 155. 3.16 1 5 155. 3.50 ## 6 155. 3.16 1 6 155. 3.81 # medias posteriores sims_tbl %>% summarise(mu = mean(mu), sigma = mean(sigma)) ## # A tibble: 1 × 2 ## mu sigma ## <dbl> <dbl> ## 1 176. 6.77 Además de realizar gráficas podemos usar la medida de convergencia \\(\\hat{R}\\). La medida \\(\\hat{R}\\) se conoce como el factor de reducción potencial de escala o diagnóstico de convergencia de Gelman-Rubin, esta es una estimación de la posible reducción en la longitud de un intervalo de confianza si las simulaciones continuaran infinitamente. \\(\\hat{R}\\) es aproximadamente la raíz cuadrada de la varianza de todas las cadenas juntas dividida entre la varianza dentro de cada cadena. Si \\(\\hat{R}\\) es mucho mayor a 1 esto indica que las cadenas no se han mezclado bien. Una regla usual es iterar hasta alcanzar un valor \\(\\hat{R} \\leq 1.1\\) para todos los parámetros. \\[\\hat{R} \\approx \\sqrt{\\frac{\\hat{V}}{W}}\\] donde \\(B\\) es la varianza entre las cadenas, \\(W\\) es la varianza dentro de las cadenas \\[B = \\frac{N}{M-1}\\sum_m (\\hat{\\theta}_m - \\hat{\\theta})^2\\] \\[W = \\frac{1}{M}\\sum_m \\hat{\\sigma}_m^2\\] Y \\(\\hat{V}\\) es una estimación del varianza de posterior de \\(\\theta\\): \\[\\hat{V} = \\frac{N-1}{N}W + \\frac{M+1}{MN}B\\] #### Ejemplo {-} En nuestro ejemplo anterior, tenemos sims_tbl %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(media = mean(valor), num = n(), sigma2 = var(valor)) %>% summarise(N = first(num), M = n_distinct(cadena), B = N * var(media), W = mean(sigma2), V_hat = ((N - 1) / N) * W + (M + 1)/(M * N) * B, R_hat = sqrt(V_hat / W)) ## # A tibble: 2 × 7 ## parametro N M B W V_hat R_hat ## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> ## 1 mu 20000 4 1281. 4.29 4.37 1.01 ## 2 sigma 20000 4 121. 1.31 1.32 1.00 Y verificamos que los valores de \\(\\hat{R}\\) son cercanos a uno, lo cual indica que este diagnóstico es aceptable. Si hubiéramos trabajado con las primeras 300 iteraciones sims_tbl %>% filter(iter_num < 300) %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(media = mean(valor), num = n(), sigma2 = var(valor)) %>% summarise(N = first(num), M = n_distinct(cadena), B = N * var(media), W = mean(sigma2), V_hat = ((N - 1) / N) * W + (M + 1)/(M * N) * B, R_hat = sqrt(V_hat / W)) ## # A tibble: 2 × 7 ## parametro N M B W V_hat R_hat ## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> ## 1 mu 299 4 32334. 40.4 175. 2.08 ## 2 sigma 299 4 7394. 11.9 42.8 1.89 Y estos valores indican problemas en la convergencia de las cadenas. Es necesario diagnosticar el problema, que en este caso resolvemos incrementando el número de iteraciones. Precisión Una vez que tenemos una muestra representativa de la distribución posterior, nuestro objetivo es asegurarnos de que la muestra es lo suficientemente grande para producir estimaciones estables y precisas de la distribución. Para ello usaremos el tamaño efectivo de muestra, Si las simulaciones fueran independientes \\(N_{eff}\\) sería el número total de simulaciones; sin embargo, las simulaciones de MCMC suelen estar correlacionadas, de modo que cada iteración de MCMC es menos informativa que si fueran independientes. Ejemplo: Si graficaramos simulaciones independientes, esperaríamos valores de autocorrelación chicos: acf(rgamma(1000,1,1)) Sin embargo, los valores que simulamos tienen el siguiente perfil de autocorrelación: sigma_metro_sims <- sims_tbl %>% filter(cadena==4) %>% pull(mu) acf(sigma_metro_sims) El tamaño efectivo de muestra nos dice qué tamaño de muestra de observaciones independientes nos daría la misma información que las simulaciones de la cadena. Una manera de manera relativamente simple de estimarlo es: \\[N_{eff} = \\frac{N}{1+2\\sum_{k=1}^\\infty ACF(k)} \\] Usualmente nos gustaría obtener un tamaño efectivo de al menos \\(100\\) (para cálculo de medias y varianzas posteriores). Esta cantidad usualmente se reporta en el software (con mejores estimaciones que la de la fórmula de arriba), y es necesario checarlo. En nuestro ejemplo hacemos una aproximación como sigue: calc_acf <- function(x){ valores_acf <- acf(x, lag.max = 1000, plot = FALSE)$acf %>% as.numeric() valores_acf[-1] } acf_tbl <- sims_tbl %>% pivot_longer(mu:sigma, names_to = "parametro", values_to = "valor") %>% group_by(parametro, cadena) %>% summarise(N = n_distinct(iter_num), k = 1:1000, acf = calc_acf(valor)) %>% summarise(N = first(N), N_eff = N / (1 + 2 * sum(acf))) acf_tbl ## # A tibble: 8 × 4 ## # Groups: parametro [2] ## parametro cadena N N_eff ## <chr> <int> <int> <dbl> ## 1 mu 1 20000 251. ## 2 mu 2 20000 700. ## 3 mu 3 20000 104. ## 4 mu 4 20000 394. ## 5 sigma 1 20000 421. ## 6 sigma 2 20000 411. ## 7 sigma 3 20000 93.9 ## 8 sigma 4 20000 724. Nótese que algunas cadenas tienen un tamaño efectivo de muestra relativamente bajo para el número de iteraciones que hicimos. De cualquier forma, el agregado sobre todas las cadenas es suficientemente grande para calcular resúmenes básicos: acf_tbl %>% group_by(parametro) %>% summarise(N = sum(N), N_eff = sum(N_eff)) ## # A tibble: 2 × 3 ## parametro N N_eff ## <chr> <int> <dbl> ## 1 mu 80000 1450. ## 2 sigma 80000 1650. Sin embargo, podemos hacer más simulaciones si es necesario, por ejemplo para aproximar de manera apropiada percentiles en las colas. Eficiencia Hay varias maneras para mejorar la eficiencia de un proceso MCMC: Paralelizar, no disminuimos el número de pasos en las simulaciones pero podemos disminuir el tiempo que tarda en correr. Cambiar la parametrización del modelo o transformar los datos. Adelgazar la muestra cuando tenemos problemas de uso de memoria, consiste en guardar únicamente los \\(k\\)-ésimos pasos de la cadena y resulta en cadenas con menos autocorrelación . Recomendaciones generales Gelman and Hill (2006) recomienda los siguientes pasos cuando uno esta simulando de la posterior: Cuando definimos un modelo por primera vez establecemos un valor bajo para el número de iteraciones. La razón es que la mayor parte de las veces los modelos no funcionan a la primera por lo que sería pérdida de tiempo dejarlo correr mucho tiempo antes de descubrir el problema. Si las simulaciones no han alcanzado convergencia aumentamos las iteraciones a \\(500\\) ó \\(1000\\) de tal forma que las corridas tarden segundos o unos cuantos minutos. Si tarda más que unos cuantos minutos (para problemas del tamaño que veremos en la clase) y aún así no alcanza convergencia entonces juega un poco con el modelo (por ejemplo intenta transformaciones lineales), para JAGS Gelman sugiere más técnicas para acelerar la convergencia en el capitulo \\(19\\) del libro Data Analysis Using Regression and Multilevel/Hierarchical models. En el caso de Stan veremos ejemplos de reparametrización, y se puede leer más en la guía. Otra técnica conveniente cuando se trabaja con bases de datos grandes (sobre todo en la parte exploratoria) es trabajar con un subconjunto de los datos, quizá la mitad o una quinta parte. Referencias "],["apéndice-principios-de-visualizacion.html", "Apéndice: Principios de visualizacion Introducción Visualización popular de datos Teoría de visualización de datos Ejemplo: gráfica de Minard", " Apéndice: Principios de visualizacion “The simple graph has brought more information to the data analyst’s mind than any other device.” — John Tukey El cuarteto de Anscombe En 1971 un estadístico llamado Frank Anscombe (fundador del departamento de Estadística de la Universidad de Yale) publicó cuatro conjuntos de dato. Cada uno consiste de 11 observaciones. La peculariedad de estos conjuntos es que tienen las mismas propiedades estadísticas. Sin embargo, cuando analizamos los datos de manera gráfica en un histograma encontramos rápidamente que los conjuntos de datos son muy distintos. Media de \\(x\\): 9 Varianza muestral de \\(x\\): 11 Media de \\(y\\): 7.50 Varianza muestral de \\(y\\): 4.12 Correlación entre \\(x\\) y \\(y\\): 0.816 Línea de regresión lineal: \\(y = 3.00 + 0.500x\\) En la gráfica del primer conjunto de datos, se ve clara una relación lineal simple con un modelo que cumple los supuestos de normalidad. La segunda gráfica (arriba a la derecha) muestra unos datos que tienen una asociación pero definitivamente no es lineal. En la tercera gráfica (abajo a la izquierda) están puntos alineados perfectamente en una línea recta, excepto por uno de ellos. En la última gráfica podemos ver un ejemplo en el cual basta tener una observación atípica para que se produzca un coeficiente de correlación alto aún cuando en realidad no existe una asociación lineal entre las dos variables. El cuarteto de Ascombe inspiró una técnica reciente para crear datos que comparten las mismas propiedades estadísticas al igual que en el cuarteto, pero que producen gráficas muy distintas (Matejka, Fitzmaurice). Introducción La visualización de datos no trata de hacer gráficas “bonitas” o “divertidas”, ni de simplificar lo complejo o ayudar a una persona “que no entiende mucho” a entender ideas complejas. Más bien, trata de aprovechar nuestra gran capacidad de procesamiento visual para exhibir de manera clara aspectos importantes de los datos. El siguiente ejemplo de (Tufte 2006), ilustra claramente la diferencia entre estos dos enfoques. A la izquierda están gráficas (más o menos típicas de Powerpoint) basadas en la filosofía de simplificar, de intentar no “ahogar” al lector con datos. El resultado es una colección incoherente, de bajo contenido, que no tiene mucho qué decir y que es, “indeferente al contenido y la evidencia”. A la derecha está una variación del rediseño de Tufte en forma de tabla, que en este caso particular es una manera eficiente de mostrar claramente los patrones que hay en este conjunto simple de datos. ¿Qué principios son los que soportan la efectividad de esta tabla sobre la gráfica de la derecha? Veremos que hay dos conjuntos de principios importantes: unos relacionados con el diseño y otros con la naturaleza del análisis de datos, independientemente del método de visualización. Visualización popular de datos Publicaciones populares (periódicos, revistas, sitios internet) muchas veces incluyen visualización de datos como parte de sus artículos o reportajes. En general siguen el mismo patrón que en la visión tradicionalista de la estadística: sirven más para divertir que para explicar, tienden a explicar ideas simples y conjuntos chicos de datos, y se consideran como una “ayuda” para los “lectores menos sofisticados”. Casi siempre se trata de gráficas triviales (muchas veces con errores graves) que no aportan mucho a artículos que tienen un nivel de complejidad mucho mayor (es la filosofía: lo escrito para el adulto, lo graficado para el niño). Teoría de visualización de datos Existe teoría fundamentada acerca de la visualización. Después del trabajo pionero de Tukey, los principios e indicadores de Tufte se basan en un estudio de la historia de la graficación y ejercicios de muestreo de la práctica gráfica a lo largo de varias disciplinas (¿cuáles son las mejores gráficas? ¿por qué?) El trabajo de Cleveland es orientado a la práctica del análisis de datos (¿cuáles gráficas nos han ayudado a mostrar claramente los resultados del análisis?), por una parte, y a algunos estudios de percepción visual. En resumen, hablaremos de las siguientes guías: Principios generales del diseño analítico Aplicables a una presentación o análisis completos, y como guía para construir nuevas visualizaciones (Tufte 2006). Principio 1. Muestra comparaciones, contrastes, diferencias. Principio 2. Muestra causalidad, mecanismo, explicación, estructura sistemática. Principio 3. Muestra datos multivariados, es decir, más de una o dos variables. Principio 4. Integra palabras, números, imágenes y diagramas. Principio 5. Describe la totalidad de la evidencia. Muestra fuentes usadas y problemas relevantes. Principio 6. Las presentaciones analíticas, a fin de cuentas, se sostienen o caen dependiendo de la calidad, relevancia e integridad de su contenido. Técnicas de visualización Esta categoría incluye técnicas específicas que dependen de la forma de nuestros datos y el tipo de pregunta que queremos investigar (Tukey (1977), William S. Cleveland (1993), W. S. Cleveland (1994), Tufte (2006)). Tipos de gráficas: cuantiles, histogramas, caja y brazos, gráficas de dispersión, puntos/barras/ líneas, series de tiempo. Técnicas para mejorar gráficas: Transformación de datos, transparencia, vibración, banking 45, suavizamiento y bandas de confianza. Pequeños múltiplos Indicadores de calidad gráfica Aplicables a cualquier gráfica en particular. Estas son guías concretas y relativamente objetivas para evaluar la calidad de una gráfica (Tufte 1986). Integridad Gráfica. El factor de engaño, es decir, la distorsión gráfica de las cantidades representadas, debe ser mínimo. Chartjunk. Minimizar el uso de decoración gráfica que interfiera con la interpretación de los datos: 3D, rejillas, rellenos con patrones. Tinta de datos. Maximizar la proporción de tinta de datos vs. tinta total de la gráfica. For non-data- ink, less is more. For data-ink, less is a bore. Densidad de datos. Las mejores gráficas tienen mayor densidad de datos, que es la razón entre el tamaño del conjunto de datos y el área de la gráfica. Las gráficas se pueden encoger mucho. Percepción visual. Algunas tareas son más fáciles para el ojo humano que otras (W. S. Cleveland 1994). Factor de engaño y Chartjunk El factor de engaño es el cociente entre el efecto mostrado en una gráfica y el efecto correspondiente en los datos. Idealmente, el factor de engaño debe ser 1 (ninguna distorsión). El chartjunk son aquellos elementos gráficos que no corresponden a variación de datos, o que entorpecen la interpretación de una gráfica. Estos son los indicadores de calidad más fáciles de entender y aplicar, y afortunadamente cada vez son menos comunes. Un diseño popular que califica como chartjunk y además introduce factores de engaño es el pie de 3D. En la gráfica de la derecha, podemos ver como la rebanada C se ve más grande que la rebanada A, aunque claramente ese no es el caso (factor de engaño). La razón es la variación en la perspectiva que no corresponde a variación en los datos (chartjunk). Crítica gráfica: Gráfica de pie Todavía elementos que pueden mejorar la comprensión de nuestra gráfica de pie: se trata de la decodificiación que hay que hacer categoría - color - cuantificación. Podemos agregar las etiquetas como se muestra en la serie de la derecha, pero entonces: ¿por qué no mostrar simplemente la tabla de datos? ¿qué agrega el pie a la interpretación? La deficiencias en el pie se pueden ver claramente al intentar graficar más categorías (13) . En el primer pie no podemos distinguir realmente cuáles son las categorías grandes y cuáles las chicas, y es muy difícil tener una imagen mental clara de estos datos. Agregar los porcentajes ayuda, pero entonces, otra vez, preguntamos cuál es el propósito del pie. La tabla de la izquierda hace todo el trabajo (una vez que ordenamos las categrías de la más grande a la más chica). Es posible hacer una gráfica de barras como la de abajo a la izquierda. Hay otros tipos de chartjunk comunes: uno es la textura de barras, por ejemplo. El efecto es la producción de un efecto moiré que es desagradable y quita la atención de los datos, como en la gráfica de barras de abajo. Otro común son las rejillas, como mostramos en las gráficas de la izquierda. Nótese como en estos casos hay efectos ópticos no planeados que degradan la percepción de los patrones en los datos. Pequeños múltiplos y densidad gráfica La densidad de una gráfica es el tamaño del conjunto de datos que se grafica comparado con el área total de la gráfica. En el siguiente ejemplo, graficamos en logaritmo-10 de millones de cabezas de ganado en Francia (cerdos, res, ovejas y caballos). La gráfica de la izquierda es pobre en densidad pues sólo representa 4 datos. La manera más fácil de mejorar la densidad es hacer más chica la gráfica: La razón de este encogimiento es una que tiene qué ver con las oportunidades perdidas de una gráfica grande. Si repetimos este mismo patrón (misma escala, mismos tipos de ganado) para distintos países obtenemos la siguiente gráfica: Esta es una gráfica de puntos. Es útil como sustituto de una gráfica de barras, y es superior en el sentido de que una mayor proporción de la tinta que se usa es tinta de datos. Otra vez, mayor proporción de tinta de datos representa más oportunidades que se pueden capitalizar. Más pequeños múltiplos Los pequeños múltiplos presentan oportunidades para mostrar más acerca de nuestro problema de interés. Consideramos por ejemplo la relación de radiación solar y niveles de ozono: En el ejemplo anterior incluyendo una variable adicional (velocidad del viento) podemos entender más acerca de la relación de radiación solar y niveles de ozono: Tinta de datos Maximizar la proporción de tinta de datos en nuestras gráficas tiene beneficios inmediatos. La regla es: si hay tinta que no representa variación en los datos, o la eliminación de esa tinta no representa pérdidas de significado, esa tinta debe ser eliminada. El ejemplo más claro es el de las rejillas en gráficas y tablas: ¿Por qué usar grises en lugar de negros? La respuesta tiene qué ver con el principio de tinta de datos: si marcamos las diferencias sutil pero claramente, tenemos más oportunidades abiertas para hacer énfasis en lo que nos interesa: a una gráfica o tabla saturada no se le puede hacer más - es difícil agregar elementos adicionales que ayuden a la comprensión. Si comenzamos marcando con sutileza, entonces se puede hacer más. Los mapas geográficos son un buen ejemplo de este principio. El espacio en blanco es suficientemente bueno para indicar las fronteras en una tabla, y facilita la lectura: Para un ejemplo del proceso de rediseño de una tabla, ver aquí. Finalmente, podemos ver un ejemplo que intenta incorporar los elementos del diseño analítico, incluyendo pequeños múltiplos: Decoración Percepción de escala Entre la percepción visual y la interpretación de una gráfica están implícitas tareas visuales específicas que las personas debemos realizar para ver correctamente la gráfica. En la década de los ochenta, William S. Cleveland y Robert McGill realizaron algunos experimentos identificando y clasificando estas tareas para diferentes tipos de gráficos (William S. Cleveland and McGill 1984). En estos, se le pregunta a la persona que compare dos valores dentro de una gráfica, por ejemplo, en dos barras en una gráfica de barras, o dos rebanadas de una gráfica de pie. Los resultados de Cleveland y McGill fueron replicados por Heer y Bostock en 2010 y los resultados se muestran en las gráficas de la derecha: Ejemplo: gráfica de Minard Concluimos esta sección con una gráfica que, aunque poco común, ejemplifica los principios de una buena gráfica, y es reconocida como una de las mejores visualizaciones de la historia. Una gráfica excelente, presenta datos interesantes de forma bien diseñada: es una cuestión de fondo, de diseño, y estadística… [Se] compone de ideas complejas comunicadas con claridad, precisión y eficiencia. … [Es] lo que da al espectador la mayor cantidad de ideas, en el menor tiempo, con la menor cantidad de tinta, y en el espacio más pequeño. … Es casi siempre multivariado. … Una excelente gráfica debe decir la verdad acerca de los datos. (Tufte, 1983) La famosa visualización de Charles Joseph Minard de la marcha de Napoleón sobre Moscú, ilustra los principios de una buena gráfica. Tufte señala que esta imagen “bien podría ser el mejor gráfico estadístico jamás dibujado”, y sostiene que “cuenta una historia rica y coherente con sus datos multivariados, mucho más esclarecedora que un solo número que rebota en el tiempo”. Se representan seis variables: el tamaño del ejército, su ubicación en una superficie bidimensional, la dirección del movimiento del ejército y la temperatura en varias fechas durante la retirada de Moscú”. Hoy en día Minard es reconocido como uno de los principales contribuyentes a la teoría de análisis de datos y creación de infografías con un fundamento estadístico. Se grafican 6 variables: el número de tropas de Napoleón, la distancia, la temperatura, la latitud y la longitud, la dirección en que viajaban las tropas y la localización relativa a fechas específicas. La gráfica de Minard, como la describe E.J. Marey, parece “desafiar la pluma del historiador con su brutal elocuencia”, la combinación de datos del mapa, y la serie de tiempo, dibujados en 1869, “retratan una secuencia de pérdidas devastadoras que sufrieron las tropas de Napoleón en 1812”. Comienza en la izquierda, en la frontera de Polonia y Rusia, cerca del río Niemen. La línea gruesa dorada muestra el tamaño de la Gran Armada (422,000) en el momento en que invadía Rusia en junio de 1812. El ancho de esta banda indica el tamaño de la armada en cada punto del mapa. En septiembre, la armada llegó a Moscú, que ya había sido saqueada y dejada desértica, con sólo 100,000 hombres. El camino del retiro de Napoleón desde Moscú está representado por la línea oscura (gris) que está en la parte inferior, que está relacionada a su vez con la temperatura y las fechas en el diagrama de abajo. Fue un invierno muy frío, y muchos se congelaron en su salida de Rusia. Como se muestra en el mapa, cruzar el río Berezina fue un desastre, y el ejército de Napoleón logró regresar a Polonia con tan sólo 10,000 hombres. También se muestran los movimientos de las tropas auxiliaries, que buscaban proteger por atrás y por la delantera mientras la armada avanzaba hacia Moscú. La gráfica de Minard cuenta una historia rica y cohesiva, coherente con datos multivariados y con los hechos históricos, y que puede ser más ilustrativa que tan sólo representar un número rebotando a lo largo del tiempo. Referencias "],["apéndice-transformaciones.html", "Apéndice: Transformaciones", " Apéndice: Transformaciones En ocasiones es conveniente transformar los datos para el análisis, el objetivo de los ajustes es simplificar la interpretación y el análisis al eliminar fuentes de variación conocidas, también es común realizan transformaciones para simplificar los patrones. Algunos ejemplos donde eliminamos efectos conocidos: Cuando analizamos el precio de venta de las casas podemos eliminar la variación debida al tamaño de las casas al pasar de precio de venta a precio de venta por metro cuadrado. De manera similar al analizar las propinas puede convenir considerar la propina como porcentaje de la cuenta. En series de tiempo cuando los datos están relacionados con el tamaño de la población podemos ajustar a mediciones per capita (en series de tiempo PIB). También es común ajustar por inflación, o poner cantidades monetarias en valor presente. mex_dat <- global_economy |> filter(Code == "MEX") pib <- ggplot(mex_dat, aes(x = Year, y = GDP / 1e6)) + geom_line() pib_pc <- ggplot(mex_dat, aes(x = Year, y = GDP / Population)) + geom_line() pib / pib_pc Adicionalmente podemos recurrir a otras transformaciones matemáticas (e.g. logaritmo, raíz cuadrada) que simplifiquen el patrón en los datos y la interpretación. Veamos un ejemplo donde es apropiado la transformación logaritmo. Usamos los datos Animals con información de peso corporal promedio y peso cerebral promedio para 28 especies. Buscamos entender la relación entre estas dos variables, e inspeccionar que especies se desvían (residuales) del esperado. Comenzamos con un diagrama de dispersión usando las unidades originales animals_tbl <- as_tibble(Animals, rownames = "animal") p1 <- ggplot(animals_tbl, aes(x = body, y = brain, label = animal)) + geom_point() + labs(subtitle = "Unidades originales") p2 <- ggplot(animals_tbl, aes(x = body, y = brain, label = animal)) + geom_point() + xlim(0, 500) + ylim(0, 1500) + geom_text_repel() + labs(subtitle = "Unidades originales, eliminando 'grandes'") (p1 + p2) Incluso cuando nos limitamos a especies de menos de 500 kg de masa corporal, la relación no es fácil de descrubir.En la suguiente gráfica hacemos la transformación logaritmo y obtenemos una gráfica más fácil de leer, además los datos se modelarán con más facilidad. p3 <- ggplot(animals_tbl, aes(x = log(body), y = log(brain), label = animal)) + geom_smooth(method = "lm", se = FALSE, color = "red") + geom_point() + geom_text_repel() + stat_poly_eq(use_label(c("eq"))) p3 ## `geom_smooth()` using formula = 'y ~ x' La transformación logaritmo tiene también ventajas en interpretación, para diferencias chicas en escala log, las diferencias corresponden a diferencias porcentuales en la escala original, por ejempo consideremos la diferencia entre el peso en escala log de humano y borrego: 4.13 - 4.02 = 0.11. Confirmamos que el humano es aproximadamente 11% más pesado que el borrego en la escala original: 62/55.5 - 1 = 0.12 animals_tbl <- animals_tbl |> mutate(log_body = log(body), log_brain = log(brain)) animals_tbl |> filter(animal == "Human" | animal == "Sheep") |> arrange(body) |> gt::gt() |> gt::fmt_number() #ociqvanemt table { font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji'; -webkit-font-smoothing: antialiased; -moz-osx-font-smoothing: grayscale; } #ociqvanemt thead, #ociqvanemt tbody, #ociqvanemt tfoot, #ociqvanemt tr, #ociqvanemt td, #ociqvanemt th { border-style: none; } #ociqvanemt p { margin: 0; padding: 0; } #ociqvanemt .gt_table { display: table; border-collapse: collapse; line-height: normal; margin-left: auto; margin-right: auto; color: #333333; font-size: 16px; font-weight: normal; font-style: normal; background-color: #FFFFFF; width: auto; border-top-style: solid; border-top-width: 2px; border-top-color: #A8A8A8; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #A8A8A8; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; } #ociqvanemt .gt_caption { padding-top: 4px; padding-bottom: 4px; } #ociqvanemt .gt_title { color: #333333; font-size: 125%; font-weight: initial; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; border-bottom-color: #FFFFFF; border-bottom-width: 0; } #ociqvanemt .gt_subtitle { color: #333333; font-size: 85%; font-weight: initial; padding-top: 3px; padding-bottom: 5px; padding-left: 5px; padding-right: 5px; border-top-color: #FFFFFF; border-top-width: 0; } #ociqvanemt .gt_heading { background-color: #FFFFFF; text-align: center; border-bottom-color: #FFFFFF; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #ociqvanemt .gt_bottom_border { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ociqvanemt .gt_col_headings { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; } #ociqvanemt .gt_col_heading { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 6px; padding-left: 5px; padding-right: 5px; overflow-x: hidden; } #ociqvanemt .gt_column_spanner_outer { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: normal; text-transform: inherit; padding-top: 0; padding-bottom: 0; padding-left: 4px; padding-right: 4px; } #ociqvanemt .gt_column_spanner_outer:first-child { padding-left: 0; } #ociqvanemt .gt_column_spanner_outer:last-child { padding-right: 0; } #ociqvanemt .gt_column_spanner { border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: bottom; padding-top: 5px; padding-bottom: 5px; overflow-x: hidden; display: inline-block; width: 100%; } #ociqvanemt .gt_spanner_row { border-bottom-style: hidden; } #ociqvanemt .gt_group_heading { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; text-align: left; } #ociqvanemt .gt_empty_group_heading { padding: 0.5px; color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; vertical-align: middle; } #ociqvanemt .gt_from_md > :first-child { margin-top: 0; } #ociqvanemt .gt_from_md > :last-child { margin-bottom: 0; } #ociqvanemt .gt_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; margin: 10px; border-top-style: solid; border-top-width: 1px; border-top-color: #D3D3D3; border-left-style: none; border-left-width: 1px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 1px; border-right-color: #D3D3D3; vertical-align: middle; overflow-x: hidden; } #ociqvanemt .gt_stub { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; } #ociqvanemt .gt_stub_row_group { color: #333333; background-color: #FFFFFF; font-size: 100%; font-weight: initial; text-transform: inherit; border-right-style: solid; border-right-width: 2px; border-right-color: #D3D3D3; padding-left: 5px; padding-right: 5px; vertical-align: top; } #ociqvanemt .gt_row_group_first td { border-top-width: 2px; } #ociqvanemt .gt_row_group_first th { border-top-width: 2px; } #ociqvanemt .gt_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #ociqvanemt .gt_first_summary_row { border-top-style: solid; border-top-color: #D3D3D3; } #ociqvanemt .gt_first_summary_row.thick { border-top-width: 2px; } #ociqvanemt .gt_last_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ociqvanemt .gt_grand_summary_row { color: #333333; background-color: #FFFFFF; text-transform: inherit; padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; } #ociqvanemt .gt_first_grand_summary_row { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-top-style: double; border-top-width: 6px; border-top-color: #D3D3D3; } #ociqvanemt .gt_last_grand_summary_row_top { padding-top: 8px; padding-bottom: 8px; padding-left: 5px; padding-right: 5px; border-bottom-style: double; border-bottom-width: 6px; border-bottom-color: #D3D3D3; } #ociqvanemt .gt_striped { background-color: rgba(128, 128, 128, 0.05); } #ociqvanemt .gt_table_body { border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3; } #ociqvanemt .gt_footnotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #ociqvanemt .gt_footnote { margin: 0px; font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #ociqvanemt .gt_sourcenotes { color: #333333; background-color: #FFFFFF; border-bottom-style: none; border-bottom-width: 2px; border-bottom-color: #D3D3D3; border-left-style: none; border-left-width: 2px; border-left-color: #D3D3D3; border-right-style: none; border-right-width: 2px; border-right-color: #D3D3D3; } #ociqvanemt .gt_sourcenote { font-size: 90%; padding-top: 4px; padding-bottom: 4px; padding-left: 5px; padding-right: 5px; } #ociqvanemt .gt_left { text-align: left; } #ociqvanemt .gt_center { text-align: center; } #ociqvanemt .gt_right { text-align: right; font-variant-numeric: tabular-nums; } #ociqvanemt .gt_font_normal { font-weight: normal; } #ociqvanemt .gt_font_bold { font-weight: bold; } #ociqvanemt .gt_font_italic { font-style: italic; } #ociqvanemt .gt_super { font-size: 65%; } #ociqvanemt .gt_footnote_marks { font-size: 75%; vertical-align: 0.4em; position: initial; } #ociqvanemt .gt_asterisk { font-size: 100%; vertical-align: 0; } #ociqvanemt .gt_indent_1 { text-indent: 5px; } #ociqvanemt .gt_indent_2 { text-indent: 10px; } #ociqvanemt .gt_indent_3 { text-indent: 15px; } #ociqvanemt .gt_indent_4 { text-indent: 20px; } #ociqvanemt .gt_indent_5 { text-indent: 25px; } #ociqvanemt .katex-display { display: inline-flex !important; margin-bottom: 0.75em !important; } #ociqvanemt div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after { height: 0px !important; } animal body brain log_body log_brain Sheep 55.50 175.00 4.02 5.16 Human 62.00 1,320.00 4.13 7.19 Y podemos usarlo también para interpretar la recta de referencia \\(y = 2.55 + 0.5 x\\) , para cambios chicos: Un incremento de 10% en masa total corresponde en un incremento de 5% en masa cerebral. El coeficiente de la regresión log-log, en nuestro ejemplo 0.5, es la elasticidad y es un concepto común en economía. Justificación Para entender la interpretación como cambio porcentual recordemos primero que la representación con series de Taylor de la función exponencial es: \\[e^x = \\sum_{n=0}^\\infty \\frac{x^n}{n!}\\] Más aún podemos tener una aproximación usando polinomios de Taylor, en el caso de la exponencial el \\(k\\)-ésimo polinomio de Taylor está dado por: \\[e^\\delta \\approx 1 + \\delta + \\frac{1}{2!}\\delta^2 + \\dots + \\frac{1}{k!}\\delta^k\\] y si \\(\\delta\\) es chica (digamos menor a 0.15), entonces la aproximación de primer grado es razonable y tenemos: \\[Ae^{\\delta} \\approx A(1+\\delta)\\] dat <- tibble(delta = seq(0, 1, 0.01), exp_delta = exp(delta), uno_mas_delta = 1 + delta) ggplot(dat, aes(x = uno_mas_delta, y = exp_delta)) + geom_line() + geom_abline(color = "red") + annotate("text", x = 1.20, y = 1.18, label = "y = x", color = "red", size = 6) "],["referencias.html", "Referencias", " Referencias "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]]
diff --git a/temario.html b/temario.html
index 37a7353..ada47e6 100644
--- a/temario.html
+++ b/temario.html
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    • 
 
 
  • Simulando de la posterior
    • 
-
  • 12.1 Ejemplo de islas
    • 
+
  • Ejemplo de islas
    • 
 
  • ¿Por qué funciona Metrópolis?
    • 
 
  • Método de Metrópolis
    • 
 
  • Ajustando el tamaño de salto
diff --git a/tipos-de-estudio-y-experimentos.html b/tipos-de-estudio-y-experimentos.html
index 8e61054..ad85efb 100644
--- a/tipos-de-estudio-y-experimentos.html
+++ b/tipos-de-estudio-y-experimentos.html
@@ -412,7 +412,7 @@
 
  • Ejemplo: varias pruebas independientes
    • 
 
 
  • Simulando de la posterior
    • 
-
  • 12.1 Ejemplo de islas
    • 
+
  • Ejemplo de islas
    • 
 
  • ¿Por qué funciona Metrópolis?
    • 
 
  • Método de Metrópolis
    • 
 
  • Ajustando el tamaño de salto