🥑 Ajiaco electoral

Después de muchos intentos, por fin un modelo probabilístico para la primera vuelta

Autor/a

Afiliación

Recetas Electorales

Análisis independiente

Fecha de publicación

1 de mayo de 2022

Fecha de última modificación

21 de mayo de 2022

“Today’s posterior is tomorrow’s prior”
– Dennis Lindley

Un plato completo para la primera vuelta

Después de varios intentos, por fin sale un plato que cocina la primera vuelta completa –con todos los candidatos juntos. El Ajiaco toma las encuestas como ingredientes para estimar simuláneamente la proporción de votos para cada candidato, proyecta la incertidumbre que hay en cada votación, y mantiene las proporciones acotadas para que nunca sumen menos de cero o más de cien por ciento.

La receta usa fórmulas complicadas y algunos ingredientes inusuales, como el ajiaco que simboliza. Abajo se describen todos los detalles para estimar y replicar el Ajiaco, e incluso usarlo para propagar la incertidumbre de otros escenarios. Siéntase libre de saltarse cualquier paso de la preparación y solo ver el plato servido –aunque se recomienda ver también la gráfica al final, que es la mejor de todas.

Una ventaja adicional del Ajiaco es que, al modelar las proporciones de votos de todos los candidatos, también servirá para analizar el elusivo residual que incluye a los que van a votar en blanco, los que no sabe por quién votar y a los no responden las encuestas con la verdad.

Todos los domingos antes de las elecciones habrá una actualización del Ajiaco con las encuestas que vayan saliendo, así que estén atentos a actualizaciones para ver la más reciente preparación.

Ajiaco servido

Ver código

library(tidyverse)

# Preparar data frame para calcular priors
ajiaco_encuestas <- 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),
                        #Start
                        lubridate::as_date("2022-03-13"),
                        #lubridate::as_date("2022-05-10"),
                        #End
                        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")) %>%
  # Sacar a IB
  dplyr::filter(nombres!="Ingrid Betancourt") %>%
  dplyr::group_by(nombres) %>% 
  dplyr::summarize(promedio_prior = mean(int_voto),
                   promedio_ponderado_t = weighted.mean(int_voto,n))  

# Numero de encuestas disponibles
ajiaco_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()


# Datos ####
ajiaco_priors <- tibble::tibble(
  gp = ajiaco_encuestas$promedio_ponderado_t[2],
  fg = ajiaco_encuestas$promedio_ponderado_t[1],
  sf = ajiaco_encuestas$promedio_ponderado_t[4],
  rh = ajiaco_encuestas$promedio_ponderado_t[3]) %>%
  dplyr::mutate(rest = 100-rowSums(dplyr::across(where(is.numeric)))) %>%
  dplyr::mutate(dplyr::across(dplyr::everything(),~./100))

# Simulacion numero de encuestas 
ajiaco_n_encuestas <- 1e2
ajiaco_ensayos <- 1e5

# Simulacion de resultados de encuestas
ajiaco_multinomial <- rmultinom(ajiaco_ensayos, ajiaco_n_encuestas,ajiaco_priors) %>%
  t() %>%
  tibble::as_tibble() %>%
  dplyr::summarise(dplyr::across(dplyr::everything(),median))

#Datos Ajiaco ####
ajiaco_data <- list(
  ajiaco_n_encuestas = ajiaco_n_encuestas,
  ajiaco_priors = c(ajiaco_multinomial$gp,
                    ajiaco_multinomial$fg,
                    ajiaco_multinomial$sf,
                    ajiaco_multinomial$rh,
                    ajiaco_multinomial$rest)
)

1: Calculamos los priors del Ajiaco a partir del promedio ponderado de las encuestas por candidato, simulamos resultados de encuestas con una multinomial y armamos la lista de datos (ajiaco_data) para el modelo Stan.

Ver código

library(here)
library(cmdstanr)

# Estimacion ####
ajiaco_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2022-colombia","2022-05-01-ajiaco","ajiaco_model.stan"),
  force_recompile = TRUE
)

