5 馃嵅 Calentao

鈥淲hen the facts change, I change my mind. What do you do, sir?鈥
鈥揓ohn Maynard Keynes

馃搮 Publicado 24 Abril 2022, 脷ltima actualizaci贸n 21 Mayo 2022

El Calentao recoge lo que qued贸 de las recetas electorales de 2018: recalienta el Plato Simple y Plato Mixto para la carrera electoral por la primera vuelta en 2022. Estos platos ya hicieron los mejores pron贸sticos en la primera vuelta de 2018, as铆 que se merecen un nuevo intento.

Ambos platos se cocinan igual que en 2018 excepto por dos diferencias: se basan en las encuestas de 2022, obviamente, y algunas variables como el tipo de encuesta ahora incluyen mezclas (telef贸nica y presencial) y un nuevo tipo digital que lleva a cabo AtlasIntel.


Calentao servido

Seg煤n la m谩s reciente preparaci贸n del Calentao, Gustavo Petro tendr铆a 35% de la votaci贸n, seguido por Federico Gutierrez con casi 24%. Rodolfo Hern谩ndez y Sergio Fajardo est谩n empatados en 10%, e Ingrid Betancourt con un poco menos de 2%4.

Como todos los platos, si se cocinan con nuevos ingredientes cuando salgan m谩s encuestas, los resultados ser谩n diferentes. Ambos platos dan resultados muy similares, aunque procesan la informaci贸n de manera diferente. Hay muy poca variabilidad entre las encuestas.

Calentao 2022

Figura 5.1: Calentao 2022

Ingredientes

El Calentao usa las encuestas p煤blicamente disponibles desde el 11 de marzo de 2022.

Tabla 5.1: Priors por candidato
Candidato \(\mu_{t}\) \(\sigma_{t}\)
Gustavo Petro 36.9 3.8
Federico Gutierrez 25.3 3.7
Rodolfo Hernandez 12.7 4.2
Sergio Fajardo 8.0 2.2
1 Fecha pron贸stico: 2022-06-20
2 N煤mero de encuestas disponibles: 27

Receta

Ver Plato Simple y Plato Mixto de 2018.


Datos

Alistamos los datos tal cual como se hizo en 2018.

library(tidyverse)
library(lubridate)

