🍲 Calentao, reciclando platos viejos

Recalentando los platos de 2018 para las elecciones de 2022

Autor/a

Afiliación

Recetas Electorales

Análisis independiente

Fecha de publicación

24 de abril de 2022

Fecha de última modificación

21 de mayo de 2022

“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.

Ver código

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 = stringr::str_sub(modelo, start = 1L,end = 2L),
                plato = ifelse(stringr::str_sub(modelo, start = 4L,end=8L)=="mixto", "Mixto 2022","Simple 2022")) %>%
  dplyr::left_join(tibble::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
  ggplot2::ggplot(ggplot2::aes(x=nombre %>% reorder(m_all),color=nombre))+
  ggplot2::geom_point(ggplot2::aes(y=m_all), shape=10, size=5)+
  ggplot2::geom_text(ggplot2::aes(y=m_all, label=m_all %>% round(digits=1)),color="black",vjust=-1)+
  ggplot2::geom_linerange(ggplot2::aes(ymin=p10,ymax=p90))+
  ggplot2::geom_hline(yintercept=seq(10,50,10),linetype="dashed",color="grey60")+
  ggplot2::coord_flip()+
  ggplot2::facet_wrap(~plato)+
  ggplot2::scale_color_manual(values=colors_entrada_2022)+
  ggplot2::theme(legend.position="none",
        text = ggplot2::element_text(size=18),
        panel.grid = ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="grey90", color="white")
        )+
  ggplot2::labs(x=NULL,
       y="Pronosticos e intervalo de credibilidad 90%",
       title = "Calentao Electoral",
       subtitle = "Estimacion del 2022-05-20",
       caption="Fuente: recetas-electorales.netlify.app"
       )

1: Leemos los resultados precalculados del Calentao y resumimos cada modelo por su media e intervalo de credibilidad del 80% (p10–p90), uniendo el nombre de cada candidato.
2: Graficamos los pronósticos (punto = media, barra = intervalo 90%) en paneles por plato (Simple/Mixto).

Ingredientes

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

Ver código

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(dplyr::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(dplyr::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()

# 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(dplyr::between(lubridate::as_date(fecha),lubridate::as_date("2022-03-13"),lubridate::as_date("2022-05-28"))) %>%
  tidyr::pivot_longer(cols=tidyselect::contains("_"),names_to = "candidato", values_to = "int_voto") %>%
  dplyr::mutate(nombres = dplyr::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(dplyr::desc(mu_prior)) %>% 
  knitr::kable("html", digits=1,caption = "Priors por candidato",
        col.names = c("Candidato",
                      "$\\mu_{t}$",
                      "$\\sigma_{t}$")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  kableExtra::footnote(number = c(paste0("Fecha pronostico: 2022-05-21"),
                      paste0("Encuestas disponibles: ",calentao_disponibles)))

1: Contamos cuántas encuestas hay disponibles entre la consulta (13 de marzo) y la primera vuelta (28 de mayo).
2: Calculamos los priors por candidato (media y desviación de la intención de voto en ese periodo) y los mostramos como tabla.

numeric(0)

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
¹ Fecha pronostico: 2022-05-21
² 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.

Ver código

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(dplyr::between(lubridate::as_date(fecha),
                        lubridate::as_date("2022-03-13"),
                        lubridate::as_date("2022-05-28"))) %>%
  tidyr::pivot_longer(cols=tidyselect::contains("_"),names_to = "candidato", values_to = "int_voto") %>% 
  dplyr::mutate(nombres = dplyr::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(lubridate::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))

1: Leemos y alistamos los datos como en 2018: seleccionamos columnas, filtramos el periodo entre consulta y primera vuelta, pasamos a formato largo, calculamos márgenes, días transcurridos (dd) e indicadores de tipo de encuesta.
2: Separamos un data frame por candidato (Petro, Gutiérrez, Fajardo, Hernández, Betancourt) para alimentar los modelos.

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.

Ver código

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:

Ver código

library(cmdstanr)

fg_simple_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2022-colombia",
       "2022-04-24-calentao", "fg_simple.stan"),
  force_recompile = TRUE
  )

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
)

1: Compilamos el modelo Stan del Plato Simple (fg_simple.stan).
2: Ajustamos el modelo para Federico Gutiérrez con muestreo MCMC (4 cadenas), pasando los datos del data frame fg_calentao.

Veamos en detalle el muestreo y los resultados.

Ver código

library(bayesplot)
library(posterior)
bayesplot::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
bayesplot::mcmc_trace(fg_simple_posterior,pars=ggplot2::vars(tidyselect::starts_with("m[")))

1: Extraemos las muestras posteriores del ajuste en formato draws.
2: Traceplot de las medias estimadas m[i] para diagnosticar la convergencia del muestreo.

Ver código

library(tidyverse)
library(posterior)

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

1: Tomamos la media posterior de cada m[i] (estimación del modelo) y la unimos con la intención de voto observada de cada encuesta.
2: Graficamos observado (azul) vs estimado (rojo) por encuesta para evaluar el ajuste.

Ñ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.

Ver código

library(rethinking)

fg_mixto_ulam <- rethinking::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
)

1: El mismo Plato Mixto pero expresado con rethinking::ulam: la fórmula alist() declara la verosimilitud normal, el predictor con efectos por encuestadora correlacionados (multi_normal con prior lkj_corr) y los priors; data= pasa los ingredientes y se ajusta con 4 cadenas.

Notas

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.↩︎

Cómo citar

BibTeX

@online{recetas_electorales,
  author = {{Recetas Electorales}},
  url = {https://recetas-electorales.netlify.app/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html},
  langid = {es}
}

Por favor, cita este trabajo como:

Recetas Electorales. n.d. https://recetas-electorales.netlify.app/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html.