ajiaco_fit <- ajiaco_stan$sample(
  data = ajiaco_data,
  seed = 123,
  chains = 4,
  parallel_chains = 4,
  iter_warmup = 1000,
  iter_sampling = 4000,
  adapt_delta = 0.95
)

1: Compilamos el modelo Stan del Ajiaco (ajiaco_model.stan).
2: Ajustamos el modelo con muestreo MCMC (4 cadenas) usando los datos simulados.

Según esta estimación del Ajiaco basada en 27 encuestas disponibles, Gustavo Petro obtendría 36% de la votación, seguido por Federico Gutierrez con 24%. Rodolfo Hernández sigue con 14% y Sergio Fajardo con 8%. El Ajiaco estimó a Ingrid Betancourt con 1-2% hasta el 20 de mayo, con la adhesión a la campaña de Rodolfo Hernández. Por último, el Ajiaco, por construcción, también estima un residuo que incluye la intención por otros candidatos, los que dicen que van a votar en blanco y los indecisos. Este residuo es de más o menos 14%, e incluye 2-2.5% para otros candidatos y 9-12% de indecisos.

El Ajiaco servido incluye la mediana de la distribución posterior estimada para todos los candidatos, así como intervalos que representan al rango entre el percentil 10 y 90 para el parámetro de cada candidato.

Ya que el modelo depende de lo que vaya saliendo en las encuestas, cada estimación del modelo arroja resultados diferentes. Eso refleja solamente el hecho de incorporar nueva información, y que debe hacerse con base a lo que salga en todas las encuestas, jamás en lo que salga en una sola.

Ver código

library(tidyverse)
library(RColorBrewer)
library(posterior)

# 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)
  )

# Plato servido
ajiaco_fit %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(tidyselect::starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = tidyselect::starts_with("pred["), names_to = "parameter",values_to = "estimate") %>%
  dplyr::group_by(parameter) %>%
  dplyr::summarise(m = quantile(estimate,0.5),
                   p10 = quantile(estimate,0.1),
                   p90 = quantile(estimate,0.9)) %>%
  dplyr::mutate(n=stringr::str_extract(parameter,"[:digit:]") %>% as.numeric()) %>%
  #Join names
  dplyr::left_join(tibble::tribble(~n,~nombre,
                           1,"Gustavo Petro",
                           2,"Federico Gutierrez",
                           3,"Sergio Fajardo",
                           4,"Rodolfo Hernandez",
                           #5,"Ingrid Betancourt",
                           #"jm","John Milton Rodriguez",
                           5,"Resto (Otros, Blanco e Indecisos)"),
                   by="n") %>%
  # Order
  dplyr::mutate(nombre = factor(nombre,levels = c("Resto (Otros, Blanco e Indecisos)",
                                                  #"Ingrid Betancourt",
                                                  "Sergio Fajardo","Rodolfo Hernandez","Federico Gutierrez","Gustavo Petro"))) %>%
  # ggplot
  ggplot2::ggplot(ggplot2::aes(y=m,x=nombre,color=nombre))+
  ggplot2::geom_point(size=2,shape=10,show.legend = FALSE)+
  ggplot2::geom_text(ggplot2::aes(label=m %>% round(digits=2)),vjust=-1.2,color="black")+
  ggplot2::geom_pointrange(ggplot2::aes(ymin = p10,ymax=p90), size=1.5)+
  # encuestas
  ggplot2::geom_point(data=tibble::tribble(~m,~nombre,
                           100*ajiaco_priors$gp,"Gustavo Petro",
                           100*ajiaco_priors$fg,"Federico Gutierrez",
                           100*ajiaco_priors$sf,"Sergio Fajardo",
                           100*ajiaco_priors$rh,"Rodolfo Hernandez",
                           #100*ajiaco_priors$ib,"Ingrid Betancourt",
                           100*ajiaco_priors$rest,"Resto (Otros, Blanco e Indecisos)"),
             color="red2", shape=18,size=5,show.legend = FALSE)+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(0,10,20,30,40,50))+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::labs(x=NULL,
       title = "Ajiaco Electoral",
       subtitle = paste0("Estimacion del 2022-05-21 con base en ",ajiaco_disponibles," encuestas.\nPromedio de encuestas a la fecha en rojo"),
       y="Mediana e intervalo de 90% para cada candidato",
       caption = "Fuente: recetas-electorales.netlify.app")+
  ggplot2::theme_classic()+
  ggplot2::theme(legend.position="none",
        strip.text.x = ggplot2::element_text(size = 10),
        axis.text.x=ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=14),
        panel.background=ggplot2::element_rect(fill="grey90", color="white")
  )

