🍲 Calentao, reciclando platos viejos

Recalentando los platos de 2018 para las elecciones de 2022

Autor/a

Afiliación

Recetas Electorales

Análisis independiente

“When the facts change, I change my mind. What do you do, sir?”
–John Maynard Keynes

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 pronosticos en la primera vuelta de 2018, así que se merecen una recalentada.

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%¹.

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.

library(tidyverse)
library(RColorBrewer)
library(here)

# Parametros ####
shape_entrada_2022 <- c(22,4,23,16,17,21,12,5,18,19)
colors_entrada_2022 <- c(
  "Alejandro Gaviria" = rgb(50,205,50, maxColorValue = 255),
  "Sergio Fajardo" = rgb(31,161,46, maxColorValue = 255),
  "Juan Manuel Galan" = rgb(213,48,62, maxColorValue = 255),
  "Ingrid Betancourt" = rgb(14,185,11, maxColorValue = 255),
  "Alex Char" = rgb(228,0,120, maxColorValue = 255),
  "David Barguil" = rgb(0,97,169, maxColorValue = 255),
  "Enrique Peñalosa" = rgb(0,139,139, maxColorValue = 255),
  "Federico Gutierrez" = rgb(0,0,255, maxColorValue = 255),
  "Oscar I. Zuluaga" = rgb(30,144,255, maxColorValue = 255),
  "Gustavo Petro" = rgb(128,0,128, maxColorValue = 255),
  "Rodolfo Hernandez" = rgb(247,190,10, maxColorValue = 255),
  "Voto en blanco" = rgb(32,33,36, maxColorValue = 255)
  )


# Calentao resultados ####
readr::read_csv(here("elecciones", "2022-colombia","2022-04-24-calentao",
                     "calentao-2022_resultados.csv")) %>%
 #Predicciones
  dplyr::group_by(modelo) %>%
  dplyr::summarise(m_all = mean(value),
                   p10 = quantile(value,0.1),
                   p90 = quantile(value,0.9)) %>% 
  dplyr::mutate(candidato = str_sub(modelo, start = 1L,end = 2L),
                plato = ifelse(str_sub(modelo, start = 4L,end=8L)=="mixto", "Mixto 2022","Simple 2022")) %>%
  dplyr::left_join(tribble(~candidato,~nombre,
                            "gp","Gustavo Petro",
                            "fg","Federico Gutierrez",
                            "sf","Sergio Fajardo",
                            "rh","Rodolfo Hernandez"),
                       by=c("candidato")) %>%
  # Exclude IB
  dplyr::filter(!is.na(nombre)) %>%
  #Grafico
  ggplot(aes(x=nombre %>% reorder(m_all),color=nombre))+
  geom_point(aes(y=m_all), shape=10, size=5)+
  geom_text(aes(y=m_all, label=m_all %>% round(digits=1)),color="black",vjust=-1)+
  geom_linerange(aes(ymin=p10,ymax=p90))+
  geom_hline(yintercept=seq(10,50,10),linetype="dashed",color="grey60")+
  coord_flip()+
  facet_wrap(~plato)+
  scale_color_manual(values=colors_entrada_2022)+
  theme(legend.position="none",
        text = element_text(size=18),
        panel.grid = element_blank(),
        panel.background=element_rect(fill="grey90", color="white")
        )+
  labs(x=NULL,
       y="Pronosticos e intervalo de credibilidad 90%",
       title = "Calentao Electoral",
       subtitle = "Estimacion del 2022-05-20",
       caption="Fuente: www.recetas-electorales.com"
       )

Calentao 2022

Ingredientes

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

library(tidyverse)
library(kableExtra)
library(lubridate)

# Encuestas disponibles
calentao_disponibles <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>%
  dplyr::filter(between(lubridate::as_date(fecha),lubridate::as_date("2022-03-13"),lubridate::as_date("2022-05-28"))) %>%
  dplyr::tally() %>%
  as.numeric()

encuestadoras_disponibles <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>%
  dplyr::filter(between(lubridate::as_date(fecha),lubridate::as_date("2022-03-13"),lubridate::as_date("2022-05-28"))) %>%
  dplyr::select(encuestadora) %>%
  dplyr::n_distinct()
  as.numeric()

numeric(0)