# Calentao datos ####
calentao_data <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>% 
  dplyr::select(n,fecha,muestra,encuestadora,merror=margen_error,tipo,
                gustavo_petro,federico_gutierrez,sergio_fajardo,rodolfo_hernandez,ingrid_betancourt) %>%
  dplyr::filter(between(lubridate::as_date(fecha),
                        lubridate::as_date("2022-03-13"),
                        lubridate::as_date("2022-05-28"))) %>%
  tidyr::pivot_longer(cols=contains("_"),names_to = "candidato", values_to = "int_voto") %>% 
  dplyr::mutate(nombres = case_when(candidato=="gustavo_petro" ~ "Gustavo Petro",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt")) %>%  
  # Crear algunas variables
  dplyr::mutate(e_max = int_voto + merror,
                e_min = int_voto - merror,
                fecha = lubridate::as_date(fecha),
                candidato = factor(candidato, levels=c("gustavo_petro","federico_gutierrez","sergio_fajardo","rodolfo_hernandez","ingrid_betancourt")),
                enc = factor(encuestadora),
                encuestadora=as.numeric(enc)) %>%
  #Crear variable duracion:
  dplyr::mutate(dd = lubridate::as_date(as.character(today()), format="%Y-%m-%d") - lubridate::as_date(as.character(fecha), format="%Y-%m-%d")) %>%
  dplyr::mutate(dd = as.numeric(dd)) %>% 
  dplyr::mutate(tipo_1=ifelse(tipo=="presencial",1,0),
                tipo_2=ifelse(tipo=="telefonico y presencial",1,0),
                tipo_3=ifelse(tipo=="digital",1,0))

## Data frames por candidato ####
gp_calentao <- calentao_data %>% dplyr::filter(candidato=="gustavo_petro", !is.na(int_voto))  
fg_calentao <- calentao_data %>% dplyr::filter(candidato=="federico_gutierrez", !is.na(int_voto))  
sf_calentao <- calentao_data %>% dplyr::filter(candidato=="sergio_fajardo", !is.na(int_voto))  
rh_calentao <- calentao_data %>% dplyr::filter(candidato=="rodolfo_hernandez", !is.na(int_voto))  
ib_calentao <- calentao_data %>% dplyr::filter(candidato=="ingrid_betancourt", !is.na(int_voto)) 

Estimaci贸n

Abajo va un ejemplo del Plato Simple para el candidato Federico Gutierrez, pero es el mismo para todos los demas. Utiliza el data frame fg_calentao, as铆 como los priors \(\small\mu_{candidato}=23.6\) y \(\small\sigma_{candidato}=4.8\). Toda la receta va en el siguiente objeto fg_simple.stan.

data{
    int<lower=1> N;
    int<lower=1> N_encuestadora;
    real int_voto[N];
    int encuestadora[N];
    real merror[N];
    real tipo_1[N];
    real tipo_2[N];
    real tipo_3[N];
    int muestra[N];
    real dd[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 a6;
    real a7;
    real<lower=0> s;
}
model{
    vector[N] m;
    s ~ cauchy( 0 , 5 );
    a7 ~ normal( 0 , 10 );
    a6 ~ normal( 0 , 10 );
    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( 25 , 4); //Priors
    for ( i in 1:N ) {
        m[i] = a1 + a_[encuestadora[i]] + a2 * muestra[i] + a3 * merror[i] +  a4 * dd[i] + a5 * tipo_1[i] + a6 * tipo_2[i] + a7 * tipo_3[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[i] + a3 * merror[i] +  a4 * dd[i] + a5 * tipo_1[i] + a6 * tipo_2[i] + a7 * tipo_3[i];
    }
    dev = dev + (-2)*normal_lpdf( int_voto | m , s );
}

Ahora nos vamos a RStan para prepara el plato con las encuestas disponibles hasta ahora:

library(rstan)

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

fg_simple_fit <- stan(file = "calentao/fg_simple.stan",
                  data=list(N=calentao_disponibles,
                            N_encuestadora=encuestadoras_disponibles,
                            int_voto=fg_calentao$int_voto,
                            encuestadora=fg_calentao$encuestadora,
                            muestra=fg_calentao$muestra,
                            merror=fg_calentao$merror,
                            dd=fg_calentao$dd,
                            tipo_1=fg_calentao$tipo_1,
                            tipo_2=fg_calentao$tipo_2,
                            tipo_3=fg_calentao$tipo_3),
                  control=list(adapt_delta=0.95),
                  iter = 4000,
                  chains = 4,
                  cores = 4)

Veamos en detalle el muestreo y los resultados.

Calentao: Cadenas

Figura 5.2: Calentao: Cadenas

Calentao: Par谩metros vs Observaciones

Figura 5.3: Calentao: Par谩metros vs Observaciones

脩apa: Estimaci贸n del Calentao con ulam de rethinking

La abstrusa representaci贸n del c贸digo en RStan puede ser intimidante. Es un lenguaje que da mucha flexibilidad, pero al costo de no poder comunicarla sino al que conoce muy bien la sem谩ntica de Stan.

As铆 que abajo incluyo el plato mixto del calentao usando una de las funciones de la 2da edici贸n del incre铆ble paquete rethinking de Richard McElreath.

library(rethinking)

fg_mixto_ulam <- ulam(
  alist(
    # Modelo
    int_voto ~ normal( m , s ) ,
    m <- a_encuestadora[encuestadora]+ 
      b1_encuestadora[encuestadora]*muestra + 
      b2_encuestadora[encuestadora]*merror + 
      b3_encuestadora[encuestadora]*dd+  
      b4_encuestadora[encuestadora]*tipo_1 + 
      b5_encuestadora[encuestadora]*tipo_2 + 
      b6_encuestadora[encuestadora]*tipo_3,
    # Priors
    c(a_encuestadora,b1_encuestadora,b2_encuestadora,b3_encuestadora,b4_encuestadora,b5_encuestadora,b6_encuestadora)[encuestadora] ~ multi_normal(c(a,b1,b2,b3,b4,b5,b6),Rho,s_encuestadora),
    a ~  dnorm(25,4), #Priors
    b1 ~ dnorm(0,10),
    b2 ~ dnorm(0,10),
    b3 ~ dnorm(0,10),
    b4 ~ dnorm(0,10),
    b5 ~ dnorm(0,10),
    b6 ~ dnorm(0,10),
    s_encuestadora ~ dcauchy(0,5),
    s ~ dcauchy(0,5),
    Rho ~ lkj_corr(2)
  ), 
  data=list(N=calentao_disponibles,
            N_encuestadora=encuestadoras_disponibles,
            int_voto=gp_calentao$int_voto,
            encuestadora=gp_calentao$encuestadora,
            muestra=gp_calentao$muestra,
            merror=gp_calentao$merror,
            dd=gp_calentao$dd,
            tipo_1=gp_calentao$tipo_1,
            tipo_2=gp_calentao$tipo_2,
            tipo_3=gp_calentao$tipo_3
  ),
  chains=4, 
  cores = 4,
  iter = 4000
)