2: Exportamos las muestras posteriores de pred[] a un CSV para reutilizarlas.

Ver código

# Export ####
ajiaco_fit %>%
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(tidyselect::starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = tidyselect::starts_with("pred["), names_to = "parameter",values_to = "estimate") %>%
  readr::write_csv(here("elecciones","2022-colombia","2022-05-01-ajiaco","ajiaco_fit.csv"))

Ingredientes

El Ajiaco es el primero modelo generativo para la primera vuelta. El plato produce estimaciones para todos los candidatos simuláneamente. La maravilla de los modelos bayesianos es que son capaces de representar el fenómeno que buscan describir, condicionando el modelo a las observaciones, pero también lo pueden simular: pueden recrear lo que se busca observar.

Gracias a esta capacidad generativa, lo que hace al Ajiaco un buen plato es propagar la incertidumbre que se encuestra en sus ingredientes (las encuestas). Así, aunque los ingredientes no sean los mejores ya que las encuestas son imperfectas y ruidosas, el Ajiaco convierte la incertidumbre que hay en todas las encuestas juntas en incertidumbre sobre la votación estimada para cada candidato.

Para preparar el Ajiaco se necesitan las proporciones de votación para cada candidato. Según esta preparación, el modelo utiliza como priors para la estimación de cada parámetro la proporción de votos promedio en el momento t de cada estimación \(\mu_{t}\) que han registrado las encuestas para cada candidato. Esta no es la única forma: el Ajiaco también puede utilizar otro promedio, como un promedio ponderado donde las más recientes pesen relativamente más, u otras ponderaciones siempre y cuando todas las proporciones sumen 100%.

Ver código

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

# Preparar data frame para calcular priors
ajiaco_encuestas <- 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),
                        #Start
                        lubridate::as_date("2022-03-13"),
                        #lubridate::as_date("2022-05-10"),
                        #End
                        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")) %>%
  # Sacar a IB
  dplyr::filter(nombres!="Ingrid Betancourt") %>%
  dplyr::group_by(nombres) %>% 
  dplyr::summarize(promedio_prior = mean(int_voto),
                   promedio_ponderado_t = weighted.mean(int_voto,n))  

# Numero de encuestas disponibles
ajiaco_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()

