🥫 Plato Simple

encuestas
modelo
simple
regresión
stan
bayesplot

Un primer modelo para agregar las encuestas

“All models are wrong, but some are useful”
- George Box

📅 Publicado 17 Abril 2018, Actualizado 10 Febrero 2022

El Plato Simple es el primer ejercicio de pronóstico para la primera vuelta. De entrada, tiene dos limitaciones importantes: no modela la determinación simultánea de la votación para todos los candidatos, ni el sesgo de respuesta de las encuestas.

La receta va en reversa. Primero el plato (los resultados), después los ingredientes (datos), luego la receta (modelo), y al final la preparación en la cocina (código). Los detalles se ponen más técnicos entre más se acerquen a la cocina.

Plato

Los resultados del Plato Simple son promedios de la distribución posterior estimada para cada candidato, así como los intervalos HPD (higher posterior density) de 90% sobre cada parámetro. Para tener una referencia, el resultado se compara con un promedio simple de las 18 encuestas que se hicieron después de las elecciones legislativas del 11 de marzo.

Resultados del Plato Simple

Ingredientes

El Plato Simple utiliza solo las encuestas y sus características. Antes de las consultas del 11 de marzo, y de la adhesión de Juan Carlos Pinzón a la campaña de German Vargas Lleras (el 16 de marzo de 2016), las encuestas estaban identificando un conjunto ruidoso de candidatos. Por esa razón, este modelo solo tiene en cuenta las encuestas realizadas después de las elecciones legislativas.

El modelo utiliza como priors para la estimación de un parámetro la proporción de votos promedio \(\mu_{candidato}\) y la desviación estándar \(\sigma_{candidato}\) que han registrado las encuestas para cada candidato. Los demás parámetros tienen priors poco informativos.

Priors por candidato
Candidato \(\mu_{prior}\) \(\sigma_{prior}\)
Ivan Duque 38.1 3.3
Gustavo Petro 26.8 3.4
Sergio Fajardo 13.1 2.9
German Vargas Lleras 7.5 2.1
Humberto de la Calle 3.0 1.1
1 Encuestas disponibles: 18

Priors Plato Simple

Receta

El modelo parte del supuesto de que la proporción de votos \(\pi\) que obtiene un candidato en las elecciones en el momento t es un reflejo de las preferencias que tiene la sociedad por ese candidato antes de las elecciones:

\[\pi_{candidato,t} \sim Normal(\pi_{candidato,t-1}, \sigma_{candidato,t-1})\] Como nadie es adivino para saber esas preferencias, solo se observan mediciones ruidosas de esa relación: las encuestas de intención de voto. Aunque no se puede conocer la proporción de votos que recibirá cada candidato antes del día de las elecciones, esa proporción es una función de la proporción de intención de voto \(\lambda\) que hayan capturado las encuestas que se hayan realizado antes de esa fecha.

\[\pi_{candidato,t-1} \sim Normal(\lambda_{candidato,t-1}, \sigma_{candidato,t-1})\] La proporción de votos para cada candidato se aproxima mediante un modelo lineal sobre las siguientes características de las encuestas: 1) el tamaño de la muestra de cada encuesta (m), 2) el márgen de error de la encuesta (e), 3) los días que pasaron entre la encuesta y la estimación (d), 4) una dummy para el tipo de encuesta (telefónica o presencial) (tipo). Además, se incluyen efectos aleatorios por encuestadora que permiten incorporar la variación a ese nivel.

Preparación

Este es el modelo completo, con los priors para cada parámetro. Los únicos priors informados son los que determinan el parámetro que captura el promedio y desviación estándar de cada candidato, y estos se actualizan con cada estimación del modelo cuando sale una nueva encuesta.

\[\small \lambda_{candidato,t} \sim Normal(\mu_{candidato,t},\sigma_{candidato,t})\] \[\small \mu_{candidato,t} = \alpha_{t}+\alpha_{encuestadora[i]}+\beta_1*m+\beta_2*e+\beta_3*d+\beta_4*tipo \] \[\small\alpha_{t} \sim Normal(\mu_{candidato},\sigma_{candidato}) \] \[\small\beta_1,\beta_2,\beta_3,\beta_4 \sim Normal(0,10) \] \[\small\alpha_{encuestadora[i]} \sim Normal(\mu, \sigma) \] \[\small\mu \sim Normal(0,10) \] \[\small\sigma \sim HalfCauchy(0,5) \] \[\small\sigma_{candidato} \sim HalfCauchy(0,5) \]

