🥑 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

“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

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(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=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")) %>%
  # 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(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(
  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(across(where(is.numeric)))) %>%
  dplyr::mutate(across(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(across(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)
)

library(here)
library(cmdstanr)

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

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
)

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.

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(starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = 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(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
  ggplot(aes(y=m,x=nombre,color=nombre))+
  geom_point(size=2,shape=10,show.legend = FALSE)+
  geom_text(aes(label=m %>% round(digits=2)),vjust=-1.2,color="black")+
  geom_pointrange(aes(ymin = p10,ymax=p90), size=1.5)+
  # encuestas
  geom_point(data=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)+
  coord_flip()+
  scale_color_manual(values=colors_entrada_2022)+
  scale_y_continuous(limits = c(0,50),breaks=c(0,10,20,30,40,50))+
  geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  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: www.recetas-electorales.com")+
  theme_classic()+
  theme(legend.position="none",
        strip.text.x = element_text(size = 10),
        axis.text.x=element_text(size=10),
        text = element_text(size=14),
        panel.background=element_rect(fill="grey90", color="white")
  )

Resultados del Ajiaco

# Export ####
ajiaco_fit %>%
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = 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%.

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

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

Priors Ajiaco

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

library(tidyverse)

ajiaco_priors <- 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(across(where(is.numeric)))) %>%
  dplyr::mutate(across(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(across(everything(),median))

Estimación

Esta es la receta para el Ajiaco en Stan:

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:

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

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
)

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.

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
mcmc_trace(ajiaco_posterior,
           pars=vars(starts_with("pred[")))

Ajiaco: Parámetros vs Observaciones

# Parámetros vs Observados
ajiaco_fit %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = 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 = everything(), names_to = "candidato",values_to="prior") %>%
                     dplyr::mutate(n=row_number()), by="n") %>%
  #Join names
  dplyr::left_join(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(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)) %>%
  ggplot(aes(y=nombre,x=estimate,fill=nombre,color="grey80"))+
  geom_density_ridges(show.legend = FALSE)+
  stat_density_ridges(quantile_lines = TRUE, quantiles = 2,color="black",show.legend = FALSE)+
  scale_x_continuous(limits = c(0,60),breaks=c(0,10,20,30,40,50,60))+
  scale_fill_manual(values=colors_entrada_2022)+
  scale_color_manual(values=colors_entrada_2022)+
  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: www.recetas-electorales.com")+
  theme_ridges()

Ajiaco: Parámetros vs Observaciones

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.

TipShinystan

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

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(starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = 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 = everything(), names_to = "candidato",values_to="prior") %>%
                     dplyr::mutate(n=row_number()), by="n") %>%
  #Join names
  dplyr::left_join(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(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)) %>%
  ggplot(aes(y=nombre,x=estimate,fill = 0.5-abs(0.5-stat(ecdf))))+
  stat_density_ridges(geom = "density_ridges_gradient", calc_ecdf = TRUE) +
  scale_fill_viridis_c(name = "Prob", direction = -1)+
  scale_x_continuous(limits = c(0,60),breaks=c(0,10,20,30,40,50,60))+
  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: www.recetas-electorales.com")+
  theme(legend.position = "bottom")+
  theme_ridges()

Ajiaco: Densidades posteriores

# Probabilidad de que Petro obtenga mas de 50% ####
probabilidad_candidato <- function(candidato,modelo,votos) {
  
modelo %>% 
  posterior::as_draws_df() %>%
  tibble::as_tibble() %>% 
  dplyr::select(starts_with(paste0("pred[",candidato,"]"))) %>%
  dplyr::select(pred=1) %>%  
  dplyr::group_by(pred) %>%
  dplyr::mutate(n=n()) %>%
  dplyr::distinct(pred, .keep_all = TRUE) %>%
  dplyr::arrange(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.

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

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
)

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

# Consulta ####
consultas_resultados <- 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(starts_with("pred[")) %>% 
  tidyr::pivot_longer(cols = 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(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(!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(desc(m)) %>% 
  # Bind rows censo
  dplyr::bind_rows(tibble(nombre = "50% del censo electoral",
                          m = votantes_simulacion/1e6)) %>%
  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")) %>% 
  kable_styling(full_width = F, font_size = 14) %>% 
  row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  column_spec(2,italic = F, bold=TRUE, background = "#FFA500", color = "black") %>%
  column_spec(3:4,bold=TRUE, color = "black") %>%
  row_spec(6,bold=TRUE, background = "#c00000", color = "white") %>%
  footnote(number = c(paste0("Fecha: 2022-05-21"),
                      paste0("Aunque nadie lee estas notas: Esto es una simulación, no la realidad")))

Simulacion del Ajiaco con censo electoral (Millones de votos)

Candidato	Votos Ajiaco	Votos Consulta	Total Consulta
Gustavo Petro	7.07	4.45	5.52
Federico Gutierrez	4.76	2.14	3.95
Resto (Otros, Blanco e Indecisos)	3.15
Rodolfo Hernandez	2.78
Sergio Fajardo	1.56	0.72	2.15
50% del censo electoral	19.50
1 Fecha: 2022-05-21
2 Aunque nadie lee estas notas: Esto es una simulación, no la realidad

Simulación del Ajiaco vs Consultas

Notas

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