# Kable
ajiaco_encuestas %>%
  dplyr::arrange(dplyr::desc(promedio_prior)) %>%
  knitr::kable("html", digits=1,caption = "Priors por candidato",
        col.names = c("Candidato",
                      "$\\mu_{t}$",
                      "$\\mu[ponderado]_{t}$")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  kableExtra::footnote(number = c(paste0("Fecha: 2022-05-21"),
                      paste0("Encuestas disponibles: ",ajiaco_disponibles)))

1: Calculamos los priors del Ajiaco (promedio simple y ponderado por el tiempo de cada candidato, entre la consulta y la primera vuelta) y los mostramos como tabla.

Priors por candidato
Candidato	\(\mu_{t}\)	\(\mu[ponderado]_{t}\)
Gustavo Petro	36.9	37.7
Federico Gutierrez	25.3	25.4
Rodolfo Hernandez	12.7	13.8
Sergio Fajardo	8.0	7.3
¹ Fecha: 2022-05-21
² Encuestas disponibles: 27

Priors Ajiaco

Lo que sigue es algo técnico, siéntase libre de saltárselo

Receta

El Ajiaco está inspirado en modelos de decisión discreta. Interpreta el apoyo que recibirá un candidato en las elecciones como un reflejo, imperfecto, de la intención de voto en las encuestas en cada momento t. Funciona de la siguiente manera.

La distribución de votos para cada candidato se determina con base en una función multinomial, donde cada ensayo es una encuesta, cada candidato es una posibible opción y la probabilidad de que se seleccione algun candidato \(\theta_{candidato}\) se determina con base en las proporciones de apoyo que reportan las encuestas. Cada encuesta entra dentro de la función multinomial como resultado de una distribución Dirichlet, cuyo único parámetro \(\alpha\) recoge al mismo tiempo todas las proporciones de votos estimadas por las encuestas para cada candidato¹. La distribución posterior es Dirichlet, ya que las funciones Dirichlet y multinomial son conjugates.

Ya que estos modelos están acotados a representar proporciones que siempre deben sumar 100%, el Ajiaco incluye un parámetro para los indecisos, tanto en la distribución multinomial como la Dirichlet. De esta forma, el modelo transforma las encuestas en incertidumbre sin resultados absurdos como intervalos de credibilidad negativos o mayores a 100%.

Estos son las 3 partes que se necesitan para construir el Ajiaco:

\[eleccion_{t} \sim Multinomial(\theta_{t})\]

\[\small \theta_{t} \sim Dirichlet(\alpha_{t})\]

\[\small\alpha_{t} \sim c(\mu_{Petro},\mu_{Gutierrez},\mu_{Fajardo},\mu_{Hernandez},\mu_{Betancourt},\mu_{Resto})\]

Datos

Para pronosticar con Ajiaco hay que simular las elecciones.

Comenzamos por resumir los parámetros que irán en la función Dirichlet como priors, que se basan en el promedio ponderado por el tiempo de las intenciones de voto en las encuestas (entre más reciente la encuesta, más pesa en el promedio). Luego simulamos 10 000 ensayos de la función multinomial y los resumimos con una mediana para cada parámetro. Esto es equivalente a simular 10 000 encuestas de intención de voto conociendo más o menos cuál es la probabilidad de seleccionar a cada candidato.

Ver código

library(tidyverse)

ajiaco_priors <- tibble::tibble(
  gp = ajiaco_encuestas$promedio_ponderado_t[2],
  fg = ajiaco_encuestas$promedio_ponderado_t[1],
  sf = ajiaco_encuestas$promedio_ponderado_t[4],
  rh = ajiaco_encuestas$promedio_ponderado_t[3]) %>%
  dplyr::mutate(rest = 100-rowSums(dplyr::across(where(is.numeric)))) %>%
  dplyr::mutate(dplyr::across(dplyr::everything(),~./100))

# Simulacion numero de encuestas
ajiaco_n_encuestas <- 1e2
ajiaco_ensayos <- 1e5

# Simulacion de resultados de encuestas
ajiaco_multinomial <- rmultinom(ajiaco_ensayos, ajiaco_n_encuestas,ajiaco_priors) %>%
  t() %>%
  tibble::as_tibble() %>%
  dplyr::summarise(dplyr::across(dplyr::everything(),median))

1: Resumimos los priors como proporciones (promedio ponderado por candidato, más el “resto” para que sumen 100%).
2: Simulamos 100 000 ensayos multinomiales (≈ encuestas hipotéticas) y los resumimos con la mediana de cada candidato — los ingredientes del Ajiaco.

Estimación

Esta es la receta para el Ajiaco en Stan:

Ver código

data {
  int<lower=1> ajiaco_n_encuestas; //Numero de encuestas
  array[5] int<lower=0> ajiaco_priors; //Numero de candidatos/opciones
}
parameters {
  simplex[5] theta; //Simplex que condensa las proporciones para que siempre sumen 100%
}
model {
  target += dirichlet_lpdf(theta | rep_vector(2, 5)); // Prior Dirichlet

  target += multinomial_lpmf(ajiaco_priors | theta); //Likelihood multinomial
}
generated quantities {
  array[5] int pred = multinomial_rng(theta, ajiaco_n_encuestas);
}

Ahora a cocinar Ajiaco en RStan:

Ver código

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

# Datos ####
ajiaco_data <- list(
  ajiaco_n_encuestas = ajiaco_n_encuestas,
  ajiaco_priors = c(ajiaco_multinomial$gp,
                    ajiaco_multinomial$fg,
                    ajiaco_multinomial$sf,
                    ajiaco_multinomial$rh,
                    ajiaco_multinomial$rest)
)

# Estimacion ####
ajiaco_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2022-colombia","2022-05-01-ajiaco","ajiaco_model.stan"),
  force_recompile = TRUE
)