Datos

Hay que hacer unos cuantos ajustes a los datos de las encuestas antes de estimar el modelo:

Código
library(tidyverse)
library(lubridate)

# Alistamiento ####
encuestas_simple_2018 <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Elecciones%202018/encuestas2018.csv") %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,encuestadora,ivan_duque,gustavo_petro,sergio_fajardo,german_vargas_lleras, humberto_delacalle, m_error=margen_error, muestra_int_voto,tipo) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = c("ivan_duque","gustavo_petro","sergio_fajardo","german_vargas_lleras", "humberto_delacalle"), 
                      names_to = "candidato", values_to = "int_voto") %>% 
  # Seleccionar solo las encuestas hechas en 2018 antes de la primea vuelta
  dplyr::filter(between(as.Date(fecha, tz="GMT"),as.Date('2018-03-11', tz="GMT"),as.Date('2018-05-19', tz="GMT"))) %>% 
  # Crear algunas variables
  dplyr::mutate(e_max = int_voto + m_error,
                e_min = int_voto - m_error,
                fecha = as.Date(fecha),
                candidato = factor(candidato, levels=c("ivan_duque","gustavo_petro","sergio_fajardo","german_vargas_lleras","humberto_delacalle")),
                enc = factor(encuestadora),
                encuestadora=as.numeric(enc)) %>%
  #Crear variable duracion:
  dplyr::mutate(dd = as.Date(as.character(today()), format="%Y-%m-%d") - as.Date(as.character(fecha), format="%Y-%m-%d")) %>%
  dplyr::mutate(dd = as.numeric(dd)) %>% 
  dplyr::mutate(dd = 100*(dd/sum(dd))) %>%
  dplyr::mutate(tipo=ifelse(tipo=="Presencial",1,0)) 


## Crear data frames por candidato: ####
id_2018_simple <- encuestas_simple_2018 %>% dplyr::filter(candidato=="ivan_duque", !is.na(int_voto))  
gp_2018_simple <- encuestas_simple_2018 %>% dplyr::filter(candidato=="gustavo_petro", !is.na(int_voto))    
sf_2018_simple <- encuestas_simple_2018 %>% dplyr::filter(candidato=="sergio_fajardo", !is.na(int_voto))   
gvl_2018_simple <- encuestas_simple_2018 %>% dplyr::filter(candidato=="german_vargas_lleras", !is.na(int_voto))  
hdlc_2018_simple <- encuestas_simple_2018 %>% dplyr::filter(candidato=="humberto_delacalle", !is.na(int_voto))

Estimación

Este es el código para estimar el modelo para cada candidato. Solo se necesitan los datos cargados en R y tener el paquete RStan instalado (ver instrucciones acá)

El muestreo del modelo se hace en Stan, que para cada candidato utiliza su respectivo data frame y priors.

Por ejemplo, para el candidato Sergio Fajardo se utiliza el data frame sf y los priors \(\small\mu_{candidato}=13\) y \(\small\sigma_{candidato}=3\) en un objeto Stan de nombre fajardo.stan:

Código
data{
    int<lower=1> N;
    int<lower=1> N_encuestadora;
    real int_voto[N];
    int encuestadora[N];
    real muestra_int_voto[N];
    real m_error[N];
    real dd[N];
    real tipo[N];
}
parameters{
    real a1;
    vector[N_encuestadora] a_;
    real a_enc;
    real<lower=0> s_enc;
    real a2;
    real a3;
    real a4;
    real a5;
    real<lower=0> s;
}
model{
    vector[N] m;
    s ~ cauchy( 0 , 5 );
    a5 ~ normal( 0 , 10 );
    a4 ~ normal( 0 , 10 );
    a3 ~ normal( 0 , 10 );
    a2 ~ normal( 0 , 10 );
    s_enc ~ cauchy( 0 , 5 );
    a_enc ~ normal( 0 , 10 );
    a_ ~ normal( a_enc , s_enc );
    a1 ~ normal( 13 , 3 );  //Priors Fajardo: mu=13, sd=3
    for ( i in 1:N ) {
        m[i] = a1+a_[encuestadora[i]]+a2*muestra_int_voto[i]+a3*m_error[i]+a4*dd[i]+a5*tipo[i];
    }
    int_voto ~ normal( m , s );
}
generated quantities{
    vector[N] m;
    real dev;
    dev = 0;
    for ( i in 1:N ) {
        m[i] = a1+a_[encuestadora[i]]+a2 * muestra_int_voto[i]+a3*m_error[i]+a4*dd[i]+a5*tipo[i];
    }
    dev = dev + (-2)*normal_lpdf( int_voto | m , s );
}


Ahora a RStan:

Código
library(rstan)

options(mc.cores = parallel::detectCores())

fajardo_fit <- rstan::stan(file='fajardo.stan',
                    data=list(
                      N=18,
                      N_encuestadora=7,
                      int_voto=sf_2018_simple$int_voto,
                      encuestadora=sf_2018_simple$encuestadora,
                      muestra_int_voto=sf_2018_simple$muestra_int_voto,
                      m_error=sf_2018_simple$m_error,
                      dd=sf_2018_simple$dd,
                      tipo=sf_2018_simple$tipo),
                    control=list(adapt_delta=0.95),
                    iter=4000,
                    chains=4)


A pesar de las divergencias iniciales, el modelo converge rápido para todos los candidatos. Al fin y al cabo es muy simple y tiene pocas observaciones.

Por sugerencia de @infrahumano, incluyo dos gráficas antes de ir a shinystan: trace plot con bayesplot para ver cómo se comportaron las 4 cadenas en los parámetros clave, y una comparación a la carrera entre el promedio de cada parámetro y su valor observado.

Plato Simple: Parámetros vs Observaciones

Plato Simple: Parámetros vs Observaciones


Ahora un resumen de todos los parámetros del modelo:

Código
library(bayesplot)

posterior_fajardo <- as.matrix(fajardo_fit)

color_scheme_set("green")

mcmc_intervals(posterior_fajardo,
               prob=0.9,
               prob_outer = 0.99,
               point_est="mean")

Plato Simple: Parámetros vs Observaciones

Referencias


McElreath, R. (2015). Statistical Rethinking. Texts in Statistical Science.

Gelman, A., Carlin, J. B., Stern, H. S., Dunson, D. B., Vehtari, A., & Rubin, D. B. (2014). Bayesian data analysis. Boca Raton, FL: CRC press.

Stan Development Team (2016) Stan Modeling Language: User’s Guide and Reference Manual. Version 2.14.0.

Gelman, A., & Azari, J. (2017). 19 things we learned from the 2016 election. Statistics and Public Policy, 4(1), 1-10.

Gelman, A. (2006). Prior distributions for variance parameters in hierarchical models (comment on article by Browne and Draper). Bayesian analysis, 1(3), pp.515-534.

Linzer, D. A. (2013). Dynamic Bayesian forecasting of presidential elections in the states. Journal of the American Statistical Association, 108(501), 124-134.

Bunker, K., & Bauchowitz, S. (2016). Electoral Forecasting and Public Opinion Tracking in Latin America: An Application to Chile. Politica, 54(2).

Shirani-Mehr, H., Rothschild, D., Goel, S., & Gelman, A. (2018). Disentangling bias and variance in election polls. Journal of the American Statistical Association, (just-accepted), 1-23.

Wickham, H., & Grolemund, G. (2016). R for data science: import, tidy, transform, visualize, and model data. O’Reilly Media, Inc.

Este proyecto de Pierre-Antoine Kremp para las presidenciales en EEUU de 2016

Esta entrada del blog de Jim Savage

Esta visualización del muestreo que hacen algoritmos como Marvok Chain Monte Carlo, Metropolis-Hastings y el de Stan: No-U-Turn sampler