# Preparar data frame para calcular priors
readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>% 
  dplyr::select(n,fecha,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")) %>%
  dplyr::filter(nombres!="Ingrid Betancourt") %>%
  dplyr::group_by(nombres) %>% 
  dplyr::summarize(mu_prior = mean(int_voto),
                   sd_prior = sd(int_voto)) %>%
  dplyr::arrange(desc(mu_prior)) %>% 
  kable("html", digits=1,caption = "Priors por candidato",
        col.names = c("Candidato",
                      "$\\mu_{t}$",
                      "$\\sigma_{t}$")) %>% 
  kable_styling(full_width = F) %>% 
  row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  footnote(number = c(paste0("Fecha pronostico: 2022-05-21"),
                      paste0("Encuestas disponibles: ",calentao_disponibles)))

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 pronostico: 2022-05-21
2 Encuestas disponibles: 27

Calentao: Priors

---

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;

  vector[N] int_voto;

  array[N] int<lower=1, upper=N_encuestadora> encuestadora;

  vector[N] merror;
  vector[N] tipo_1;
  vector[N] tipo_2;
  vector[N] tipo_3;
  vector[N] dd;

  array[N] int muestra;  // keep as int if it is truly integer; otherwise use vector[N]
}

parameters {
  real a1;

  real a_enc;
  real<lower=0> s_enc;
  vector[N_encuestadora] a_;

  real a2;
  real a3;
  real a4;
  real a5;
  real a6;
  real a7;

  real<lower=0> s;
}

transformed parameters {
  vector[N] m;

  m = a1
      + a_[encuestadora]
      + a2 * to_vector(muestra)
      + a3 * merror
      + a4 * dd
      + a5 * tipo_1
      + a6 * tipo_2
      + a7 * tipo_3;
}

model {
  // priors
  s ~ cauchy(0, 5);

  a1 ~ normal(25, 4);

  a_enc ~ normal(0, 10);
  s_enc ~ cauchy(0, 5);
  a_ ~ normal(a_enc, s_enc);

  a2 ~ normal(0, 10);
  a3 ~ normal(0, 10);
  a4 ~ normal(0, 10);
  a5 ~ normal(0, 10);
  a6 ~ normal(0, 10);
  a7 ~ normal(0, 10);

  // likelihood
  int_voto ~ normal(m, s);
}

generated quantities {
  real 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(cmdstanr)

fg_simple_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2022-colombia",
       "2022-04-24-calentao", "fg_simple.stan")
  )
  
fg_simple_fit <- fg_simple_stan$sample(
  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),
  seed = 123,
  chains = 4,
  parallel_chains = 4,
  iter_warmup = 1000,
  iter_sampling = 4000,
  adapt_delta = 0.95
)  

Veamos en detalle el muestreo y los resultados.

library(bayesplot)
library(posterior)
color_scheme_set("blue")
  
# Crear matriz de muestras de la distribucion posterior
fg_simple_posterior <- posterior::as_draws_df(fg_simple_fit)
  
#Trace plot para los parametros de interes
mcmc_trace(fg_simple_posterior,pars=vars(starts_with("m[")))

Calentao: Cadenas

library(tidyverse)
library(posterior)

# Parámetros vs Observados
fg_simple_fit %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(starts_with("m[")) %>% 
  dplyr::summarize(across(starts_with("m["),mean)) %>% 
  tidyr::pivot_longer(cols = starts_with("m["), names_to = "parameter",values_to = "estimate") %>%
  dplyr::mutate(n=row_number()) %>%
  dplyr::left_join(calentao_data %>%
                     dplyr::filter(candidato=="federico_gutierrez") %>%
                     dplyr::select(int_voto) %>%
                     dplyr::mutate(n=row_number()), by="n") %>%
  ggplot(aes(x=n))+
  geom_point(aes(y=int_voto),size=4,color="blue")+
  geom_point(aes(y=estimate),color="red2",shape=10,size=5)+
  theme_classic()+
  labs(y="intencion de voto",x=NULL)+
  scale_x_continuous(breaks=c(1:calentao_disponibles))

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
)

Notas

1. Ingrid Betancourt adhirió a la campaña de Rodolfo Hernández el 20 de mayo de 2022, y desde entonces se saca de las recetas electorales.