ajiaco_fit <- ajiaco_stan$sample(
  data = ajiaco_data,
  seed = 123,
  chains = 4,
  parallel_chains = 4,
  iter_warmup = 1000,
  iter_sampling = 4000,
  adapt_delta = 0.95
)

1: Compilamos el modelo Stan del Ajiaco (ajiaco_model.stan).
2: Ajustamos el modelo con muestreo MCMC (4 cadenas) usando la lista de datos.

El Ajiaco electoral se cocina rápido. Todas las cadenas se portan bien. La distribución de cada parámetro se concentra en la proporción que viene de las encuestas rápidamente, y con tantas encuestas simuladas se ve muy claro.

Ver código

library(tidyverse)
library(tidybayes)
library(bayesplot)
library(ggridges)

# Crear matriz de muestras de la distribucion posterior
ajiaco_posterior <- posterior::as_draws_df(ajiaco_fit)

#Trace plot para los parametros de interes
bayesplot::mcmc_trace(ajiaco_posterior,
           pars=ggplot2::vars(tidyselect::starts_with("pred[")))

2: Graficamos la densidad posterior completa de cada candidato (gráfico de cordilleras) con su mediana marcada.

Ver código

# Parámetros vs Observados
ajiaco_fit %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(tidyselect::starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = tidyselect::starts_with("pred["), names_to = "parameter",values_to = "estimate") %>%
  dplyr::mutate(n=stringr::str_extract(parameter,"[:digit:]") %>% as.numeric()) %>%
  dplyr::left_join(ajiaco_priors %>%
                     tidyr::pivot_longer(cols = dplyr::everything(), names_to = "candidato",values_to="prior") %>%
                     dplyr::mutate(n=dplyr::row_number()), by="n") %>%
  #Join names
  dplyr::left_join(tibble::tribble(~candidato,~nombre,
                           "fg","Federico Gutierrez",
                           "gp","Gustavo Petro",
                           "sf","Sergio Fajardo",
                           "rh","Rodolfo Hernandez",
                           #"ib","Ingrid Betancourt",
                           #"jm","John Milton Rodriguez",
                           "rest","Resto (Otros, Blanco e Indecisos)"),
                   by="candidato") %>%
  dplyr::mutate(nombre = ifelse(stringr::str_detect(nombre,"Resto"),"Resto*",nombre)) %>%
  dplyr::mutate(nombre = factor(nombre,levels = c("Gustavo Petro","Federico Gutierrez","Rodolfo Hernandez","Sergio Fajardo","Resto*"))) %>%
  dplyr::mutate(nombre = fct_rev(nombre)) %>%
  ggplot2::ggplot(ggplot2::aes(y=nombre,x=estimate,fill=nombre,color="grey80"))+
  ggridges::geom_density_ridges(show.legend = FALSE)+
  stat_density_ridges(quantile_lines = TRUE, quantiles = 2,color="black",show.legend = FALSE)+
  ggplot2::scale_x_continuous(limits = c(0,60),breaks=c(0,10,20,30,40,50,60))+
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_color_manual(values=colors_entrada_2022)+
  ggplot2::labs(x="Distribución posterior de la intención de voto estimada para cada candidato",
       y=NULL,
       title = "Pronósticos del Ajiaco para la primera vuelta 2022",
       subtitle = paste0("Estimación del 2022-05-21 con base en ",ajiaco_disponibles," encuestas."),
       caption="*Incluye otros candidatos, voto en blanco e indecisos\nFuente: recetas-electorales.netlify.app")+
  theme_ridges()

Lo mejor del Ajiaco es que estima probabilidades para todos los niveles de votación de cada candidato. La distribución posterior para cada candidato es una densidadad completa para cada nivel de votación. Si usted quisiera saber cuál es la probabilidad de que Petro obtenga más de 40% de la votación, o cuál es la probabilidad que Fajardo saque más de 15%, pregúnteselo al Ajiaco.

Shinystan

El Ajiaco es mejor en shinystan.
En la consola de R: shinystan::launch_shinystan(ajiaco_fit)

Ver código

library(tidyverse)
library(tidybayes)
library(bayesplot)
library(ggridges)

# Crear matriz de muestras de la distribucion posterior
ajiaco_posterior <- posterior::as_draws_df(ajiaco_fit)

# Parámetros vs Observados
ajiaco_fit %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(tidyselect::starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = tidyselect::starts_with("pred["), names_to = "parameter",values_to = "estimate") %>%
  dplyr::mutate(n=stringr::str_extract(parameter,"[:digit:]") %>% as.numeric()) %>%
  dplyr::left_join(ajiaco_priors %>%
                     tidyr::pivot_longer(cols = dplyr::everything(), names_to = "candidato",values_to="prior") %>%
                     dplyr::mutate(n=dplyr::row_number()), by="n") %>%
  #Join names
  dplyr::left_join(tibble::tribble(~candidato,~nombre,
                           "fg","Federico Gutierrez",
                           "gp","Gustavo Petro",
                           "sf","Sergio Fajardo",
                           "rh","Rodolfo Hernandez",
                           "ib","Ingrid Betancourt",
                           #"jm","John Milton Rodriguez",
                           "rest","Resto (Otros, Blanco e Indecisos)"),
                   by="candidato") %>%
  dplyr::mutate(nombre = ifelse(stringr::str_detect(nombre,"Resto"),"Resto*",nombre)) %>%
  dplyr::mutate(nombre = factor(nombre,levels = c("Gustavo Petro","Federico Gutierrez","Rodolfo Hernandez","Sergio Fajardo","Ingrid Betancourt","Resto*"))) %>%
  dplyr::mutate(nombre = fct_rev(nombre)) %>%
  ggplot2::ggplot(ggplot2::aes(y=nombre,x=estimate,fill = 0.5-abs(0.5-stat(ecdf))))+
  stat_density_ridges(geom = "density_ridges_gradient", calc_ecdf = TRUE) +
  ggplot2::scale_fill_viridis_c(name = "Prob", direction = -1)+
  ggplot2::scale_x_continuous(limits = c(0,60),breaks=c(0,10,20,30,40,50,60))+
  ggplot2::labs(x="Distribución posterior de la intención de voto para cada candidato",
       y=NULL,
       title = "Pronósticos del Ajiaco para la primera vuelta 2022",
       subtitle = paste0("Estimación del 2022-05-21 con base en ",ajiaco_disponibles," encuestas."),
       caption="*Incluye otros candidatos, voto en blanco e indecisos\nFuente: recetas-electorales.netlify.app")+
  ggplot2::theme(legend.position = "bottom")+
  theme_ridges()

2: Definimos una función auxiliar que calcula la probabilidad posterior de que un candidato supere cierto umbral de votos.

Ver código

# Probabilidad de que Petro obtenga mas de 50% ####
probabilidad_candidato <- function(candidato,modelo,votos) {

modelo %>%
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(tidyselect::starts_with(paste0("pred[",candidato,"]"))) %>%
  dplyr::select(pred=1) %>%  
  dplyr::group_by(pred) %>%
  dplyr::mutate(n=dplyr::n()) %>%
  dplyr::distinct(pred, .keep_all = TRUE) %>%
  dplyr::arrange(dplyr::desc(n)) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(p=n/sum(n)) %>%
  dplyr::filter(pred>=votos) %>%
  dplyr::summarise(100*sum(p)) %>%
  as.numeric()

}

Ñapa: Simulación de las elecciones usando 🥑 Ajiaco

El Ajiaco se puede usar con un ingrediente adicional para simular unas elecciones: el censo electoral. Según la registraduría hay 39 millones votantes elegibles, y con históricos de participación de cerca de casi 50%, hay más o menos una masa electoral de 19.5 millones de votantes.

Cocinemos el Ajiaco con esa masa electoral para ver cuántos votos obtendría cada candidato, y comparemos con los votos que tuvieron en las consultas del 13 de marzo.

Ver código

library(rstan)
library(bayesplot)

# Censo electoral y tasa participacion 54% ####
censo <- 39002239
votantes_simulacion <- 0.5*censo

# Modelo ####
ajiaco_simulacion <- "
data {
  int<lower=1> ajiaco_n_encuestas;
  array[5] int<lower=0> ajiaco_priors;   // should sum to ajiaco_n_encuestas
}

parameters {
  simplex[5] theta;
}

model {
  theta ~ dirichlet(rep_vector(2.0, 5));
  ajiaco_priors ~ multinomial(theta);
}

generated quantities {
  array[5] int pred = multinomial_rng(theta, 19501120);
}

"

# Estimacion ####
ajiaco_sim_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2022-colombia","2022-05-01-ajiaco","ajiaco_sim.stan"),
  force_recompile = TRUE
)

ajiaco_simulacion_fit <- ajiaco_sim_stan$sample(
  data = ajiaco_data,
  seed = 123,
  chains = 4,
  parallel_chains = 4,
  iter_warmup = 1000,
  iter_sampling = 4000,
  adapt_delta = 0.95
)

1: Definimos el censo electoral (~39 M) y la masa de votantes (~50% de participación). El modelo Stan en línea simula pred[] sobre 19.5 M de votantes.
2: Compilamos el modelo de simulación (ajiaco_sim.stan).
3: Ajustamos el modelo para proyectar la votación total por candidato.

Ver código

library(rstan)
library(bayesplot)
library(kableExtra)
library(tidyverse)

# Consulta ####
consultas_resultados <- tibble::tribble(~fecha,~encuestadora,~consulta,~candidato,~int_voto,~votos,
                                # Pacto Historico
                                "2022-03-15","Resultado","Pacto Historico","Gustavo Petro",80.51,4446970,
                                "2022-03-15","Resultado","Pacto Historico","Francia Marquez",14.04,775732,
                                "2022-03-15","Resultado","Pacto Historico","Camilo Romero",4.07,225224,
                                "2022-03-15","Resultado","Pacto Historico","Arelis Uriana",0.97,53843,
                                "2022-03-15","Resultado","Pacto Historico","Alfredo Saade",0.38,21374,
                                # Centro Esperanza
                                "2022-03-15","Resultado","Centro Esperanza","Sergio Fajardo",33.43,717694,
                                "2022-03-15","Resultado","Centro Esperanza","Juan Manuel Galan",22.54,483977,
                                "2022-03-15","Resultado","Centro Esperanza","Alejandro Gaviria",15.57,334318,
                                "2022-03-15","Resultado","Centro Esperanza","Carlos Amaya",20.97,450286,
                                "2022-03-15","Resultado","Centro Esperanza","Jorge Enrique Robledo",7.46,160159,
                                # Equipo por Colombia
                                "2022-03-15","Resultado","Equipo por Colombia","Federico Gutierrez",54.17,2139927,
                                "2022-03-15","Resultado","Equipo por Colombia","Alex Char",17.73,700557,
                                "2022-03-15","Resultado","Equipo por Colombia","David Barguil",15.76,622724,
                                "2022-03-15","Resultado","Equipo por Colombia","Enrique Peñalosa",5.82,229970,
                                "2022-03-15","Resultado","Equipo por Colombia","Aydee Lizarazo",6.51,257191
                                ) %>%
  dplyr::mutate(fecha=lubridate::as_date(fecha))


# Tabla de votacion ####
options(knitr.kable.NA = '')

ajiaco_simulacion_fit %>%
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>%
  dplyr::select(tidyselect::starts_with("pred[")) %>%
  tidyr::pivot_longer(cols = tidyselect::starts_with("pred["), names_to = "parameter",values_to = "estimate") %>%
  dplyr::group_by(parameter) %>%
  dplyr::summarise(m = quantile(estimate,0.5),
                   p10 = quantile(estimate,0.1),
                   p90 = quantile(estimate,0.9)) %>%
  dplyr::mutate(n=stringr::str_extract(parameter,"[:digit:]") %>% as.numeric()) %>%
  #Join names
  dplyr::left_join(tibble::tribble(~n,~nombre,
                           1,"Gustavo Petro",
                           2,"Federico Gutierrez",
                           3,"Sergio Fajardo",
                           4,"Rodolfo Hernandez",
                           #5,"Ingrid Betancourt",
                           #"jm","John Milton Rodriguez",
                           5,"Resto (Otros, Blanco e Indecisos)"),
                   by="n") %>%
  # Order
  dplyr::mutate(nombre = factor(nombre,levels = c("Resto (Otros, Blanco e Indecisos)",
                                                  #"Ingrid Betancourt",
                                                  "Rodolfo Hernandez","Sergio Fajardo","Federico Gutierrez","Gustavo Petro"))) %>%
  #dplyr::filter(!stringr::str_detect(nombre,"Resto")) %>%
  dplyr::select(nombre,m) %>%
  dplyr::mutate(m = m/1e6) %>%
  # Consultas
  dplyr::left_join(consultas_resultados %>%
                     dplyr::group_by(consulta) %>%
                     dplyr::mutate(total_consulta = sum(votos)/1e6,
                                   votos = votos/1e6) %>%
                     dplyr::select(candidato,votos,total_consulta),
                   by=c("nombre"="candidato")) %>%
  dplyr::select(nombre,m,votos,total_consulta) %>%
  # Kable
  dplyr::arrange(dplyr::desc(m)) %>% 
  # Bind rows censo
  dplyr::bind_rows(tibble::tibble(nombre = "50% del censo electoral",
                          m = votantes_simulacion/1e6)) %>%
  knitr::kable("html", 
        digits=2,
        caption = "Simulacion del Ajiaco con censo electoral (Millones de votos)",
        knitr.kable.NA = "",
        col.names = c("Candidato",
                      "Votos Ajiaco",
                      "Votos Consulta",
                      "Total Consulta")) %>% 
  kableExtra::kable_styling(full_width = F, font_size = 14) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  kableExtra::column_spec(2,italic = F, bold=TRUE, background = "#FFA500", color = "black") %>%
  kableExtra::column_spec(3:4,bold=TRUE, color = "black") %>%
  kableExtra::row_spec(6,bold=TRUE, background = "#c00000", color = "white") %>%
  kableExtra::footnote(number = c(paste0("Fecha: 2022-05-21"),
                      paste0("Aunque nadie lee estas notas: Esto es una simulación, no la realidad")))

1: Definimos los resultados reales de las consultas del 13 de marzo (por coalición y candidato) para comparar.
2: Convertimos la simulación del Ajiaco en votos totales por candidato (millones), la unimos con los votos de las consultas y la mostramos como tabla, añadiendo el 50% del censo como referencia.

Simulacion del Ajiaco con censo electoral (Millones de votos)
Candidato	Votos Ajiaco	Votos Consulta	Total Consulta
Gustavo Petro	7.08	4.45	5.52
Federico Gutierrez	4.76	2.14	3.95
Resto (Otros, Blanco e Indecisos)	3.16
Rodolfo Hernandez	2.80
Sergio Fajardo	1.55	0.72	2.15
50% del censo electoral	19.50
¹ Fecha: 2022-05-21
² Aunque nadie lee estas notas: Esto es una simulación, no la realidad

Simulación del Ajiaco vs Consultas

Notas

Por esta razón el Ajiaco no incluye a los candidatos con menos de 1% de intención de voto, y posiblemente en una futura estimación también excluya a la candidata del partido Oxígeno Verde.↩︎

Cómo citar

BibTeX

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

Por favor, cita este trabajo como:

Recetas Electorales. n.d. https://recetas-electorales.netlify.app/elecciones/2022-colombia/2022-05-01-ajiaco/2022-ajiaco.html.