Recetas Electorales https://www.recetas-electorales.com/ Cocinando pronósticos electorales con herramientas open source y estadística bayesiana es https://www.recetas-electorales.com/logo/recetas-symbol.jpg Recetas Electorales https://www.recetas-electorales.com/ quarto-1.9.30 Fri, 15 May 2026 22:00:00 GMT 🌊 Gaussiano Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-16-gaussiano/2026-gaussiano.html

“A Gaussian process is a distribution over functions.”
—Rasmussen & Williams

Introduciendo el Gaussiano

La Cazuela estimó tendencias con una regresión: para cada candidato, un intercepto y una pendiente en el tiempo. Eso captura dirección pero no forma: si un candidato primero cae y luego repunta, o si el cambio se acelera en las últimas semanas, la línea recta lo pierde.

El Gaussiano reemplaza esa línea recta con un Gaussian Process (GP): una distribución sobre funciones suaves que aprende la forma de la tendencia directamente de los datos. Curvatura, aceleración, rebotes —todo queda capturado.

Pero la innovación más importante es otra: los GPs de los candidatos están correlacionados. Si Claudia López gana terreno, ¿a quién le quita votos? ¿A Paloma Valencia? ¿A Fajardo? El modelo estima una matriz de correlación entre las trayectorias de todos los candidatos, revelando la dinámica competitiva de la carrera.

La ventaja del GP es visible en la siguiente gráfica Figura 1: las curvas ya no son líneas rectas. La región sombreada corresponde a la proyección hacia el futuro (sin efecto casa), donde la incertidumbre crece a medida que nos alejamos de los datos observados —comportamiento propio de un GP bien calibrado.

Ver código
fecha_hoy <- Sys.Date()

p_pred_summary <- purrr::map_dfr(seq_len(J_pred), function(j2) {
  cols_j <- paste0("p_pred[", j2, ",", seq_len(K), "]")
  draws_all |>
    dplyr::select(dplyr::all_of(cols_j)) |>
    purrr::set_names(cand_names) |>
    tidyr::pivot_longer(dplyr::everything(), names_to = "candidato", values_to = "prop") |>
    dplyr::group_by(candidato) |>
    dplyr::summarise(
      media = mean(prop),
      q025  = quantile(prop, 0.025),
      q975  = quantile(prop, 0.975),
      q25   = quantile(prop, 0.25),
      q75   = quantile(prop, 0.75),
      .groups = "drop"
    ) |>
    dplyr::mutate(fecha = fecha_pred_seq[[j2]])
}) |>
  dplyr::mutate(cod = stringr::str_sub(candidato, start = 6L)) |>
  dplyr::left_join(candidatos_2026, by = "cod") |>
  dplyr::filter(cod != "ruido")

orden_candidatos <- p_pred_summary |>
  dplyr::group_by(nombre) |>
  dplyr::summarise(media_global = mean(media), .groups = "drop") |>
  dplyr::arrange(dplyr::desc(media_global)) |>
  dplyr::pull(nombre)

fecha_inicio <- lubridate::ymd("2026-05-01")

datos_plot <- p_pred_summary |>
  dplyr::filter(fecha >= fecha_inicio) |>
  dplyr::mutate(
    nombre    = factor(nombre, levels = orden_candidatos),
    es_futuro = fecha > fecha_hoy
  )

colores_leyenda <- datos_plot |>
  dplyr::distinct(nombre, color_cand) |>
  dplyr::arrange(match(nombre, orden_candidatos))

etiquetas_hoy <- datos_plot |>
  dplyr::filter(!es_futuro) |>
  dplyr::group_by(nombre, color_cand) |>
  dplyr::filter(fecha == max(fecha)) |>
  dplyr::ungroup()

etiquetas_pred <- datos_plot |>
  dplyr::group_by(nombre, color_cand) |>
  dplyr::filter(fecha == max(fecha)) |>
  dplyr::ungroup()

datos_plot |>
  ggplot2::ggplot(ggplot2::aes(x = fecha, color = color_cand, fill = color_cand)) +
  ggplot2::geom_ribbon(
    ggplot2::aes(ymin = q025, ymax = q975, alpha = es_futuro),
    color = NA
  ) +
  ggplot2::geom_ribbon(
    ggplot2::aes(ymin = q25, ymax = q75),
    alpha = 0.30, color = NA
  ) +
  ggplot2::geom_line(
    data = ~ dplyr::filter(.x, !es_futuro),
    ggplot2::aes(y = media), linewidth = 1.1
  ) +
  ggplot2::geom_line(
    data = ~ dplyr::filter(.x, es_futuro),
    ggplot2::aes(y = media), linewidth = 1.0, linetype = "dashed"
  ) +
  ggplot2::geom_vline(
    xintercept = as.numeric(fecha_hoy),
    linetype = "dotted", color = "gray40", linewidth = 0.8
  ) +
  ggplot2::geom_label(
    data          = etiquetas_hoy,
    ggplot2::aes(y = media, label = scales::percent(media, accuracy = 0.1),
                 fill = color_cand),
    nudge_x       = -3,
    hjust         = 1,
    color         = "white",
    fontface      = "bold",
    size          = 3.2,
    label.padding = ggplot2::unit(0.2, "lines"),
    show.legend   = FALSE
  ) +
  ggplot2::geom_label(
    data          = etiquetas_pred,
    ggplot2::aes(y = media, label = scales::percent(media, accuracy = 0.1),
                 fill = color_cand),
    nudge_x       = 3,
    hjust         = 0,
    color         = "white",
    fontface      = "bold",
    size          = 3.2,
    label.padding = ggplot2::unit(0.2, "lines"),
    show.legend   = FALSE
  ) +
  ggplot2::scale_color_identity(
    guide  = "legend",
    name   = NULL,
    breaks = colores_leyenda$color_cand,
    labels = as.character(colores_leyenda$nombre)
  ) +
  ggplot2::scale_fill_identity() +
  ggplot2::scale_alpha_manual(
    values = c(`FALSE` = 0.15, `TRUE` = 0.07),
    guide  = "none"
  ) +
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::scale_x_date(
    date_labels = "%d %b",
    date_breaks = "2 weeks",
    expand      = ggplot2::expansion(mult = c(0.09, 0.12))
  ) +
  ggplot2::labs(
    title    = "Gaussiano: tendencia GP y proyección",
    subtitle = paste0("Línea punteada vertical = hoy (", fecha_hoy,
                      "). Zona discontinua = proyección sin efecto casa."),
    caption  = "Fuente: https://recetas-electorales.netlify.app/",
    x        = NULL,
    y        = "% intención de voto"
  ) +
  ggplot2::theme_minimal(base_size = 14) +
  ggplot2::theme(
    text             = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    strip.text       = ggplot2::element_text(face = "bold", size = 13),
    axis.text.x      = ggplot2::element_text(angle = 30, hjust = 1, size = 9),
    legend.position  = "bottom"
  )
Figura 1: Tendencia GP por candidato: pasado y proyección a futuro

Evolución acumulada

La animación muestra cómo el GP actualiza las trayectorias a medida que se incorporan nuevas encuestas, con la proyección al 1° de junio.

Gaussiano: evolución acumulada de trayectorias GP

Gaussiano: evolución acumulada de trayectorias GP

Valencia vs. De la Espriella: Proyecciones

Paloma Valencia y Abelardo de la Espriella compiten por el mismo electorado de derecha. El GP permite ver si sus trayectorias se cruzan —o si una de las dos consolida la ventaja de cara al 1° de junio.

Ver código
library(ggtext)

k_pv   <- which(cand_names == "cand_pv")
k_adle <- which(cand_names == "cand_adle")
prob_pv_gt_adle_gp <- mean(
  draws_all[[paste0("p_pred[", J_pred, ",", k_pv,   "]")]] >
  draws_all[[paste0("p_pred[", J_pred, ",", k_adle, "]")]]
)

duo_plot <- p_pred_summary |>
  dplyr::filter(
    cod %in% c("pv", "adle"),
    fecha >= lubridate::ymd("2026-05-01")
  ) |>
  dplyr::mutate(es_futuro = fecha > fecha_hoy)

duo_etiquetas_hoy <- duo_plot |>
  dplyr::filter(!es_futuro) |>
  dplyr::group_by(nombre, color_cand) |>
  dplyr::filter(fecha == max(fecha)) |>
  dplyr::ungroup()

duo_etiquetas_pred <- duo_plot |>
  dplyr::group_by(nombre, color_cand) |>
  dplyr::filter(fecha == max(fecha)) |>
  dplyr::ungroup()

duo_colores <- duo_plot |>
  dplyr::distinct(nombre, color_cand)

duo_plot |>
  ggplot2::ggplot(ggplot2::aes(x = fecha, color = color_cand, fill = color_cand)) +
  ggplot2::geom_ribbon(
    ggplot2::aes(ymin = q025, ymax = q975, alpha = es_futuro),
    color = NA
  ) +
  ggplot2::geom_ribbon(
    ggplot2::aes(ymin = q25, ymax = q75),
    alpha = 0.35, color = NA
  ) +
  ggplot2::geom_line(
    data = ~ dplyr::filter(.x, !es_futuro),
    ggplot2::aes(y = media), linewidth = 1.3
  ) +
  ggplot2::geom_line(
    data = ~ dplyr::filter(.x, es_futuro),
    ggplot2::aes(y = media), linewidth = 1.2, linetype = "dashed"
  ) +
  ggplot2::geom_vline(
    xintercept = as.numeric(fecha_hoy),
    linetype = "dotted", color = "gray40", linewidth = 0.8
  ) +
  ggplot2::geom_label(
    data        = duo_etiquetas_hoy,
    ggplot2::aes(y = media, label = scales::percent(media, accuracy = 0.1),
                 fill = color_cand),
    nudge_x     = -3,
    hjust       = 1,
    color       = "white",
    fontface    = "bold",
    size        = 5,
    show.legend = FALSE
  ) +
  ggplot2::geom_label(
    data        = duo_etiquetas_pred,
    ggplot2::aes(y = media, label = scales::percent(media, accuracy = 0.1),
                 fill = color_cand),
    nudge_x     = 3,
    hjust       = 0,
    color       = "white",
    fontface    = "bold",
    size        = 5,
    show.legend = FALSE
  ) +
  ggtext::geom_richtext(
    data = tibble::tibble(x = max(duo_plot$fecha), y = Inf),
    ggplot2::aes(
      x = x, y = y,
      label = sprintf(
        "<b>P(Paloma > De la Espriella, 1° junio) = <span style='color:#63B9E9'>%.1f%%</span></b>",
        prob_pv_gt_adle_gp * 100
      )
    ),
    inherit.aes  = FALSE,
    hjust        = 1.05,
    vjust        = 1.5,
    size         = 5.5,
    family       = "news-cycle",
    fill         = "#F8F9FA",
    color        = "#212529",
    label.color  = NA,
    label.padding = ggplot2::unit(c(0.35, 0.55, 0.35, 0.55), "lines")
  ) +
  ggplot2::scale_color_identity(
    guide  = "legend",
    name   = NULL,
    breaks = duo_colores$color_cand,
    labels = duo_colores$nombre
  ) +
  ggplot2::scale_fill_identity() +
  ggplot2::scale_alpha_manual(values = c(`FALSE` = 0.18, `TRUE` = 0.08),
                               guide = "none") +
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::scale_x_date(
    date_labels = "%d %b",
    date_breaks = "2 weeks",
    expand      = ggplot2::expansion(mult = c(0.02, 0.10))
  ) +
  ggplot2::labs(
    title    = "Valencia vs. De la Espriella: tendencia GP y proyección",
    subtitle = paste0("Línea punteada = hoy (", fecha_hoy,
                      "). Zona discontinua = proyección sin efecto casa."),
    caption  = "Fuente: https://recetas-electorales.netlify.app/",
    x        = NULL,
    y        = "% intención de voto"
  ) +
  ggplot2::theme_minimal(base_size = 20) +
  ggplot2::theme(
    text             = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    axis.text.x      = ggplot2::element_text(angle = 30, hjust = 1, size = 14),
    legend.position  = "bottom"
  )
Figura 2: Trayectoria GP y proyección: Paloma Valencia y Abelardo de la Espriella
Ver código
library(ggtext)

draws_duo <- tibble::tibble(
  p_pv   = draws_all[[paste0("p_pred[", J_pred, ",", k_pv,   "]")]],
  p_adle = draws_all[[paste0("p_pred[", J_pred, ",", k_adle, "]")]]
) |>
  tidyr::pivot_longer(
    cols      = c(p_pv, p_adle),
    names_to  = "candidato",
    values_to = "prop"
  ) |>
  dplyr::mutate(
    color_cand = dplyr::case_when(
      candidato == "p_pv"   ~ "#63B9E9",
      candidato == "p_adle" ~ "#000066"
    )
  )

draws_duo |>
  ggplot2::ggplot(ggplot2::aes(x = prop, fill = color_cand)) +
  ggplot2::geom_density(alpha = 0.55, color = NA) +
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::scale_fill_identity(
    guide  = "legend",
    labels = c("#63B9E9" = "Paloma Valencia", "#000066" = "De la Espriella"),
    breaks = c("#63B9E9", "#000066")
  ) +
  ggtext::geom_richtext(
    data = tibble::tibble(x = Inf, y = Inf),
    ggplot2::aes(
      x = x, y = y,
      label = sprintf(
        "<b>P(Paloma > De la Espriella, 1° junio) = <span style='color:#63B9E9'>%.1f%%</span></b>",
        prob_pv_gt_adle_gp * 100
      )
    ),
    inherit.aes   = FALSE,
    hjust         = 1.1,
    vjust         = 1.5,
    size          = 7,
    family        = "news-cycle",
    fill          = "#F8F9FA",
    color         = "#212529",
    label.color   = NA,
    label.padding = ggplot2::unit(c(0.4, 0.6, 0.4, 0.6), "lines")
  ) +
  ggplot2::labs(
    title    = "Paloma Valencia vs. De la Espriella: distribuciones posteriores al 1° de junio",
    subtitle = "Modelo Gaussiano — proyección primera vuelta 2026",
    x        = "% intención de voto proyectado",
    y        = "Densidad",
    fill     = NULL,
    caption  = "Fuente: https://recetas-electorales.netlify.app/"
  ) +
  ggplot2::theme_minimal(base_size = 24) +
  ggplot2::theme(
    text             = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position  = "top"
  )
Figura 3: Distribuciones posteriores de Paloma Valencia y De la Espriella al 1° de junio (Gaussiano)

Diagnósticos

Escala de longitud del GP () y parámetros de concentración:

Ver código
library(bayesplot)

draws_diag <- draws_all |>
  dplyr::select(.chain, .iteration, .draw, rho, kappa) |>
  posterior::as_draws_array()

bayesplot::mcmc_trace(draws_diag, regex_pars = "^rho$|^kappa$")

Receta Gaussiano

El Gaussiano reemplaza la regresion de Ajiaco2 y Cazuela con un Gaussian Process multivariado correlacionado, que es simultáneamente:

  1. Suavizante: la tendencia de cada candidato puede tener cualquier forma suave —no solo una línea recta.
  2. Predictivo: la estructura GP permite extrapolar con incertidumbre creciente hacia el futuro.
  3. Correlacionado: la covarianza entre los GPs de diferentes candidatos captura la dinámica competitiva de la carrera.

El GP multivariado se implementa via el Linear Model of Coregionalization (LMC): la covarianza total es el producto de Kronecker entre la covarianza temporal () y la covarianza entre candidatos (). Esto hace al modelo separable, permitiendo la parametrización no-centrada eficiente y el cómputo de la media posterior en la grilla de predicción vía .

Modelo

Ver código
// gaussiano.stan
// Dirichlet-Multinomial con Gaussian Process multivariado correlacionado
// Extiende la Cazuela: reemplaza la tendencia lineal con un GP suavizante
// cuya covarianza entre candidatos es estimada vía prior LKJ.
//
// Modelo de coregionalización lineal (LMC):
//   f[k, j] = alpha_k * (L_Omega_gp * z_gp)[k, :] @ L_t'
//   Cov(f_k(t), f_l(t')) = alpha_k * alpha_l * Omega_gp[k,l] * K_t(t, t')

functions {
  // Kernel cruzado K(x_pred, x_obs; rho), amplitud unitaria
  matrix kernel_cross(array[] real x_pred, array[] real x_obs, real rho) {
    int n1 = size(x_pred);
    int n2 = size(x_obs);
    matrix[n1, n2] K;
    for (i in 1:n1)
      for (j in 1:n2)
        K[i, j] = exp(-0.5 * square((x_pred[i] - x_obs[j]) / rho));
    return K;
  }
}

data {
  int<lower=1> J;                           // encuestas observadas
  int<lower=2> K;                           // candidatos (K-1 libres + referencia)
  int<lower=1> H;                           // encuestadoras
  array[J] int<lower=0> n;                  // tamaños muestrales
  array[J, K] int<lower=0> Y;              // conteos Y[j, k]
  array[J] real t_obs;                      // tiempos observados (escalados)
  array[J] int<lower=1, upper=H> house;     // índice de encuestadora

  // Grilla de predicción (pasado + futuro)
  int<lower=1> J_pred;
  array[J_pred] real t_pred;
}

parameters {
  vector[K - 1] mu;                          // interceptos base (log-ratio vs ref)
  real<lower=0> rho;                         // escala de longitud del GP (shared)
  vector<lower=0>[K - 1] alpha_gp;          // amplitud GP por candidato
  cholesky_factor_corr[K - 1] L_Omega_gp;   // correlación entre GPs de candidatos
  matrix[K - 1, J] z_gp;                    // pesos GP (parametrización no-centrada)

  // Efectos de casa multinivel (heredados de la Cazuela)
  matrix[K - 1, H] z_delta;
  vector<lower=0>[K - 1] sigma_delta;
  cholesky_factor_corr[K - 1] L_Omega_delta;

  real<lower=0> kappa;                       // concentración DM
}

transformed parameters {
  // Kernel GP sobre tiempos observados (amplitud unitaria; escala por alpha_gp)
  matrix[J, J] K_t = gp_exp_quad_cov(t_obs, 1.0, rho);
  for (j in 1:J) K_t[j, j] += 1e-9;       // jitter numérico
  matrix[J, J] L_t = cholesky_decompose(K_t);

  // GPs correlacionados: f = diag(alpha) * L_Omega * z_gp * L_t'
  matrix[K - 1, J] f_gp;
  {
    matrix[K - 1, J] z_corr = diag_pre_multiply(alpha_gp, L_Omega_gp * z_gp);
    f_gp = z_corr * L_t';
  }

  // Efectos de casa (non-centered)
  matrix[K - 1, H] delta = diag_pre_multiply(sigma_delta, L_Omega_delta) * z_delta;

  // Predictor lineal (log-ratio)
  matrix[J, K] eta;
  for (j in 1:J) {
    for (k in 1:(K - 1))
      eta[j, k] = mu[k] + f_gp[k, j] + delta[k, house[j]];
    eta[j, K] = 0;                          // candidato de referencia
  }

  // Simplex via softmax
  array[J] simplex[K] p;
  for (j in 1:J) p[j] = softmax(eta[j]');
}

model {
  // Priors GP
  mu ~ normal(0, 2);
  rho ~ normal(0.5, 0.3);                   // escala de longitud en tiempo escalado
  alpha_gp ~ normal(0, 1);
  L_Omega_gp ~ lkj_corr_cholesky(2);
  to_vector(z_gp) ~ std_normal();

  // Priors efectos de casa
  sigma_delta ~ normal(0, 1);
  L_Omega_delta ~ lkj_corr_cholesky(2);
  to_vector(z_delta) ~ std_normal();

  // Prior concentración
  kappa ~ lognormal(log(200), 0.7);

  // Likelihood Dirichlet-Multinomial
  for (j in 1:J)
    Y[j] ~ dirichlet_multinomial(kappa * to_vector(p[j]));
}

generated quantities {
  // Matrices de correlación
  corr_matrix[K - 1] Omega_gp = multiply_lower_tri_self_transpose(L_Omega_gp);
  corr_matrix[K - 1] Omega_delta = multiply_lower_tri_self_transpose(L_Omega_delta);

  // Media posterior del GP en la grilla de predicción
  // f_pred[j2, k] = K(t_pred, t_obs) * K_t^{-1} * f_gp[k, :]'
  matrix[J_pred, K - 1] f_gp_pred;
  {
    matrix[J_pred, J] K_star = kernel_cross(t_pred, t_obs, rho);
    for (k in 1:(K - 1)) {
      vector[J] f_k = f_gp[k]';
      f_gp_pred[, k] = K_star * mdivide_left_spd(K_t, f_k);
    }
  }

  // Proporciones predichas (sin efecto casa — tendencia "pura")
  array[J_pred] simplex[K] p_pred;
  for (j2 in 1:J_pred) {
    vector[K] eta_pred;
    for (k in 1:(K - 1))
      eta_pred[k] = mu[k] + f_gp_pred[j2, k];
    eta_pred[K] = 0;
    p_pred[j2] = softmax(eta_pred);
  }

  // Posterior predictive check
  array[J, K] int Y_rep;
  for (j in 1:J)
    Y_rep[j] = dirichlet_multinomial_rng(kappa * to_vector(p[j]), n[j]);
}

brms puede expresar el mismo modelo con una fórmula de alto nivel. Las diferencias respecto al modelo Stan son:

Aspecto Stan brms
Likelihood Dirichlet-Multinomial () Multinomial (sin sobredispersión)
GPs entre candidatos LMC: compartido, correlacionado GP independiente por categoría
Efecto casa LKJ cruzado () Independiente por categoría
Ver código
library(brms)

# Un fila por encuesta, con conteos y tiempo escalado como columnas
datos_brm <- dplyr::bind_cols(
  encuestas_meta,
  tibble::as_tibble(conteos_2026),
  tibble::tibble(time_scaled = time_scaled)
)

# GP suavizante por categoría + efecto de encuestadora
# brms genera un GP separado (lscale, sdgp propios) para cada log-ratio
form_brm <- brms::bf(
  cbind(cand_ic, cand_adle, cand_pv, cand_sf, cand_cl, cand_ruido) | trials(muestra) ~
    gp(time_scaled, scale = FALSE) + (1 | encuestadora)
)

# Priors aproximando los del modelo Stan
priors_brm <- c(
  brms::prior(normal(0, 2),     class = Intercept),
  brms::prior(normal(0.5, 0.3), class = lscale,   lb = 0),
  brms::prior(normal(0, 1),     class = sdgp,      lb = 0),
  brms::prior(normal(0, 1),     class = sd,        lb = 0)
)

gp_brms_fit <- brms::brm(
  form_brm,
  data    = datos_brm,
  family  = brms::multinomial(refcat = "cand_ruido"),
  prior   = priors_brm,
  seed    = 42,
  chains  = 4,
  cores   = 4,
  iter    = 5000,
  warmup  = 1000,
  control = list(adapt_delta = 0.95, max_treedepth = 12),
  backend = "cmdstanr"
)

# Tendencia pura (sin efecto casa) en la grilla de predicción
newdata_brm <- tibble::tibble(
  time_scaled  = time_pred_scaled,
  encuestadora = factor(NA, levels = levels(encuestas_meta$encuestadora)),
  muestra      = 1000L
)

pred_brm <- brms::posterior_epred(
  gp_brms_fit,
  newdata          = newdata_brm,
  allow_new_levels = TRUE,
  re_formula       = NA   # marginaliza sobre el efecto casa
)

Comparación de modelos

Ajiaco2 Cazuela Gaussiano
Tendencia temporal No (pooled) Lineal () GP no-paramétrico
Forma de la tendencia — Línea recta Cualquier función suave
Correlación entre candidatos No No (en tendencias) Sí —
Proyección a futuro No Extrapolación lineal GP predictivo con incertidumbre
Efecto casa No Sí, LKJ Sí, LKJ (igual)
Parámetros adicionales —
Interpretabilidad Muy alta ( = preferencias) Alta ( = tendencia/día) Media ( = suavidad)

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🌊 Gaussiano},
  date = {2026-05-16},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-16-gaussiano/2026-gaussiano.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🌊 Gaussiano.” May 16. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-16-gaussiano/2026-gaussiano.html.
]]> encuestas gaussian process cmdstanr lkj https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-16-gaussiano/2026-gaussiano.html Fri, 15 May 2026 22:00:00 GMT 🥇 Recetario 2026 Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-03-concurso/2026-concurso-1era.html

“How can we find more beauty in process, not outcomes?”
C. Thi Nguyen

Segunda edición: Premios más grandes y nuevas reglas

En 2022, el concurso de Recetas Electorales reunió pronósticos de medios, politólogos y analistas. La Silla Vacía ganó la primera vuelta y @PoliticaConDato la segunda —ambos con recetas transparentes y reproducibles. Todos fallamos en el pronóstico, pero fue un ejercicio divertido y constructivo.

Desde ese entonces, La Silla Vacía pasó de un semáforo a un ponderador mucho mejor cocinado.

Para 2026, el concurso vuelve con tres grandes cambios:

  • 🏆 Premio al mejor pronóstico: $1.000.000 COP para el mejor pronóstico de la primera vuelta.
  • 🏆 Premio a la transparencia: $200.000 COP para la receta más transparente y reproducible.
  • 🤖 Declaración de uso de IA obligatoria: los LLMs cambian qué significa “modelo propio”. Si se usan, hay que decirlo explícitamente.
  • ⏱️ Tiempos más estrictos: Cierre con hora exacta, acuse de recibo requerido, sin enmiendas.

Lo que no cambia: No se aceptan salsas secretas. Cada receta debe ser abierta, reproducible y evaluable.

Las mejores recetas se llevan un premio no por el resultado sino por el proceso.

TipPremios:

🥇 Mejor pronóstico 1era vuelta: $1.000.000 COP.

🔬 Receta más transparente y reproducible: $200.000 COP

¿Qué tengo que hacer para participar?

Para participar hay que enviar una receta a recetas.electorales@gmail.com con los cuatro componentes descritos abajo. Solo se acepta un pronóstico por cada participante.

ImportanteFechas límite — sin excepciones
  • 1era vuelta: antes del 24 de mayo de 2026 a las 23:59 hora Colombia (UTC-5)

La receta solo cuenta cuando el cocinero recibe un correo de confirmación de recetas.electorales@gmail.com. Sin confirmación, no hay participación.

Recetas recibidas después de cada cierre son descalificadas del concurso. Pueden publicarse como referencia, pero no se puntúan ni compiten por el premio. No se aceptan enmiendas tras el cierre: la receta enviada es la que se evalúa.

Como las recetas electorales, cada plato debe tener cuatro componentes mínimos:

1. 👨‍🍳 Cocinero y nombre de la receta

Identidad de quien preparó el plato — puede ser personal o institucional — un nombre para la receta, y autorización expresa para publicar en Recetas Electorales los ingredientes, la cocina y el plato.

Se debe incluir nombre o seudónimo del cocinero.

2. 🍚 Ingredientes — Datos

Todos los datos que usa el modelo deben estar referenciados y ser públicamente disponibles antes del cierre del concurso. Lo mejor es que el modelo tenga un repositorio público en GitHub con todos los datos que utiliza. No hay restricciones sobre los datos que se utilicen, siempre y cuando sean verificables y estén disponibles al momento del envío.

3. 🍳 Cocina — Cálculos y Modelos

Cualquier cálculo o modelo estadístico debe incluir el código para estimarlo, evaluarlo y calcular los pronósticos que resulten. El código debe estar en un repositorio público (GitHub, GitLab, etc.) antes del cierre, con el commit correspondiente al pronóstico enviado como prueba de entrega previa a la elección.

Todas las técnicas son bienvenidas — desde promedios simples hasta modelos jerárquicos bayesianos — siempre y cuando sean reproducibles. El código puede estar en múltiples lenguajes de programación (R, Python, Julia, Stan, etc.).

Las recetas que incluyan datos y código reproducible serán publicadas en el repositorio de GitHub de Recetas Electorales con crédito al cocinero, para que queden disponibles como referencia abierta.

AdvertenciaDeclaración de uso de inteligencia artificial

El uso de herramientas de IA (ChatGPT, Claude, Gemini, Copilot, etc.) está permitido y bienvenido, pero debe declararse explícitamente. Cada receta debe indicar:

  1. Qué herramienta(s) de IA se usaron: Nombre y versión si está disponible
  2. En qué rol: asistencia en código, análisis de datos, interpretación de resultados, o como motor principal del pronóstico
  3. Si el pronóstico fue generado directamente por un LLM (por ejemplo, preguntándole a un modelo su estimación), esto debe declararse como la metodología principal

Sin esta declaración, la receta puede ser descalificada.

4. 🍲 Plato — Resultados

Cada modelo debe resultar en un pronóstico numérico de la proporción de votos válidos que cada candidato obtendrá. Se deben incluir todos los candidatos requeridos — aquellos con promedio de intención de voto ≥1% en el repositorio de encuestas al cierre, más el voto en blanco. La lista oficial se publicará con el correo de confirmación.

Los intervalos de incertidumbre son opcionales pero bienvenidos. No afectan el puntaje final.

La proporción de votos válidos se calcula así:

El ganador

La receta ganadora se determina por el error cuadrático medio (ECM) calculado sobre los candidatos requeridos. A diferencia del error absoluto medio (MAE), el ECM penaliza los errores grandes de forma cuadrática: Equivocarse en 4 puntos es 16 veces peor que equivocarse en 1. Esto evita el problema de 2022, donde errores menores acumulados en candidatos irrelevantes podían superar un gran error en el candidato principal.

Gana quien tenga el menor puntaje.

Candidatos requeridos

Solo se evalúan los candidatos en la lista oficial publicada al cierre —aquellos con promedio de intención de voto ≥1% en el repositorio de encuestas. El voto en blanco es opcional y no afecta el resultado. Los candidatos fuera de esa lista no afectan el puntaje.

Para la primera vuelta los candidatos a evaluar son:

  • Iván Cepeda
  • Abelardo de la Espriella
  • Paloma Valencia
  • Sergio Fajardo
  • Claudia López

Cálculo del Error Cuadrático Medio (ECM)

Para candidatos requeridos, con pronóstico puntual y resultado observado (en puntos porcentuales de votos válidos):

Penalización por pronóstico incompleto

Si una receta omite el pronóstico para algún candidato requerido, ese candidato recibe una penalización igual al doble del peor error cuadrático individual observado entre todos los participantes para ese candidato. Omitir candidatos nunca puede mejorar el puntaje.

Línea de base (benchmark)

Se publicará el ECM del promedio simple de encuestas disponibles al cierre y la última estimación del Ajiaco2 —serán líneas de base contra la que se comparan todas las recetas.

Regla de desempate

En caso de empate en el puntaje, el premio se reparte en iguales partes entre los ganadores.

Evaluación secundaria (publicada, no puntúa)

Después de la primeva vuelta, se publicará para cada receta:

  • Error absoluto medio (MAE): Para comparar con la edición de 2022
  • Sesgo promedio: Dirección y magnitud del error sistemático por candidato
  • Cobertura empírica: Para recetas que incluyan intervalos, proporción de candidatos cuyo resultado cayó dentro del intervalo declarado

Ejemplo: Un promedio simple de las encuestas disponibles

Ingredientes — Datos

Esta receta usa el repositorio de datos de Recetas Electorales, así que este paso es solo una línea.

Ver código
library(tidyverse)
library(here)

# Datos de encuestas 2026
ejemplo_datos <- readr::read_csv(
  here("elecciones","2026-colombia","2026-01-26-entrada","encuestas_2026.csv")
) |>
  dplyr::mutate(fecha = lubridate::mdy(fecha))

Cocina y Plato

Ver código
library(tidyverse)
library(kableExtra)
library(scales)

candidatos_2026 <- tibble::tribble(
  ~candidato,          ~nombre,
  "cand_ic",           "Iván Cepeda",
  "cand_adle",         "Abelardo de la Espriella",
  "cand_sf",           "Sergio Fajardo",
  "cand_pv",           "Paloma Valencia",
  "cand_cl",           "Claudia López"
)

ejemplo_datos |>
  dplyr::select(fecha, tidyselect::starts_with("cand_")) |>
  tidyr::pivot_longer(
    cols = c(tidyselect::starts_with("cand_")),
    names_to = "candidato", values_to = "int_voto"
  ) |>
  dplyr::filter(
    candidato %in% c("cand_ic","cand_adle","cand_pv","cand_cl","cand_sf"),
    fecha >= lubridate::ymd("2026-03-13")
    ) |>
  dplyr::left_join(candidatos_2026, by = "candidato") |>
  dplyr::group_by(nombre) |>
  dplyr::summarise(pronostico = 100*mean(int_voto, na.rm = TRUE), .groups = "drop") |>
  dplyr::arrange(dplyr::desc(pronostico)) |>
  dplyr::mutate(
    pronostico = scales::label_percent(accuracy = 0.1, scale = 1)(pronostico),
    intervalo = "ND"
  ) |>
  knitr::kable("html",
    caption = "Pronóstico: % votos por candidato (promedio simple de encuestas)",
    col.names = c("Candidato", "Pronóstico", "Intervalo")
  ) |>
  kableExtra::kable_styling(full_width = FALSE) |>
  kableExtra::row_spec(0, bold = TRUE, background = "#FF4900", color = "white") |>
  kableExtra::footnote(
    number = c(
      "Cocinero: Recetas Electorales",
      "Fecha pronóstico: 2026-05-02",
      "Herramienta IA usada: Ninguna",
      "Social: @recetaelectoral"
    )
  )
Pronóstico: % votos por candidato (promedio simple de encuestas)
Candidato Pronóstico Intervalo
Iván Cepeda 37.4% ND
Abelardo de la Espriella 23.2% ND
Paloma Valencia 19.4% ND
Sergio Fajardo 3.7% ND
Claudia López 2.6% ND
1 Cocinero: Recetas Electorales
2 Fecha pronóstico: 2026-05-02
3 Herramienta IA usada: Ninguna
4 Social: @recetaelectoral

🏆 Podio electoral

NotaResultados pendientes

Los resultados y el podio se publicarán aqui.

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🥇 Recetario 2026},
  date = {2026-05-03},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-03-concurso/2026-concurso-1era.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🥇 Recetario 2026.” May 3. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-03-concurso/2026-concurso-1era.html.
]]> elecciones pronósticos encuestas concurso https://www.recetas-electorales.com/elecciones/2026-colombia/2026-05-03-concurso/2026-concurso-1era.html Sat, 02 May 2026 22:00:00 GMT 🛒 Bazaar Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-20-bazaar/2026-bazaar.html

“Prices at any moment reflect a clash of narratives rather than any kind of consensus.”
—Rajiv Sethi, “Predicting Rare Events”

El Bazar de las apuestas

Las encuestas preguntan. Los mercados de predicción apuestan.

Nuestro Ajiaco2 y la Cazuela estiman la distribución de intención de voto “spot”, hoy. Polymarket estima quién gana. Son preguntas distintas, pero se pueden complementar: un candidato que lidera encuestas pero tiene baja probabilidad en Polymarket puede estar sufriendo un problema de viabilidad percibida por el mercado.

En un mercado de predicción como Polymarket, los participantes compran y venden contratos que valen $1 si un evento ocurre. El precio de cada contrato refleja la probabilidad implícita que el mercado asigna a ese resultado. Si un contrato por “Claudia López gana la primera vuelta” se transa a $0.30, el mercado dice que hay un 30% de probabilidad de que eso ocurra.

A diferencia de las encuestas, que miden la intención declarada de votantes o posibles votantes, Polymarket agrega la información privada de apostadores que arriesgan dinero real. Es un mecanismo distinto, con sesgos y problemas distintos, y por eso es interesante ponerlo al lado de nuestros modelos bayesianos.

Descargando los datos

Usamos el paquete polymarketR para acceder a la API pública de Polymarket:

Ver código
library(polymarketR)

descargar <- function(slug, mercado) {
  polymarketR::get_event_prices_history(
    event_slug = slug, interval = "max", fidelity = 1440
  ) |> dplyr::mutate(mercado = mercado)
}

bazar_raw <- dplyr::bind_rows(
  descargar("colombia-presidential-election",             "Ganador general"),
  descargar("colombia-presidential-election-1st-round-winner", "Primera vuelta")
)

Evolución de las probabilidades

Analizamos dos mercados simultáneamente: Ganador general (quién gana la presidencia) y Primera vuelta (quién gana la primera vuelta). Cada candidato tiene un contrato “Yes/No” en cada mercado; el precio “Yes” es la probabilidad implícita Figura 1.

Ver código
cinco_candidatos <- tibble::tribble(
  ~patron,       ~nombre,                    ~color_cand,
  "Cepeda",      "Iván Cepeda",              "#A52E94",
  "Espriella",   "Abelardo de la Espriella", "#000066",
  "Fajardo",     "Sergio Fajardo",           "#442F7E",
  "Lopez|L.pez", "Claudia López",            "#00B399",
  "Valencia",    "Paloma Valencia",          "#63B9E9"
)

bazar_plot <- bazar_raw |>
  dplyr::filter(outcome == "Yes") |>
  dplyr::mutate(fecha = as.Date(datetime)) |>
  dplyr::filter(stringr::str_detect(groupItemTitle, stringr::str_c(cinco_candidatos$patron, collapse = "|"))) |>
  dplyr::mutate(nombre = cinco_candidatos$nombre[
    purrr::map_int(groupItemTitle, ~ which(stringr::str_detect(.x, cinco_candidatos$patron))[[1]])
  ]) |>
  dplyr::left_join(cinco_candidatos |> dplyr::select(nombre, color_cand), by = "nombre") |>
  dplyr::group_by(nombre, color_cand, mercado, fecha) |>
  dplyr::summarise(prob = mean(price), .groups = "drop")

p_evolucion <- bazar_plot |>
  dplyr::filter(fecha >= lubridate::ymd("2026-03-12")) |>
  ggplot2::ggplot(ggplot2::aes(
    x     = fecha,
    y     = prob,
    color = nombre,
    group = nombre,
    text  = paste0(nombre, ": ", scales::percent(prob, accuracy = 0.1),
                   "<br>", format(fecha, "%d %b %Y"))
  )) +
  ggplot2::geom_line(linewidth = 1.0, alpha = 0.85) +
  ggplot2::scale_color_manual(
    values = setNames(cinco_candidatos$color_cand, cinco_candidatos$nombre)
  ) +
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, NA)) +
  ggplot2::facet_wrap(~ mercado) +
  ggplot2::labs(
    title    = "Probabilidades implícitas — Polymarket",
    subtitle = paste0("Datos al ", Sys.Date()),
    caption  = "Fuente: polymarket.com con polymarketR",
    x        = NULL,
    y        = "Probabilidad implícita",
    color    = NULL
  ) +
  ggplot2::theme_minimal(base_size = 14) +
  ggplot2::theme(
    text             = ggplot2::element_text(family = "news-cycle"),
    legend.position  = "bottom"
  )

plotly::ggplotly(p_evolucion, tooltip = "text") |>
  plotly::layout(
    legend = list(orientation = "h", y = -0.2, x = 0.5, xanchor = "center")
  )
Figura 1: Evolución de las probabilidades implícitas en Polymarket

Distribución actual

¿Dónde están hoy las fichas? Figura 2

Ver código
bazar_hoy <- bazar_plot |>
  dplyr::group_by(nombre, color_cand, mercado) |>
  dplyr::filter(fecha == max(fecha)) |>
  dplyr::summarise(prob = mean(prob), fecha_max = max(fecha), .groups = "drop")

bazar_hoy |>
  ggplot2::ggplot(ggplot2::aes(
    x    = prob,
    y    = reorder(nombre, prob),
    fill = color_cand
  )) +
  ggplot2::geom_col(alpha = 0.85) +
  ggplot2::scale_fill_identity() +
  ggplot2::geom_text(
    ggplot2::aes(label = scales::percent(prob, accuracy = 0.1)),
    hjust = -0.15, size = 4.5, family = "news-cycle"
  ) +
  ggplot2::scale_x_continuous(
    labels = scales::percent_format(accuracy = 1),
    expand = ggplot2::expansion(mult = c(0, 0.2))
  ) +
  ggplot2::scale_y_discrete(labels = scales::label_wrap(15))+
  ggplot2::facet_wrap(~ mercado) +
  ggplot2::labs(
    title    = "Probabilidades implícitas — Polymarket",
    subtitle = paste0("Última actualización: ", max(bazar_hoy$fecha_max)),
    caption  = "Fuente: polymarket.com con polymarketR",
    x        = "Probabilidad implícita",
    y        = NULL
  ) +
  ggplot2::theme_minimal(base_size = 15) +
  ggplot2::theme(
    text               = ggplot2::element_text(family = "news-cycle")
  )
Figura 2: Probabilidades implícitas actuales según Polymarket

El mercado vs. las encuestas

Los mercados de predicción y las encuestas miden cosas distintas:

Encuestas Polymarket
¿Quién responde? Votantes colombianos Apostadores del mundo
¿Qué mide? Intención de voto declarada Probabilidad implícita de victoria
Incentivo para ser honesto Ninguno Dinero real
Horizonte Estado actual Resultado final
Sesgo conocido Efecto casa, NS/NR Sesgos de mercado, liquidez
AdvertenciaOjo

Los mercados de predicción internacionales pueden tener información asimétrica sobre política colombiana. El volumen de transacciones y la profundidad del mercado son indicadores importantes de cuánto peso darle a estas señales.

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🛒 Bazaar},
  date = {2026-04-20},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-20-bazaar/2026-bazaar.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🛒 Bazaar.” April 20. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-20-bazaar/2026-bazaar.html.
]]> polymarket mercados de predicción probabilidades candidatos https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-20-bazaar/2026-bazaar.html Sun, 19 Apr 2026 22:00:00 GMT 🍲 Cazuela Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-13-cazuela/2026-cazuela.html

“Don’t ask why you should use a multilevel model. Ask instead, Why not?.”
–Richard McElreath

Introduciendo la Cazuela

La Cazuela es una extensión del Ajiaco2 que incorpora covariables al modelo Dirichlet-Multinomial, de manera similar a un modelo lineal generalizado (GLM). Mientras que el Ajiaco2 estima una sola proporción pooled común a todas las encuestas, la Cazuela permite que las proporciones varíen en función de:

  1. Tendencia temporal: ¿Cómo ha cambiado el apoyo a cada candidato a lo largo del tiempo?
  2. Efecto casa encuestadora: ¿Cada encuestadora tiene un sesgo sistemático hacia o en contra de ciertos candidatos?

El resultado es un modelo que no solo estima el estado actual de las preferencias electorales sino que también captura la dinámica temporal y corrige por las diferencias sistemáticas entre encuestadoras.

Veamos los resultados de la Cazuela Figura 1:

Ver código
# Extraer p[j,k] para la encuesta más reciente ####
J <- cazuela_data$J
K <- cazuela_data$K
cand_names <- colnames(conteos_2026)

# Usar las proporciones de la última encuesta (más reciente en el tiempo)
cols_last <- paste0("p[", J, ",", 1:K, "]")
cazuela_fit |>
  posterior::as_draws_df() |>
  tibble::as_tibble() |>
  dplyr::select(dplyr::all_of(cols_last)) |>
  dplyr::rename_with(
    ~ paste0("p_", cand_names),
    .cols = dplyr::everything()
  ) |>
  tidyr::pivot_longer(cols = dplyr::everything(),
                      names_to = "candidato", values_to = "prop") |>
  dplyr::mutate(candidato = stringr::str_sub(candidato, start = 3L)) |>
  dplyr::group_by(candidato) |>
  dplyr::mutate(candidato_m = mean(prop), .group_by = "drop") |>
  # Nombres
  dplyr::left_join(
    candidatos_2026 |> dplyr::mutate(candidato = paste0("cand_", cod)),
    by = "candidato"
  ) |>
  # Quitar ruido
  dplyr::filter(!stringr::str_detect(candidato, "ruido")) |>
  ggplot2::ggplot(ggplot2::aes(x = prop, y = reorder(nombre, candidato_m))) +
  ggdist::stat_dist_slabinterval(
    ggplot2::aes(
      fill = color_cand,
      fill_ramp = ggplot2::after_stat(level)
      ),
    .width = c(0.5, 0.8, 0.95, 0.99),
    interval_alpha = 0.95,
    show.legend = c(fill = FALSE, fill_ramp = TRUE, size = FALSE)
  ) +
  ggdist::stat_pointinterval(
    ggplot2::aes(label = scales::percent(candidato_m, accuracy = 0.1)),
  geom = "label",
  .width = 0,
  vjust = -0.5,
  fill = "white",
  color = "black"
  )+
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  ggplot2::scale_y_discrete(labels = scales::label_wrap(20))+
  ggplot2::scale_fill_identity(na.translate = FALSE)+
  ggdist::scale_fill_ramp_discrete(
    name   = "Intervalo creíble",
    range  = c(0.25, 1),
    breaks = c(0.5, 0.8, .95, 0.99),
    labels = c("50%", "80%", "95%", "99%"),
    na.translate = FALSE
  )+
  ggplot2::labs(
    title = "Cazuela: Tendencias y efectos casa encuestadora",
    subtitle = paste0("Modelo probabilístico estimado ", Sys.Date(), " con ", dplyr::n_distinct(encuestas_2026$encuesta_id)," encuestas"),
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = "Distribución posterior estimada, % intención de voto",
    y = NULL
  )+
  ggplot2::theme_minimal(base_size = 18) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    panel.grid.major.y = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position = "none"
  )
Figura 1: Cazuela: Dirichlet-Multinomial con covariables

Valencia o De la Espriella? Competencia probabilística

Una ventaja del enfoque bayesiano es que las comparaciones directas entre candidatos son triviales: basta con calcular la fracción de draws en los que la proporción de un candidato supera la del otro.

Según la Cazuela a 19 Mayo 2026, la probabilidad posterior de que Paloma Valencia obtenga más votos que De la Espriella en primera vuelta es 0.0%.

Ver código
library(ggtext)

draws_comp |>
  tidyr::pivot_longer(
    cols = c(p_cand_pv, p_cand_adle),
    names_to = "candidato",
    values_to = "prop"
  ) |>
  dplyr::mutate(
    color_cand = dplyr::case_when(
      candidato == "p_cand_pv"   ~ "#63B9E9",
      candidato == "p_cand_adle" ~ "#000066"
    )
  ) |>
  ggplot2::ggplot(ggplot2::aes(x = prop, fill = color_cand)) +
  ggplot2::geom_density(alpha = 0.55, color = NA) +
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::scale_fill_identity(
    guide  = "legend",
    labels = c("#63B9E9" = "Paloma Valencia", "#000066" = "De la Espriella"),
    breaks = c("#63B9E9", "#000066")
  ) +
  ggtext::geom_richtext(
    data = tibble::tibble(x = Inf, y = Inf),
    ggplot2::aes(
      x = x, y = y,
      label = sprintf(
        "<b>P(Paloma > De la Espriella) = <span style='color:#63B9E9'>%.1f%%</span></b>",
        prob_pv_gt_adle * 100
      )
    ),
    inherit.aes  = FALSE,
    hjust        = 1.1,
    vjust        = 1.5,
    size         = 7,
    family       = "news-cycle",
    fill         = "#F8F9FA",
    color        = "#212529",
    label.color  = NA,
    label.padding = ggplot2::unit(c(0.4, 0.6, 0.4, 0.6), "lines")
  ) +
  ggplot2::labs(
    title    = "Paloma Valencia vs. De la Espriella: distribuciones posteriores",
    subtitle = "Cazuela — encuesta más reciente, primera vuelta 2026",
    x        = "Distribución posterior estimada, % intención de voto",
    y        = "Densidad",
    fill     = NULL,
    caption  = "Fuente: https://recetas-electorales.netlify.app/"
  ) +
  ggplot2::theme_minimal(base_size = 24) +
  ggplot2::theme(
    text               = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor   = ggplot2::element_blank(),
    legend.position    = "top"
  )
Figura 2: Distribuciones posteriores de Paloma Valencia y De la Espriella (encuesta más reciente).

Tendencia temporal

La gran ventaja de la Cazuela sobre el Ajiaco2 es que podemos visualizar cómo han cambiado las proporciones estimadas a lo largo del tiempo, corrigiendo por el efecto casa de cada encuestadora Figura 3.

Ver código
# Extraer p[j,k] para todas las encuestas ####
draws_all <- cazuela_fit |>
  posterior::as_draws_df() |>
  tibble::as_tibble()

# Construir data.frame largo con p[j,k] para cada draw y encuesta
p_draws <- purrr::map_dfr(1:J, function(j) {
  # Seleccionar columnas exactas p[j,1], p[j,2], ..., p[j,K]
  cols_j <- paste0("p[", j, ",", 1:K, "]")
  draws_all |>
    dplyr::select(dplyr::all_of(cols_j)) |>
    dplyr::rename_with(~ cand_names, .cols = dplyr::everything()) |>
    dplyr::mutate(.draw = dplyr::row_number(), .stan_idx = j)
}) |>
  dplyr::left_join(
    encuestas_meta |> dplyr::mutate(.stan_idx = dplyr::row_number()),
    by = ".stan_idx"
  ) |>
  dplyr::select(-".stan_idx") |>
  tidyr::pivot_longer(
    cols = dplyr::all_of(cand_names),
    names_to = "candidato",
    values_to = "prop"
  ) |>
  dplyr::mutate(cod = stringr::str_sub(candidato, start = 6L)) |>
  dplyr::left_join(candidatos_2026, by = c("cod")) |>
  dplyr::filter(cod != "ruido")

# Resumir por fecha y candidato
p_summary <- p_draws |>
  dplyr::group_by(fecha, nombre, color_cand, cod) |>
  dplyr::summarise(
    media = mean(prop),
    q025 = quantile(prop, 0.025),
    q975 = quantile(prop, 0.975),
    q25 = quantile(prop, 0.25),
    q75 = quantile(prop, 0.75),
    .groups = "drop"
  )

# Orden global de candidatos por media posterior (usado en todas las gráficas)
orden_candidatos <- p_summary |>
  dplyr::group_by(nombre) |>
  dplyr::summarise(media_global = mean(media), .groups = "drop") |>
  dplyr::arrange(dplyr::desc(media_global)) |>
  dplyr::pull(nombre)

p_summary |>
  dplyr::mutate(nombre = factor(nombre, levels = orden_candidatos)) |>
  ggplot2::ggplot(ggplot2::aes(x = fecha, y = media, color = color_cand, fill = color_cand)) +
  ggplot2::geom_ribbon(ggplot2::aes(ymin = q025, ymax = q975), alpha = 0.15, color = NA) +
  ggplot2::geom_ribbon(ggplot2::aes(ymin = q25, ymax = q75), alpha = 0.3, color = NA) +
  ggplot2::geom_line(linewidth = 1.2) +
  ggplot2::geom_point(size = 2.5) +
  ggplot2::scale_color_identity() +
  ggplot2::scale_fill_identity() +
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::facet_wrap(~ nombre, scales = "free_y", ncol = 3) +
  ggplot2::labs(
    title = "Cazuela: Tendencia temporal por candidato",
    subtitle = paste0("Intervalos creíbles del 50% y 95%, estimados con ", dplyr::n_distinct(encuestas_2026$encuesta_id), " encuestas"),
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = NULL,
    y = "% intención de voto"
  ) +
  ggplot2::theme_minimal(base_size = 14) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    strip.text = ggplot2::element_text(face = "bold", size = 14),
    legend.position = "none"
  )
Figura 3: Tendencia temporal estimada por la Cazuela

Efectos de casa

Cada encuestadora tiene un sesgo sistemático implícito. La Cazuela modela estos efectos de casa como un modelo multinivel de efectos aleatorios: cada vector se extrae de una distribución normal multivariada con matriz de covarianza estimada vía descomposición LKJ. Esto permite que el modelo aprenda si una encuestadora que sobreestima a un candidato tiende a subestimar a otro Figura 4.

Ver código
# Extraer delta[k, h] (nota: índices [k, h] en el modelo actualizado) ####
K_minus_1 <- K - 1
H <- cazuela_data$H

delta_draws <- draws_all |>
  dplyr::select(dplyr::matches("^delta\\[")) |>
  tidyr::pivot_longer(dplyr::everything(), names_to = "param", values_to = "value") |>
  dplyr::mutate(
    indices = stringr::str_extract(param, "\\[(.+)\\]", group = 1),
    k = as.integer(stringr::str_extract(indices, "^\\d+")),
    h = as.integer(stringr::str_extract(indices, "\\d+$")),
    encuestadora = house_levels[h],
    candidato = cand_names[k],
    cod = stringr::str_sub(candidato, start = 6L)
  ) |>
  dplyr::left_join(candidatos_2026, by = c("cod")) |>
  dplyr::filter(cod != "ruido")

delta_summary <- delta_draws |>
  dplyr::group_by(encuestadora, nombre, color_cand, cod) |>
  dplyr::summarise(
    media = mean(value),
    q025 = quantile(value, 0.025),
    q975 = quantile(value, 0.975),
    .groups = "drop"
  )

delta_summary |>
  dplyr::mutate(nombre = factor(nombre, levels = orden_candidatos)) |>
  ggplot2::ggplot(ggplot2::aes(x = media, y = encuestadora, color = color_cand)) +
  ggplot2::geom_vline(xintercept = 0, linetype = "dashed", color = "gray50") +
  ggplot2::geom_pointrange(ggplot2::aes(xmin = q025, xmax = q975), size = 0.5) +
  ggplot2::scale_color_identity() +
  ggplot2::facet_wrap(~ nombre, scales = "free_x", ncol = 2) +
  ggplot2::labs(
    title = "Cazuela: Efectos de casa por encuestadora",
    subtitle = "Desviaciones multinivel (log-ratio), intervalos creíbles del 95%",
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = "Efecto casa (log-ratio escala)",
    y = NULL
  ) +
  ggplot2::theme_minimal(base_size = 16) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    strip.text = ggplot2::element_text(face = "bold", size = 14),
    legend.position = "none"
  )
Figura 4: Efectos de casa estimados por la Cazuela

El partial pooling en acción

La característica más poderosa del modelo multinivel es el shrinkage: cada encuestadora es un punto en el espacio de estimaciones y el modelo las “jala” hacia el centro según cuánta evidencia tiene. La animación Figura 5 muestra cómo se mueve cada casa encuestadora entre tres escenarios:

  1. Pooling completo: Todas colapsan al mismo punto, el promedio global.
  2. Sin pooling: Cada encuestadora se estimada de forma independiente.
  3. Partial pooling (Cazuela): El modelo jerárquico regula —las encuestadoras con pocas encuestas se encogen más hacia el centro que las que tienen varias muestras.
Figura 5: Pooling en la Cazuela

Correlación entre efectos de casa

El modelo estima explícitamente la matriz de correlación entre los efectos de casa de los candidatos usando un prior LKJ. Esto captura si las encuestadoras que sobreestiman a un candidato tienden a subestimar a otro Figura 6.

Ver código
# Extraer Omega[i,j] ####
omega_draws <- draws_all |>
  dplyr::select(dplyr::matches("^Omega\\[")) |>
  tidyr::pivot_longer(dplyr::everything(), names_to = "param", values_to = "value") |>
  dplyr::mutate(
    indices = stringr::str_extract(param, "\\[(.+)\\]", group = 1),
    i = as.integer(stringr::str_extract(indices, "^\\d+")),
    j = as.integer(stringr::str_extract(indices, "\\d+$"))
  ) |>
  dplyr::group_by(i, j) |>
  dplyr::summarise(media = mean(value), .groups = "drop") |>
  dplyr::mutate(
    cand_i = cand_names[i],
    cand_j = cand_names[j],
    cod_i = stringr::str_sub(cand_i, start = 6L),
    cod_j = stringr::str_sub(cand_j, start = 6L)
  ) |>
  dplyr::left_join(candidatos_2026 |> dplyr::select(cod, nombre), by = c("cod_i" = "cod")) |>
  dplyr::rename(nombre_i = nombre) |>
  dplyr::left_join(candidatos_2026 |> dplyr::select(cod, nombre), by = c("cod_j" = "cod")) |>
  dplyr::rename(nombre_j = nombre) |>
  dplyr::filter(!is.na(nombre_i), !is.na(nombre_j))

orden_corr <- orden_candidatos[orden_candidatos %in% unique(omega_draws$nombre_i)]

omega_draws |>
  dplyr::mutate(
    nombre_i = factor(nombre_i, levels = orden_corr),
    nombre_j = factor(nombre_j, levels = orden_corr)
  ) |>
  ggplot2::ggplot(ggplot2::aes(x = nombre_i, y = nombre_j, fill = media)) +
  ggplot2::geom_tile() +
  ggplot2::geom_text(ggplot2::aes(label = round(media, 2)), size = 3.5) +
  ggplot2::scale_fill_gradient2(low = "#2166AC", mid = "white", high = "#B2182B",
                       midpoint = 0, limits = c(-1, 1),
                       name = "Correlación") +
  ggplot2::scale_x_discrete(labels = scales::label_wrap(12)) +
  ggplot2::scale_y_discrete(labels = scales::label_wrap(12)) +
  ggplot2::labs(
    title = "Correlación entre efectos de casa",
    subtitle = "Matriz posterior media estimada con prior LKJ(2)",
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = NULL, y = NULL
  ) +
  ggplot2::theme_minimal(base_size = 18) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
    panel.grid = ggplot2::element_blank(),
    legend.position = "right"
  )
Figura 6: Matriz de correlación posterior de efectos de casa

Diagnósticos

El muestreo MCMC:

Ver código
bayesplot::mcmc_trace(cazuela_fit$draws(), pars = ggplot2::vars(matches("beta0_raw")))

Receta Cazuela

La Cazuela extiende el Ajiaco2 al permitir que las proporciones de candidatos varíen por encuesta como función de covariables. En lugar de un solo vector pooled, cada encuesta tiene su propio construido a partir de un predictor lineal con función de enlace softmax, como en un GLM multinomial.

La novedad clave es que los efectos de casa se modelan como efectos aleatorios multinivel con una estructura de covarianza completa. Los vectores se extraen de una distribución normal multivariada cuya matriz de covarianza se descompone en desviaciones estándar por candidato () y una matriz de correlación () con prior LKJ. Se usa la parametrización no-centrada () para mejorar la eficiencia del muestreo MCMC:

Donde es el tiempo centrado y escalado de la encuesta , es el índice de la encuestadora, y es el factor Cholesky de la matriz de correlación . El prior favorece correlaciones moderadas, lo que actúa como regularización contra matrices de correlación extremas.

Modelo

Ver código
data {
  int<lower=1> J;                     // encuestas
  int<lower=2> K;                     // candidatos
  int<lower=1> H;                     // encuestadoras
  array[J] int<lower=0> n;           // tamaño muestral
  array[J, K] int<lower=0> Y;        // conteos Y[j, k]
  vector[J] time;                     // covariable temporal (centrada)
  array[J] int<lower=1, upper=H> house; // índice de encuestadora
}

parameters {
  vector[K - 1] beta0_raw;           // intercepto (log-ratio vs candidato K)
  vector[K - 1] beta_time_raw;       // pendiente temporal (log-ratio vs K)

  // Efectos aleatorios de casa: multinivel con covarianza LKJ
  matrix[K - 1, H] z_delta;          // efectos estandarizados (non-centered)
  vector<lower=0>[K - 1] sigma_delta; // sd por candidato
  cholesky_factor_corr[K - 1] L_Omega; // factor Cholesky de correlación

  real<lower=0> kappa;                // concentración DM
}

transformed parameters {
  // Reconstruir efectos de casa: delta[,h] = diag(sigma) * L * z[,h]
  matrix[K - 1, H] delta;
  delta = diag_pre_multiply(sigma_delta, L_Omega) * z_delta;

  matrix[J, K] eta;
  for (j in 1:J) {
    for (k in 1:(K - 1)) {
      eta[j, k] = beta0_raw[k] + beta_time_raw[k] * time[j] + delta[k, house[j]];
    }
    eta[j, K] = 0;
  }

  array[J] simplex[K] p;
  for (j in 1:J) {
    p[j] = softmax(eta[j]');
  }
}

model {
  // Priors efectos fijos
  beta0_raw ~ normal(0, 2);
  beta_time_raw ~ normal(0, 1);

  // Priors multinivel para efectos de casa
  sigma_delta ~ normal(0, 1);
  L_Omega ~ lkj_corr_cholesky(2);
  to_vector(z_delta) ~ std_normal();

  // Prior concentración
  kappa ~ lognormal(log(200), 0.7);

  // Likelihood
  for (j in 1:J) {
    Y[j] ~ dirichlet_multinomial(kappa * to_vector(p[j]));
  }
}

generated quantities {
  array[J, K] int Y_rep;
  for (j in 1:J) {
    Y_rep[j] = dirichlet_multinomial_rng(kappa * to_vector(p[j]), n[j]);
  }

  // Matriz de correlación de efectos de casa
  corr_matrix[K - 1] Omega;
  Omega = multiply_lower_tri_self_transpose(L_Omega);
}

Comparación con el Ajiaco2

Ajiaco2 Cazuela
Proporciones Un solo pooled por encuesta
Tendencia temporal No Sí ()
Efecto casa No Sí, multinivel con LKJ
Covarianza casa No
Parametrización Directa Non-centered ()
Enlace Dirichlet prior directo Softmax (multinomial logit)
Parámetros
Interpretación Estado promedio Estado dinámico corregido
Ver código
cazuela_fit$summary(variables = c("beta0_raw", "beta_time_raw", "kappa"))
# A tibble: 11 × 10
   variable       mean   median      sd     mad       q5      q95  rhat ess_bulk
   <chr>         <dbl>    <dbl>   <dbl>   <dbl>    <dbl>    <dbl> <dbl>    <dbl>
 1 beta0_raw…   1.03     1.03    0.154   0.140    0.777    1.27   1.00     5730.
 2 beta0_raw…   0.452    0.453   0.207   0.188    0.117    0.777  1.00     5962.
 3 beta0_raw…   0.373    0.374   0.185   0.165    0.0711   0.671  1.00     6859.
 4 beta0_raw…  -1.37    -1.37    0.258   0.237   -1.80    -0.969  1.00     7737.
 5 beta0_raw…  -1.64    -1.64    0.194   0.171   -1.95    -1.33   1.00     9827.
 6 beta_time…   0.0266   0.0251  0.0739  0.0725  -0.0918   0.150  1.00     7886.
 7 beta_time…   0.0557   0.0549  0.0802  0.0776  -0.0738   0.190  1.00     7814.
 8 beta_time…  -0.0172  -0.0184  0.0827  0.0807  -0.151    0.121  1.00     7664.
 9 beta_time…  -0.178   -0.182   0.126   0.123   -0.379    0.0342 1.00    10541.
10 beta_time…   0.0576   0.0552  0.149   0.145   -0.184    0.306  1.000   14392.
11 kappa      235.     227.     68.8    65.2    136.     359.     1.00     3754.
# ℹ 1 more variable: ess_tail <dbl>

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🍲 Cazuela},
  date = {2026-04-13},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-13-cazuela/2026-cazuela.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🍲 Cazuela.” April 13. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-13-cazuela/2026-cazuela.html.
]]> encuestas dirichlet multinomial cmdstanr random effects lkj https://www.recetas-electorales.com/elecciones/2026-colombia/2026-04-13-cazuela/2026-cazuela.html Sun, 12 Apr 2026 22:00:00 GMT 🍳 Promesas Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-03-29-promesas/2026-promesas.html

¿Qué proponen los candidatos?

Los programas de gobierno son documentos extensos, dispersos, y escritos para que nadie los lea. Cada campaña publica sus propuestas en su propia página, con su propio formato y su propia lógica de navegación. Compararlos requiere leerlos todos, organizarlos mentalmente, y tener buena memoria.

Los LLMs son buenos para esto. Resumen, comparan, y extraen información de textos enormes. El problema es que no tienen acceso a la información que está en las páginas de los candidatos: necesitan que alguien se las dé.

TipUn asistente que leyó todos los programas de gobierno

La app de abajo es un chatbot que usa Retrieval-Augmented Generation (RAG) para responder preguntas sobre los programas de gobierno de los candidatos. Toda la información proviene de los documentos PDF oficiales de cada programa de gobierno y de las páginas web de cada campaña.

Ingredientes

La app fue construida con:

  • ragnar: para crear un store vectorial con el contenido de las páginas web de cada campaña. El store usa DuckDB como base de datos, embeddings de OpenAI (text-embedding-3-small) para la búsqueda semántica, y BM25 para la búsqueda por palabras clave.
  • ellmer: para conectar con un LLM (GPT-4o-mini) que responde las preguntas usando el contexto recuperado del store.
  • shinychat: para la interfaz de chat dentro de una app de Shiny.

El proceso tiene dos pasos:

  1. Ingesta: se procesan los PDFs de los programas de gobierno y se recorren las páginas oficiales de cada candidato. Todo el contenido se divide en fragmentos (chunks), se generan embeddings, y se almacenan en el store.
  2. Consulta: cuando el usuario hace una pregunta, el LLM busca los fragmentos más relevantes en el store y los usa como contexto para generar una respuesta fundamentada.

Fuentes

El store combina dos tipos de fuentes para cada candidato:

  • Programas de gobierno (PDF): los documentos oficiales registrados ante el CNE por cada campaña.
  • Páginas web: el contenido publicado en las páginas oficiales de cada campaña.
Ver código
library(tidyverse)
library(tinytable)

tibble::tibble(
  Candidato = c("Claudia López",
  "Sergio Fajardo",
  "Iván Cepeda",
  "Abelardo de la Espriella",
  "Paloma Valencia"),
  `Programa de gobierno (PDF)` = c(
    "Claudia-lopez-Programa-de-Gobierno.pdf",
    "Programa de gobierno Cambio. Serio. Seguro.pdf",
    "programa-gobierno-2026-2030 (1).pdf",
    "programa-de-gobierno-abelardo-delaspriella-.pdf",
    "Plan-Integrado-de-Gobierno-Final_compressed.pdf"
  ),
  `Página web` = c(
    "claudia-lopez.com",
    "sergiofajardo.com",
    "movimientopactohistorico.co",
    "defensoresdelapatria.com",
    "palomavalencia.com"
  )) |>
    tinytable::tt()
Tabla 1: Fuentes consultadas por candidato
Candidato Programa de gobierno (PDF) Página web
Claudia López Claudia-lopez-Programa-de-Gobierno.pdf claudia-lopez.com
Sergio Fajardo Programa de gobierno Cambio. Serio. Seguro.pdf sergiofajardo.com
Iván Cepeda programa-gobierno-2026-2030 (1).pdf movimientopactohistorico.co
Abelardo de la Espriella programa-de-gobierno-abelardo-delaspriella-.pdf defensoresdelapatria.com
Paloma Valencia Plan-Integrado-de-Gobierno-Final_compressed.pdf palomavalencia.com

La app Promesas

  • El contenido del store refleja lo publicado en las páginas oficiales al 29 de marzo de 2026. Las campañas pueden actualizar sus propuestas después de esa fecha.
  • Algunas páginas tienen contenido dinámico (JavaScript) que puede no capturarse completamente durante la ingesta.
  • El LLM puede cometer errores de interpretación. Siempre es buena idea verificar las respuestas consultando directamente las fuentes.
  • La calidad de las respuestas depende de la calidad del contenido publicado por cada campaña. Si un candidato no publica propuestas detalladas, el asistente no podrá inventarlas.

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🍳 Promesas},
  date = {2026-03-29},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-03-29-promesas/2026-promesas.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🍳 Promesas.” March 29. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-03-29-promesas/2026-promesas.html.
]]> llms propuestas ragnar ellmer https://www.recetas-electorales.com/elecciones/2026-colombia/2026-03-29-promesas/2026-promesas.html Sat, 28 Mar 2026 23:00:00 GMT 🍽️ Entrada, las sobrevivientes Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-26-entrada/2026-entrada.html

“Any outcome that is made possible by creating a law could have happened without the law.”
–Kaushik Basu (2018)

“Artículo 11. Responsabilidad de las firmas encuestadoras. Las firmas encuestadoras deberán cumplir con las leyes de la estadística. Si no lo hicieren, responderán civil y penalmente por sus actos cuando corresponda.”
–Ley 2494 de 2025

Las encuestas que sobrevivieron la regulación que buscó acabarlas

En 1897, el médico Edward Goodwin propuso una ley para determinar que la razón entre la circumferencia y el diámetro de un círculo era 3.2. La intersección entre la ignorancia y la arrogancia siempre produce cosas así.

Las barbaridades escritas en la Ley 2494 de 2025 no están lejos del episodio de 1897. Ninguna es más reveladora de la ignorancia que lo quedó escrito en el Art 11, que amenaza el trabajo estadístico con consequencias penales por no seguir las leyes de la estadística.

Ignorando por un momento que la ley fue propuesta por políticos cercanos a los futuros candidatos que se beneficiarían de la ignorancia producida por la veda a las encuestas, la existencia de esa ley es un triste reflejo de cómo unas élites pueden reconocer a todo el país que no entienden la diferencia entre una norma que hay que seguir y una regularidad científica.

Afortunadamente ni la honestidad ni el rigor estadístico se pueden legislar. Hay que seguir impulsando ambas así exista una ley que persigua lo contrario.

Las encuestas, juntas.

Ver código
library(tidyverse)
library(plotly)
library(scales)
library(ggrepel)
library(DT)
library(RColorBrewer)
library(showtext)
library(here)

sysfonts::font_add_google("News Cycle","news-cycle")
showtext::showtext_auto()

candidatos_df <- tibble::tribble(
  ~cod, ~nombre, ~color_cand,
  "ic", "Iván Cepeda", "#A52E94",
  "adle", "Abelardo de la Espriella", "#000066",
  "vd", "Vicky Dávila","#A11E4E",
  "sf", "Sergio Fajardo", "#442F7E",
  "jmg", "Juan Manuel Galán", "#BE1100",
  "jcp", "Juan Carlos Pinzón", "#23C062",
  "pv", "Paloma Valencia", "#63B9E9",
  "cl", "Claudia López", "#00B399",
  "ep", "Enrique Peñalosa","#0BDA51",
  "jdo", "Juan Daniel Oviedo","#F0E60D",
  "voto_blanco","Voto en blanco", "#FFFFFF",
  "ns_nr", "No sabe-No responde", "#EAECF0",
  "ruido","Ruido","black"
  )

encuestas_2026 <- readr::read_csv(here("elecciones","2026-colombia","2026-01-26-entrada","encuestas_2026.csv")) |>
  dplyr::mutate(
    fecha = lubridate::mdy(fecha),
    encuesta_id = 1:dplyr::n(),
    encuestadora = factor(encuestadora),
    cand_ruido = 1 - rowSums(dplyr::across(-c("fecha","encuesta_id", "encuestadora", "muestra", "voto_blanco","ns_nr")), na.rm = TRUE)) |>
  tidyr::pivot_longer(
    cols = tidyselect::starts_with("cand"),
    names_to = "candidato",
    values_to = "int_voto") 

# Datos para grafica ####
datos_entrada <- encuestas_2026 |>
  dplyr::filter(candidato %in% c("cand_ic", "cand_adle", "cand_pv", "cand_sf", "cand_cl")) |>
  dplyr::mutate(candidato = stringr::str_sub(candidato, start = 6L)) |>
  dplyr::left_join(candidatos_df, by = c("candidato" = "cod")) |>
  dplyr::filter(candidato != "ruido", !is.na(int_voto))

# LOESS por candidato (grilla densa para curva suave) ####
loess_entrada <- datos_entrada |>
  dplyr::group_by(nombre) |>
  dplyr::filter(dplyr::n() >= 3) |>
  dplyr::group_modify(~{
    fit <- stats::loess(int_voto ~ as.numeric(fecha), data = .x)
    fecha_grid <- seq(min(.x$fecha), max(.x$fecha), by = "day")
    tibble::tibble(
      fecha = fecha_grid,
      int_voto = stats::predict(fit, newdata = data.frame(fecha = as.numeric(fecha_grid)))
    )
  }) |>
  dplyr::ungroup()

# Grafica ####
entrada_2026 <- datos_entrada |>
  ggplot2::ggplot(ggplot2::aes(x = fecha, y = int_voto, color = nombre)) +
  ggplot2::geom_line(data = loess_entrada,
                     ggplot2::aes(x = fecha, y = int_voto, color = nombre, group = nombre),
                     linetype = "dotdash", linewidth = 0.8, show.legend = FALSE) +
  ggplot2::geom_point(ggplot2::aes(shape = encuestadora,
                                   text = paste0(nombre, ": ", scales::percent(int_voto, accuracy = 0.1),
                                                 "<br>", encuestadora, " (", format(fecha, "%d-%b"), ")")),
                      size = 4, alpha = 0.85) +
  ggplot2::scale_color_manual(values = setNames(candidatos_df$color_cand, candidatos_df$nombre)) +
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::guides(shape = "none") +
  ggplot2::labs(x = NULL, y = "Intención de voto", color = NULL) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "bottom")

#ggplotly ####
plotly::ggplotly(entrada_2026, tooltip = "text") |>
  plotly::layout(
    legend = list(orientation = "h", y = -0.15, x = 0.5, xanchor = "center"),
    xaxis = list(
      rangeslider = list(visible = TRUE, thickness = 0.04),
      rangeselector = list(
        buttons = list(
          list(step = "all", label = "Todo"),
          list(count = 3, step = "month", stepmode = "backward", label = "3m"),
          list(count = 1, step = "month", stepmode = "backward", label = "1m")
        )
      )
    )
  )

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🍽️ Entrada, las sobrevivientes},
  date = {2026-01-28},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-26-entrada/2026-entrada.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🍽️ Entrada, las sobrevivientes.” January 28. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-26-entrada/2026-entrada.html.
]]> encuestas candidatos encuestadoras cne https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-26-entrada/2026-entrada.html Tue, 27 Jan 2026 23:00:00 GMT 🥑 Ajiaco2 Recetas Electorales https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-28-ajiaco2/2026-ajiaco2.html

“Failure is a favor to the future.”
–Rita Dove

Introduciendo el Ajiaco2

El Ajiaco2 es un modelo probabilístico que las Recetas Electorales han tratado de preparar desde hace 5 años. Es complejo, pero funciona divínamente. Es el motor inferencial para la primera vuelta.

Es un modelo que procesa simultáneamente todas las encuestas como un proceso Dirichlet-multinomial, de manera que se preserven las cotas de que los posibles candidatos no tengan probabilidades absurdas de pasar a la segunda vuelta. Esto es mucho más difícil de lo que parece, y hay que hacer ciertos supuestos importantes como imputaciones de los conteos de las encuestas con base en las proporciones reportadas en las fichas técnicas. De cualquier forma, el nuevo Ajiaco2 supera las limitaciones de la receta de 2022 y se puede servir completo.

Veamos los resultados de la más reciente estimación del Ajiaco2 Figura 1 para los candidatos a la primera vuelta luego de las consultas del 13 de marzo:

Ver código
# Graph posterior ####
ajiaco2_fit |>
  posterior::as_draws_df() |>
  tibble::as_tibble() |>
  dplyr::rename_with(
    ~ paste0("p_", colnames(conteos_2026)),
    .cols = paste0("p[", seq_along(colnames(conteos_2026)), "]")
  ) |>
  tidyr::pivot_longer(cols = dplyr::starts_with("p"),
                      names_to = "candidato", values_to = "prop") |>
  dplyr::mutate(candidato = stringr::str_sub(candidato, start = 8L)) |>
  dplyr::group_by(candidato) |>
  dplyr::mutate(candidato_m = mean(prop), .group_by = "drop") |>
  # Nombres
  dplyr::left_join(
    candidatos_2026,
    by = c("candidato"="cod")
  ) |>
  # Quitar ruido
  dplyr::filter(candidato != "ruido") |>
  ggplot2::ggplot(ggplot2::aes(x = prop, y = reorder(nombre, candidato_m))) +
  ggdist::stat_dist_slabinterval(
    ggplot2::aes(
      fill = color_cand,
      fill_ramp = ggplot2::after_stat(level)
      ),
    .width = c(0.5, 0.8, 0.95, 0.99),
    interval_alpha = 0.95,
    show.legend = c(fill = FALSE, fill_ramp = TRUE, size = FALSE)
  ) +
  ggdist::stat_pointinterval(
    ggplot2::aes(label = scales::percent(candidato_m, accuracy = 0.1)),
  geom = "label",
  .width = 0,
  vjust = -0.5,
  fill = "white",
  color = "black"
  )+
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  ggplot2::scale_y_discrete(labels = scales::label_wrap(20))+
  ggplot2::scale_fill_identity(na.translate = FALSE)+
  ggdist::scale_fill_ramp_discrete(
    name   = "Credible interval",
    range  = c(0.25, 1),
    breaks = c(0.5, 0.8, .95, 0.99),
    labels = c("50%", "80%", "95%", "99%"),
    na.translate = FALSE
  )+
  ggplot2::labs(
    title = "Ajiaco2: Modelo probabilístico para la primera vuelta 2026",
    subtitle = paste0("Estimado ", Sys.Date(), " con ", dplyr::n_distinct(encuestas_2026$encuesta_id)," encuestas"),
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = "Distribución posterior estimada, % intención de voto",
    y = NULL
  )+
  ggplot2::theme_minimal(base_size = 20) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    panel.grid.major.y = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position = "none"
  )
Figura 1: Ajiaco2

Evolución acumulada

La siguiente animación muestra cómo el Ajiaco2 actualiza sus estimaciones a medida que llegan nuevas encuestas, desde marzo hasta mayo 2026.

Ajiaco2: evolución acumulada de la distribución posterior

Ajiaco2: evolución acumulada de la distribución posterior

Valencia o De la Espriella? Las probabilidades

Una ventaja del enfoque bayesiano es que las comparaciones directas entre candidatos son inmediatas, solo hay que calcular la fracción de muestras en los que la proporción de un candidato supera la del otro. No hay prueba de hipótesis, ni p-values, ni carreta frecuentista: solo probabilidades posteriores.

Según el Ajiaco2 a 19 Mayo 2026, la probabilidad posterior de que Paloma Valencia obtenga más votos que De la Espriella en primera vuelta es 3.2%.

Ver código
library(ggtext)

draws_comp |>
  dplyr::select(p_cand_pv, p_cand_adle, .draw) |>
  tidyr::pivot_longer(
    cols = c(p_cand_pv, p_cand_adle),
    names_to = "candidato",
    values_to = "prop"
  ) |>
  dplyr::mutate(
    color_cand = dplyr::case_when(
      candidato == "p_cand_pv" ~ "#63B9E9",
      candidato == "p_cand_adle" ~ "#000066"
    )
  ) |>
  ggplot2::ggplot(ggplot2::aes(x = prop, fill = color_cand)) +
  ggplot2::geom_density(alpha = 0.55, color = NA) +
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  ggplot2::scale_fill_identity(
    guide = "legend",
    labels = c("#63B9E9" = "Paloma Valencia", "#000066" = "De la Espriella"),
    breaks = c("#63B9E9", "#000066")
  ) +
  ggtext::geom_richtext(
    data = tibble::tibble(x = Inf, y = Inf),
    ggplot2::aes(
      x = x, y = y,
      label = sprintf(
        "<b>P(Paloma > De la Espriella) = <span style='color:#63B9E9'>%.1f%%</span></b>",
        prob_pv_gt_adle * 100
      )
    ),
    inherit.aes  = FALSE,
    hjust        = 1.1,
    vjust        = 1.5,
    size         = 7,
    family       = "news-cycle",
    fill         = "#F8F9FA",
    color        = "#212529",
    label.color  = NA,
    label.padding = ggplot2::unit(c(0.4, 0.6, 0.4, 0.6), "lines")
  ) +
  ggplot2::labs(
    title = "Paloma Valencia vs. De la Espriella: distribuciones posteriores",
    subtitle = "Modelo Ajiaco2 — primera vuelta 2026",
    x = "Distribución posterior estimada, % intención de voto",
    y = "Densidad",
    fill = NULL,
    caption = "Fuente: https://recetas-electorales.netlify.app/"
  ) +
  ggplot2::theme_minimal(base_size = 24) +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle"),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position = "top"
  )
Figura 2: Distribuciones posteriores de Paloma Valencia y De la Espriella.

Descifrando porcentajes y probabilidades en el Ajiaco2

Es relativamente fácil interpretar el Ajiaco2, así que ilustremos para uno de los punteros Figura 3. Cada curva muestra la distribución posterior de la proporción de voto del candidato, estimada a partir del modelo Dirichlet-multinomial. Por ejemplo, para @IvanCepedaCast la mayor densidad se concentra alrededor del 36%, lo que indica que este es el valor más compatible con las encuestas observadas. El modelo sugiere que la probabilidad posterior de que la intención de voto sea inferior al 25% es prácticamente nula y que sea mayor a 50%, lo que necesitaría un candidato para ganar en primera vuelta, es también nula.

El intervalo creíble del 50% pone la intención de voto entre 34% y 37%, mientras que el intervalo de 95% se extiende desde cerca de 31% hasta 40%, lo que refleja la incertidumbre que resulta de la heterogeneidad de las encuestas disponibles.

Ver código
# Graph posterior ####
ajiaco2_fit |>
  posterior::as_draws_df() |>
  tibble::as_tibble() |>
  dplyr::rename_with(
    ~ paste0("p_", colnames(conteos_2026)),
    .cols = paste0("p[", seq_along(colnames(conteos_2026)), "]")
  ) |>
  tidyr::pivot_longer(cols = dplyr::starts_with("p"),
                      names_to = "candidato", values_to = "prop") |>
  dplyr::mutate(candidato = stringr::str_sub(candidato, start = 8L)) |>
  # Nombres
  dplyr::left_join(
    candidatos_2026,
    by = c("candidato"="cod")
  ) |>
  dplyr::filter(candidato %in% c("ic")) |>
  ggplot2::ggplot(ggplot2::aes(x = prop)) +
  ggdist::stat_dist_slabinterval(
    ggplot2::aes(
      fill = color_cand,
      fill_ramp = ggplot2::after_stat(level)
      ),
    .width = c(0.5, 0.95, 0.99),
    interval_alpha = 0.95,
    show.legend = c(fill = FALSE, fill_ramp = TRUE, size = FALSE)
  ) +
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1))+
  ggplot2::scale_fill_identity(na.translate = FALSE)+
  ggdist::scale_fill_ramp_discrete(
    name   = "Credible interval",
    range  = c(0.25, 1),
    breaks = c(0.5, .95, 0.99),
    labels = c("50%", "95%", "99%"),
    na.translate = FALSE
  )+
  ggplot2::labs(
    title = "Interpretando el Ajiaco2 para @IvanCepedaCast",
    subtitle = paste0("Modelo probabilístico estimado", Sys.Date(), " con ", dplyr::n_distinct(encuestas_2026$encuesta_id)," encuestas"),
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = "% intención de voto estimada",
    y = "Probabilidad"
  )+
  ggplot2::theme_minimal() +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle", size = 20),
    panel.grid.major.y = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position = "top"
  )
Figura 3: Interpretando el Ajiaco2

El ajiaco viene con ñapa para explorar interactivamente el modelo Ajiaco2. Selecciona un candidato y un umbral de intención de voto para ver probabilidades posteriores.

Retrovisor: El Ajiaco de 2022 quedó aguado. ¿Qué falló?

En 2022 salió la primera versión de Ajiaco, que en su momento buscaba solucionar un problema técnico complejo en el análisis de encuestas: ¿Cómo se pueden representar correctamente las probabilidades de candidatos que compiten en la primera vuelta? Para solucionar el problema era necesario usar distribuciones de probabilidad un tanto complejas; tal vez más complicado aún era determinar la parametrización de esas funciones.

El Ajiaco en 2022 buscó estimar simuláneamente la proporción de votos para cada candidato teniendo en cuenta las proporciones de voto blanco e indeciso, y trató de proyectar la incertidumbre que hay en cada votación sin romper el techo que mantiene acotadas las proporciones para que nunca sumen menos de cero o más de cien por ciento.

Fracasó: el Ajiaco de 2022 quedó aguado. No logró lo que pretendía y cometió muchos errores, algunos imperdonables. El modelo avanzó en el uso de la función correcta, una Dirichlet, pero no usó las observaciones a nivel cada encuesta directamente; además ignoró la varianza muestral, las diferencias por encuestadora y el paso del tiempo. El modelo usó estimaciones de promedios por candidato para simular a cada candidato. El muestreo MCMC era redundante y no había propagación de la incertidumbre como se pensaba. Metodológicamente no fue un modelo predictivo inferencial porque fijaba arbitrariamente el tamaño de muestra () de resultados de las encuestas existentes.

Mea culpa. Estas cosas son dificiles de hacer y se hizo lo que se pudo en 2022. Pero como dice la poeta Rita Doves, el error del pasado al menos nos ayudó a solucionar el problema del presente.

El modelo corregido se puede aplicar a la primera vuelta de 2022. El resultado Figura 4 es similar: Las encuesta no detectaron la subida de Rodolfo Hernandez por la veda.

Ver código
# ggdist ####
ajiaco2_retro2022_fit |>
  posterior::as_draws_df() |>
  tibble::as_tibble() |>
  dplyr::rename_with(
    ~ paste0("p_", colnames(conteos_2022)),
    .cols = paste0("p[", seq_along(colnames(conteos_2022)), "]")
  ) |>
  tidyr::pivot_longer(cols = dplyr::starts_with("p"),
                      names_to = "candidato", values_to = "prop") |>
  dplyr::mutate(cod = stringr::str_remove(candidato,"p_")) |>
  # Nombres
  dplyr::left_join(
    candidatos_2022,
    by = "cod"
  ) |>
  dplyr::filter(cod != "ruido") |>
  dplyr::group_by(candidato) |>
  dplyr::mutate(candidato_m = median(prop), .group_by = "drop") |>
  ggplot2::ggplot(ggplot2::aes(x = prop, y = reorder(nombre, candidato_m))) +
  ggdist::stat_dist_slabinterval(
    ggplot2::aes(
      fill = color_cand,
      fill_ramp = ggplot2::after_stat(level)
      ),
    .width = c(0.5, 0.8, 0.95, 0.99),
    interval_alpha = 0.95,
    show.legend = c(fill = FALSE, fill_ramp = TRUE, size = FALSE)
  ) +
  ggdist::stat_pointinterval(
    ggplot2::aes(label = scales::percent(candidato_m, accuracy = 0.1)),
    geom = "label",
    .width = 0,
    vjust = -0.5,
    size = 3,
    fill = "white",
    color = "black"
    )+
  ggplot2::geom_vline(data = . %>% dplyr::distinct(cod, nombre, vuelta_1, color_cand),
             ggplot2::aes(color = color_cand, xintercept = vuelta_1, label = nombre), linetype = "dashed", show.legend = FALSE)+
  ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  ggplot2::scale_fill_identity(na.translate = FALSE)+
  ggplot2::scale_color_identity(na.translate = FALSE)+
  ggdist::scale_fill_ramp_discrete(
    name   = "Credible interval",
    range  = c(0.25, 1),
    breaks = c(0.5, 0.8, .95, 0.99),
    labels = c("50%", "80%", "95%", "99%"),
    na.translate = FALSE
  )+
  ggplot2::labs(
    title = "Ajiaco2 cocinado con los ingredientes de la primera vuelta de 2022",
    subtitle = "Modelo retrospectivo 2022 con base en 32 encuestas",
    caption = "Fuente: https://recetas-electorales.netlify.app/",
    x = "% intención de voto estimada",
    y = NULL
  )+
  ggplot2::theme_minimal() +
  ggplot2::theme(
    text = ggplot2::element_text(family = "news-cycle", size = 20),
    panel.grid.major.y = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    legend.position = "top"
  )
Figura 4: Ajiaco2 recalentado con los ingredientes de la primera vuelta de 2022

Receta Ajiaco2

El Ajiaco2 agrega encuestas como un vector de conteos por candidato que se modela como un proceso Dirichlet-Multinomial con un tamaño de muestra , que corresponde a la muestra de cada encuesta.

La lógica del modelo es que existe una distribución de apoyo a los candidatos (las proporciones ), común a todas las encuestas, y que cada encuesta es una realización ruidosa de esa distribución. Muy similar a los métodos de meta análisis. El parámetro de concentración controla qué tan similares son las encuestas entre sí: valores altos implican encuestas muy parecidas y valores bajos permiten mayor variabilidad. El modelo produce no solo estimaciones de apoyo para cada candidato, sino también simulaciones de resultados de encuestas hipotéticas, lo que permite evaluar la incertidumbre y la coherencia del modelo con los datos observados.

Agárrese que el modelo es complicado pero se puede describir, con ayuda de un LLM para el Latex, de la siguiente manera:

Modelo

Abajo se describe el modelo en Stan.

Ver código
data {
  int<lower=1> J;                     // encuestas
  int<lower=2> K;                     // candidatos
  array[J] int<lower=0> n;            // tamaño muestral
  array[J, K] int<lower=0> Y;         // conteos Y[j, k]
}

parameters {
  simplex[K] p;                   // preferencias pooled
  real<lower=0> kappa;            // concentración DM
}

model {
  // priors
  p ~ dirichlet(rep_vector(1.0, K));    // relativamente débil
  kappa ~ lognormal(log(200), 0.7);    // centrado en 200

  // likelihood
  for (j in 1:J) {
    Y[j] ~ dirichlet_multinomial(kappa * p);
  }
}

generated quantities {
  vector[K] alpha = kappa * to_vector(p);
  array[J, K] int Y_rep;              // conteos
  for (j in 1:J) {
    Y_rep[j] = dirichlet_multinomial_rng(alpha, n[j]);
  }
}

Estimación

Usamos cmdstanr para estimar el modelo luego de transformar las proporciones reportadas en las fichas técnicas de las encuestas en conteos sobre la muestra de cada encuesta. Por ejemplo, si un candidato marcó 20% de la intención de voto en una encuesta de 2 000 personas, el conteo es 400.

Luego la maravilla de compiladores se encargan de estimar el modelo.

El muestreo funciona bien:

Ver código
bayesplot::mcmc_trace(ajiaco2_fit$draws(),  pars = ggplot2::vars(tidyselect::starts_with("p[")))

Resultados

Ahora miremos los parametros:

Ver código
ajiaco2_fit$summary(variables = c("p", "kappa"))
# A tibble: 7 × 10
  variable    mean  median       sd      mad      q5      q95  rhat ess_bulk
  <chr>      <dbl>   <dbl>    <dbl>    <dbl>   <dbl>    <dbl> <dbl>    <dbl>
1 p[1]      0.375   0.375   0.0141   0.0140   0.352    0.399  1.00    25364.
2 p[2]      0.231   0.231   0.0123   0.0121   0.211    0.252  1.00    19738.
3 p[3]      0.196   0.196   0.0117   0.0117   0.177    0.215  1.00    21774.
4 p[4]      0.0406  0.0403  0.00551  0.00551  0.0320   0.0500 1.00    16067.
5 p[5]      0.0295  0.0293  0.00461  0.00457  0.0223   0.0374 1.000   18235.
6 p[6]      0.128   0.127   0.00958  0.00938  0.112    0.143  1.000   21039.
7 kappa    93.1    92.1    16.6     16.4     67.8    122.     1.00    15470.
# ℹ 1 more variable: ess_tail <dbl>

Cómo citar

BibTeX
@online{recetas_electorales2026,
  author = {{Recetas Electorales}},
  title = {🥑 Ajiaco2},
  date = {2026-01-28},
  url = {https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-28-ajiaco2/2026-ajiaco2.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2026. “🥑 Ajiaco2.” January 28. https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-28-ajiaco2/2026-ajiaco2.html.
]]> encuestas dirichlet probabilístico multinomial cmdstanr https://www.recetas-electorales.com/elecciones/2026-colombia/2026-01-28-ajiaco2/2026-ajiaco2.html Tue, 27 Jan 2026 23:00:00 GMT 🍰 Postre logístico Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-06-10-postre-2022/2022-postre.html

“There is no inference without assumption, but do not choose your assumptions for the sake of inference. Build complex models one piece at a time. Be critical. Be kind.”
– Richard McElreath

El Postre 2022 estima qué tan probable es que gane Gustavo Petro. A diferencia del Ajiaco, el Postre solo hace una transformación logística a un modelo sencillo que se puede interpretar como un pronóstico probabilístico para la segunda vuelta.

Veamos cómo se prepara.

Postre Logístico 2022

Este nuevo Postre recoge la probabilidad de que Gustavo Petro sea presidente, estimada por el modelo que se describe abajo.

Las probabilidades se obtienen de muchas simulaciones de cada uno de los parámetros del modelo, y luego calcular la mediana de la densidad que resulta de esas simulaciones.

En estas primeras estimaciones la densidad es bimodal, porque las encuestas se contradicen: las telefónicas dan como ganador a Hernandez, mientras que las presenciales dan como ganador a Petro.

ImportanteCarrera apretada, según el modelo basado en las encuestas

Segun la más reciente estimación, Gustavo Petro tiene más o menos 45% de probabilidad de ganar

Ver código
library(rethinking)
library(RColorBrewer)
library(lubridate)
library(tidyverse)
library(rstan)

# ponderador LSV ####
lsv_semaforo <- tibble::tribble(~encuestadora,~semaforo,
                          "CNC",7.1,
                          "Invamer",10,
                          "GAD3",7,
                          "AtlasIntel",7.5,
                          "MassiveCaller",5.6,
                          "YanHaas",5.5,
                          "Guarumo",8.9,
                          "TYSE",5.5,
                          "CELAG",5.1)

# Encuestas ####
postre2022_encuestas <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>% 
  dplyr::select(n,fecha,encuestadora,muestra,gustavo_petro,rodolfo_hernandez,tipo) %>%
  dplyr::filter(fecha>=lubridate::as_date("2022-05-29")) %>%
  dplyr::mutate(gp=gustavo_petro*muestra/100,
                rh=rodolfo_hernandez*muestra/100,
                encuestadora =factor(encuestadora)) %>%
  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(gp_win = ifelse(gp>rh,1,0),
                rh_win = ifelse(gp<rh,1,0)) %>% 
  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))

# Numero de encuestas disponibles
postre2022_disponibles <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>%
  dplyr::filter(lubridate::as_date(fecha) >= lubridate::as_date("2022-05-30")) %>%
  dplyr::tally() %>%
  as.numeric()

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

# Postre ulam Petro ####
postre2022_ulam_gp <- rethinking::ulam(
  alist(
    #modelo
    gp ~ dbinom(muestra,p),
    logit(p) <- a[encuestadora] + b1*dd + b2*tipo_1,
    #priors
    a[encuestadora] ~ dnorm(a,s),
    a ~ dnorm(45,5),
    b1 ~ dnorm(0,5),
    b2 ~ dnorm(0,5),
    s ~ dcauchy(0,5)
  ),
  data=list(
    N = postre2022_disponibles,
    encuestadora = postre2022_encuestas$encuestadora,
    muestra = postre2022_encuestas$muestra,
    dd = postre2022_encuestas$dd,
    tipo_1 = postre2022_encuestas$tipo_1,
    gp= postre2022_encuestas$gp
    ),
  control=list(adapt_delta=0.96),
  iter=5000, 
  warmup=1000, 
  chains=4, 
  cores=4,
  log_lik=TRUE)

# Postre ulam Hernandez ####
postre2022_ulam_rh <- rethinking::ulam(
  alist(
    #modelo
    rh ~ dbinom(muestra,p),
    logit(p) <- a[encuestadora] + b1*dd + b2*tipo_1,
    #priors
    a[encuestadora] ~ dnorm(a,s),
    a ~ dnorm(47,5),
    b1 ~ dnorm(0,5),
    b2 ~ dnorm(0,5),
    s ~ dcauchy(0,5)
  ),
  data=list(
    N = postre2022_disponibles,
    encuestadora = postre2022_encuestas$encuestadora,
    muestra = postre2022_encuestas$muestra,
    dd = postre2022_encuestas$dd,
    tipo_1 = postre2022_encuestas$tipo_1,
    rh= postre2022_encuestas$rh
    ),
  control=list(adapt_delta=0.96),
  iter=5000, 
  warmup=1000, 
  chains=4, 
  cores=4,
  log_lik=TRUE)
Ver código
library(rethinking)
library(tidyverse)
library(RColorBrewer)

# Estimar prob 50% para incluir en grafico 
prob_win_gp <- postre2022_ulam_gp %>% 
  rethinking::link(n=20000) %>% 
  tibble::as_tibble() %>% 
  tidyr::pivot_longer(cols = dplyr::everything(), names_to = "poll_n", values_to = "estimate") %>% 
  dplyr::summarize(m = median(estimate),
                   p10 = quantile(estimate,prob=0.1),
                   p90 = quantile(estimate,prob=0.9)) %>%
  dplyr::select(m) %>%
  as.numeric()

prob_win_rh <- postre2022_ulam_rh %>% 
  rethinking::link(n=20000) %>% 
  tibble::as_tibble() %>% 
  tidyr::pivot_longer(cols = dplyr::everything(), names_to = "poll_n", values_to = "estimate") %>% 
  dplyr::summarize(m = median(estimate),
                   p10 = quantile(estimate,prob=0.1),
                   p90 = quantile(estimate,prob=0.9)) %>%
  dplyr::select(m) %>%
  as.numeric()


#postre logis
postre2022_ulam_gp %>% 
  rethinking::link(n=20000) %>% 
  tibble::as_tibble() %>% 
  tidyr::pivot_longer(cols = dplyr::everything(), names_to = "poll_n", values_to = "estimate") %>% 
  ggplot2::ggplot()+
  ggplot2::geom_density(ggplot2::aes(x=estimate),fill="#800080",color="grey60", alpha=0.8)+
  ggplot2::geom_vline(xintercept = prob_win_gp, color="gold", linetype="dashed", size=1.2)+
  ggplot2::annotate("text",x=0.38,y=15,
           color="#800080",
           label=paste0("Probabilidad de ganar: ",round(100*prob_win_gp, digits = 0),"%"))+
  ggplot2::labs(x="Densidad de probabilidad de sacar mas de 50% de la votación",
       y="Frecuencia simulacion distribucion posterior",
       title=paste0("Postre Logístico para Gustavo Petro a 2022-06-10"), 
       subtitle=paste0("20.000 simulaciones del modelo logístico para la 2da vuelta","\nBasado en ",postre2022_disponibles," encuestas"), 
       caption = "Fuente: www.recetas-electorales.com")+
  ggplot2::theme(legend.position = "none",
        panel.background = ggplot2::element_blank())+
  ggplot2::xlim(c(0.35,0.55))

Postre logístico 2022 para Gustavo Petro

Postre logístico 2022 para Gustavo Petro

Ingredientes

Los únicos ingredientes de esta receta son las encuestas que han salido desde la primera vuelta. Como priors se toman los promedios y desviaciones estándar de cada candidato.

Ver código
library(tidyverse)
library(lubridate)
library(kableExtra)

# Kable
readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv") %>% 
  dplyr::select(n,fecha,encuestadora,muestra,gustavo_petro,rodolfo_hernandez) %>%
  dplyr::filter(fecha>=lubridate::as_date("2022-05-29")) %>% 
  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=="rodolfo_hernandez" ~ "Rodolfo Hernandez")) %>%
  dplyr::group_by(nombres) %>% 
  dplyr::summarize(#promedio_prior = mean(int_voto),
                   promedio_ponderado_t = weighted.mean(int_voto,w=as.numeric(fecha)),
                   sd_prior = sd(int_voto)) %>%  
  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::row_spec(1,bold=TRUE, background = "#800080", color = "white") %>%
  kableExtra::row_spec(2,bold=TRUE, background = "#F7BE0A", color = "black") %>%
  kableExtra::footnote(number = c(paste0("Fecha: 2022-05-21"),
                      paste0("Encuestas disponibles: ",postre2022_disponibles)))
Priors por candidato
Candidato
Gustavo Petro 45.0 2.5
Rodolfo Hernandez 46.6 5.9
1 Fecha: 2022-05-21
2 Encuestas disponibles: 13

Postre 2022: Priors

Receta

El Postre modela directamente las encuestas como una distribución binomial donde cada encuesta es un ensayo:

donde es la muestra de cada encuesta y es la proporción de la intención de voto para Petro. La proporción de intención de voto se determina a través de una función logística (log-link function) y, como es costumbre en este recetario, efectos aleatorios por encuestadora, la duración entre la encuesta y la estimación y una dummy para el tipo de encuestas (i.e. telefónica, presencial) así:


Preparación


Este es el postre completo, con los priors del caso:

Estimación con ulam

El modelo estimado con ulam de McElreath a continuación:

Ver código
library(rethinking)

# Modelo logístico en map2stan:
postre2022_ulam <- rethinking::ulam(
  alist(
    #modelo
    gp ~ dbinom(muestra,p),
    logit(p) <- a[encuestadora] + b1*dd + b2*tipo_1,
    #priors
    a[encuestadora] ~ dnorm(a,s),
    a ~ dnorm(45,5),
    b1 ~ dnorm(0,5),
    b2 ~ dnorm(0,5),
    s ~ dcauchy(0,5)
  ),
  data=list(
    N = postre2022_disponibles,
    encuestadora = postre2022_encuestas$encuestadora,
    muestra = postre2022_encuestas$muestra,
    dd = postre2022_encuestas$dd,
    tipo_1 = postre2022_encuestas$tipo_1,
    gp= postre2022_encuestas$gp
    ),
  control=list(adapt_delta=0.96),
  iter=1e4, 
  warmup=1000, 
  chains=4, 
  cores=4,
  log_lik=TRUE)

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🍰 Postre logístico},
  date = {2022-06-05},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-06-10-postre-2022/2022-postre.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🍰 Postre logístico.” June 5. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-06-10-postre-2022/2022-postre.html.
]]> logístico probabilidad pronósticos elecciones https://www.recetas-electorales.com/elecciones/2022-colombia/2022-06-10-postre-2022/2022-postre.html Sat, 04 Jun 2022 22:00:00 GMT ☕ Café post-electoral Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-31-cafe-2022/2022-cafe.html

“Everything is obvious –once you know the answer”
–Duncan Watts

Lista la primera vuelta: Gustavo Petro obtuvo 40% de la votación, seguido por la sorpresa de la jornada Rodolfo Hernández con 28%. Federico Gutierrez obtuvo 25%, y Sergio Fajardo 4%.

Aplicando la fórmula de 🥇 Recetas Abiertas, todas las recetas que ponderaron más el pasado inmediato tuvieron relativamente un mejor desempeño. De las 8 recetas incluídas en el Sancocho 2022 a las que mejor les fue: En primera vuelta, un promedio simple sin ponderacion de las encuestas y La Silla Vacia1 tuvieron el mejor desempeño, y en segunda vuelta un modelo ensamble de @PoliticaConDato.

ImportanteCon base en los resultados del escrutinio y solo teniendon en cuenta lo pronósticos abiertos y documentados, La Silla Vacia hizo el mejor pronóstico en la 1era vuelta y @PoliConDato en la 2da vuelta
Ver código
library(tidyverse)
library(plotly)
library(here)

# Parametros ####
shape_cafe_2022 <- c(
  "Encuestas" = 6,
  "@PoliticaConDato" = 15,
  "@ColombiaRisk" = 17,
  "Simple 2022" = 15,
  "Mixto 2022" = 16,
  "Ajiaco" = 5,
  "@JorgeGalindo El Pais" = 16,
  "La Silla Vacia" = 6,
  "@calc_electoral" = 1,
  "Resultado" = NULL
  )

colors_cafe_2022 <- c(
  "Encuestas" = "purple3",
  "@PoliticaConDato" = "blue",
  "@ColombiaRisk" = "gold2",
  "Simple 2022" = "orangered",
  "Mixto 2022" = "orangered",
  "Ajiaco" = "orangered",
  "@JorgeGalindo El Pais" = "green4",
  "La Silla Vacia" = "darkturquoise",
  "@calc_electoral" = "royalblue2",
  "Resultado" = "#ff4800"
  )

# Cafe plot ####
cafe_2022_plot <- readr::read_csv(here("elecciones","2022-colombia","2022-05-31-cafe-2022","sancocho_resultados.csv")) %>%
  dplyr::filter(!is.na(nombres), nombres!="Voto en blanco") %>%
  dplyr::mutate(nombres = factor(nombres, levels=c("Gustavo Petro","Rodolfo Hernandez","Federico Gutierrez","Sergio Fajardo"))) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(dplyr::desc(nombres)),y=pronostico))+
  ggplot2::geom_point(data=. %>% dplyr::filter(plato!="Resultado"),
             ggplot2::aes(shape=plato,
                 text = paste("Estimado por: ", plato,
                              "\nValor estimado: ",paste(round(pronostico, digits = 2)," %")),
                 color=plato),
             size=4,
             position = position_dodge(0.5),
             show.legend = FALSE)+
  ggplot2::geom_errorbar(data=. %>% dplyr::filter(plato!="Resultado"),
              ggplot2::aes(ymax=high,ymin=low,
                  color=plato),
              position = position_dodge(0.5),width=0.3, show.legend = FALSE)+
  # Resultados
  ggplot2::geom_col(data=. %>% dplyr::filter(plato=="Resultado"),
           ggplot2::aes(text = paste0("Resultado ",nombres,": ", paste(round(pronostico, digits = 2)," %"))),
           alpha=0.4, fill="#ff4800", show.legend = FALSE)+
  ggplot2::theme(legend.position = "none",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        strip.text.x = ggplot2::element_text(size = 8),
        axis.text=ggplot2::element_text(size=11),
        axis.ticks.x=ggplot2::element_blank(),
        axis.text.x=ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x=NULL,y="\n% Votos validos vs % Votos estimados",
       title="Cafe post electoral 2022 - Primera vuelta",
       subtitle="Pronósticos (puntos) vs Resultados (barra)",
       caption="\nFuente: www.recetas-electorales.com")+
  ggplot2::scale_shape_manual(values=shape_cafe_2022)+
  ggplot2::scale_color_manual(values=colors_cafe_2022)+
  ggplot2::coord_flip()

# ggplotly ####
plotly::ggplotly(cafe_2022_plot, tooltip = "text") %>%
   plotly::layout(title = list(text = paste0('Cafe post electoral 2022 - Primara vuelta',
                                    '<br>',
                                    '<sup>',
                                     'Pronosticos (puntos) vs Resultados (barra)','</sup>')))

Café post electoral 2022 - Primera vuelta

Ver código
library(tidyverse)
library(plotly)

# parametros ####
shape_cafe_2022 <- c(
  "Encuestas" = 6,
  "@PoliticaConDato" = 15,
  "@ColombiaRisk" = 17,
  "Simple 2022" = 15,
  "Mixto 2022" = 16,
  "Ajiaco" = 5,
  "@JorgeGalindo El Pais" = 16,
  "La Silla Vacia" = 6,
  "@calc_electoral" = 1,
  "@Scalvo25" = 18,
  "Resultado" = NULL
  )

colors_cafe_2022 <- c(
  "Encuestas" = "purple3",
  "@PoliticaConDato" = "blue",
  "@ColombiaRisk" = "gold2",
  "Simple 2022" = "orangered",
  "Mixto 2022" = "orangered",
  "Ajiaco" = "orangered",
  "@JorgeGalindo El Pais" = "green4",
  "La Silla Vacia" = "darkturquoise",
  "@calc_electoral" = "royalblue2",
  "@Scalvo25" = "gold2",
  "Resultado" = "#ff4800"
  )
library(tidyverse)
library(lubridate)

# Encuestas 2022 ####
encuestas_ulr_2022 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"
encuestas_2022 <- readr::read_csv(encuestas_ulr_2022)

# 0. Resultado 2da vuelta ####
resultado_2da_vuelta_2022 <- tibble::tribble(~pronostico,~nombres,
                     50.44,"Gustavo Petro",
                     47.31,"Rodolfo Hernandez") %>%
  dplyr::mutate(plato = "Resultado")

# 1. Base: promedio de las encuestas ####
encuestas_2da_vuelta_2022 <- encuestas_2022 %>%
  # Filter despues de consultas 
  dplyr::filter(fecha >= lubridate::as_date("2022-05-29")) %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,tidyselect::contains(c("petro","hernandez")),blanco,otros) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>%
  # Promedios
  dplyr::group_by(candidato) %>%
  dplyr::summarise(pronostico = mean(int_voto,na.rm=TRUE),
                   high = max(int_voto,na.rm=TRUE),
                   low = min(int_voto,na.rm=TRUE)) %>%
  dplyr::mutate(plato= paste0("Encuestas"),
                nombres = dplyr::case_when(candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro",
                                    candidato=="blanco" ~ "Voto en blanco",
                                    candidato=="otros" ~ "Otros candidatos",
                                    )
                ) 

# 4. El País ####
elpais_2da_2022 <- readr::read_csv("https://raw.githubusercontent.com/JorgeGalindo/co-elect-2022/main/promedio_evol_2av.csv") %>% 
  dplyr::slice_tail(n=1) %>%
  dplyr::select(gustavo_petro, rodolfo_hernandez) %>%
  tidyr::pivot_longer(cols = dplyr::everything(),names_to = "candidato",values_to = "pronostico") %>%
  dplyr::mutate(plato= "@JorgeGalindo El Pais",
                nombres = dplyr::case_when(candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    )
                ) 
  
# 5. La Silla Vacia ####
lsv_2022_2da <- tibble::tribble(~pronostico,~nombres,
                     47.2,"Gustavo Petro",
                     46.5,"Rodolfo Hernandez",
                     4,"Voto en blanco") %>%
  dplyr::mutate(plato = "La Silla Vacia")

# 6. PoliticaConDato ####
politicacondato_2da_2022 <- tibble::tribble(~pronostico,~nombres,~high,~low,
                     48.3,"Gustavo Petro",54.1,44.8,
                     47.3,"Rodolfo Hernandez",50.7,41.4) %>%
  dplyr::mutate(plato = "@PoliticaConDato")

# 8. Calculo Electoral ####
calculo_electoral_2da_2022 <- tibble::tribble(~nombres,~pronostico,~low,~high,
                     "Gustavo Petro",48,NA,NA,
                     "Rodolfo Hernandez",47.3,NA,NA
                     ) %>%
  dplyr::mutate(plato = "@calc_electoral")
  
# 9 Sergio Calvo
sergio_calvo_2da_2022 <-  tibble::tribble(~nombres,~pronostico,~low,~high,
                     "Gustavo Petro",48.19,50.83,44.36,
                     "Rodolfo Hernandez",47.69,53.98,40.24
                     ) %>%
  dplyr::mutate(plato = "@Scalvo25")


# Preparar cafe 2da vuelta ####
cafe2022_2da_vuelta <- dplyr::bind_rows(
                             resultado_2da_vuelta_2022,
                             encuestas_2da_vuelta_2022,
                             elpais_2da_2022,
                             lsv_2022_2da,
                             politicacondato_2da_2022,
                             sergio_calvo_2da_2022,
                             calculo_electoral_2da_2022
                             ) %>%
  dplyr::select(plato,nombres,pronostico,high,low) %>%
  dplyr::mutate(nombres = factor(nombres, levels=c("Gustavo Petro","Rodolfo Hernandez")),
                plato = factor(plato,levels = c("Resultado","@JorgeGalindo El Pais","La Silla Vacia","@PoliticaConDato","@calc_electoral","@Scalvo25","Encuestas"))) 

# Cafe 2nda vuelta ####
cafe2022_2da_vuelta_plot <- cafe2022_2da_vuelta %>%
  dplyr::filter(!stringr::str_detect(nombres,"Blanco|Otros"),!is.na(nombres)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(dplyr::desc(nombres)),y=pronostico))+
  ggplot2::geom_point(data=. %>% dplyr::filter(plato!="Resultado"),
             ggplot2::aes(shape=plato,
                 text = paste('Candidato: ', nombres,
                              '<br>Estimacion: ', round(pronostico, digits=2),
                              '<br>Cocinero: ',plato),
                color=plato),
             size=4,
             position=position_dodge(0.5))+
  ggplot2::geom_errorbar(ggplot2::aes(color=plato,ymax=high,ymin=low),position = position_dodge(0.5),width=0.5, show.legend = FALSE)+
  # Resultados
  ggplot2::geom_col(data=. %>% dplyr::filter(plato=="Resultado"),
           ggplot2::aes(text = paste0("Resultado ",nombres,": ", paste(round(pronostico, digits = 2)," %"))),
           alpha=0.4, fill="cyan", show.legend = FALSE)+
  ggplot2::theme(legend.position = "none",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        strip.text.x = ggplot2::element_text(size = 8),
        axis.text=ggplot2::element_text(size=11),
        axis.ticks.x=ggplot2::element_blank(),
        axis.text.x=ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x=NULL,y="\n% votos pronosticados/estimados por candidato",
       title="Cafe post electoral 2022",
       subtitle="Pronosticos y promedios para la 2da vuelta 2022",
       caption="\nFuente: Cálculos www.recetas-electorales.com")+
  #ggplot2::scale_y_continuous(limits = c(30,60))+
  ggplot2::scale_color_manual(values=colors_cafe_2022)+
  ggplot2::scale_shape_manual(values=shape_cafe_2022)+
  ggplot2::coord_flip()

# ggplotly ####
plotly::ggplotly(cafe2022_2da_vuelta_plot, tooltip = "text") %>%
   plotly::layout(title = list(text = paste0('Cafe post electoral 2022 - Segunda vuelta',
                                    '<br>',
                                    '<sup>',
                                     'Pronosticos (puntos) vs Resultados (barra)','</sup>')))

Café post electoral 2022 - Segunda vuelta

¿Sirvió el 🚦 de encuestadoras de La Silla Vacía?

El semáforo es una evaluación ex ante del desempeño de las encuestadoras basado en algunos atributos deseables, como la transparencia de publicación y la precisión en pasadas elecciones. Fue un insumo también para el ejercicio de promedios ponderados de @JorgeGalindo.

¿Qué poder predictivo tuvo el semáforo? ¿Realmente las encuestadoras con mejor puntaje fueron las más precisas? Usando la misma fórmula de evaluación de las recetas, abajo se muestra la relación entre el score de cada encuestadora y el semáforo para la primera y segunda vuelta.

El semáforo fue un muy buen predictor de los sesgos polling house excepto para las encuestadoras más precisas: AtlasIntel en primera vuelta y GAD3 en segunda vuelta. Es claro que el semáforo le da un puntaje muy bajo a las mejores encuestadoras y muy alto a otras que tal vez no lo merecen.

En el futuro, el semáforo podría tener en cuenta que hay mucha variabilidad interna entre las encuestas que hace cada encuestadora.

Ver código
library(tidyverse)
library(lubridate)
library(RColorBrewer)
library(plotly)
library(ggrepel)

# Encuestas ####
encuestas_ulr_2022 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"
encuestas_2022 <- readr::read_csv(encuestas_ulr_2022)

# 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)
  )
# Resultado 1era vuelta ####
resultado_1era_vuelta_2022 <- tibble::tribble(~pronostico,~nombres,
                     39.84,"Gustavo Petro",
                     23.64,"Federico Gutierrez",
                     4.13,"Sergio Fajardo",
                     27.82,"Rodolfo Hernandez") %>%
  dplyr::mutate(plato = "Resultado")

# Encuestadoras ####
semaforo_1era_2022 <- encuestas_2022 %>%
  dplyr::select(n,fecha,encuestadora,tidyselect::contains("_"), blanco,otros,muestra,merror=margen_error) %>%
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>% 
  dplyr::mutate(e_max = int_voto + merror,
                e_min = int_voto - merror,
                fecha = lubridate::as_date(fecha),
                nombres = dplyr::case_when(
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    ) %>%
                  factor(),
                order_colors = as.numeric(nombres)) %>%
    dplyr::filter(dplyr::between(lubridate::as_date(fecha),
                        #Start
                        lubridate::as_date("2022-03-13"),
                        #End
                        lubridate::as_date("2022-05-28")),
                  !is.na(nombres)) %>%
  dplyr::group_by(nombres,encuestadora)  %>%
  dplyr::summarize(promedio_encuestadora = mean(int_voto, na.rm=TRUE),
                max_encuestadora = max(int_voto, na.rm=TRUE),
                min_encuestadora = min(int_voto, na.rm=TRUE)) %>%
  dplyr::select(pronostico=promedio_encuestadora,high=max_encuestadora,low=min_encuestadora,plato=encuestadora) %>%
  # Join resultados 
  dplyr::left_join(resultado_1era_vuelta_2022 %>%
                     dplyr::select(Resultado=pronostico,nombres),
                   by="nombres") %>%
  # Distancia media pronostico-resultado
  dplyr::mutate(evaluacion = abs(Resultado  - pronostico)) %>%
  dplyr::group_by(plato) %>% 
  dplyr::summarize(score = sum(evaluacion, na.rm = TRUE)) %>%
  # Join semaforo
  dplyr::left_join(tibble::tribble(~plato,~semaforo,
                           "Invamer",10,
                           "CNC",8.1,
                           "Guarumo",7.2,
                           "TYSE",5.7,
                           "YanHaas",5.2,
                           "CELAG",4.7,
                           "AtlasIntel",3.5,
                           "MassiveCaller",2.5
                           ),
                   by="plato") %>%
  # Plot
  ggplot2::ggplot(ggplot2::aes(x=semaforo,y=score))+
  ggplot2::geom_point(data=. %>% dplyr::filter(plato!="Resultado"),
             ggplot2::aes(
               text = paste("Encuestadora: ", plato,
                              "\nScore Recetas Electorales: ", round(score, digits = 2),
                              "\nPuntaje Semaforo La Silla Vacia: ", semaforo),
               color=plato, fill=plato, shape=plato),
             size=4,
             show.legend = FALSE)+
  ggrepel::geom_text_repel(ggplot2::aes(label=plato))+
  ggplot2::geom_smooth(method="lm")+
  ggplot2::theme(legend.position = "none",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        strip.text.x = ggplot2::element_text(size = 8),
        axis.text=ggplot2::element_text(size=11),
        axis.ticks.x=ggplot2::element_blank(),
        axis.text.x=ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="Puntaje Semáforo La Silla Vacía",y="Score evaluación resultados",
       caption="\nFuente: Cálculos www.recetas-electorales.com basados en La Silla Vacía")+
  ggplot2::scale_shape_manual(values=shape_entrada_2022)

# Ggplotly ####
plotly::ggplotly(semaforo_1era_2022, tooltip = "text")

Café post electoral: Evaluación del semáforo de La Silla Vacía

Ver código
library(tidyverse)
library(lubridate)
library(RColorBrewer)
library(ggrepel)

# Resultado 1era vuelta ####
resultado_2da_vuelta_2022 <- tibble::tribble(~pronostico,~nombres,
                     50.44,"Gustavo Petro",
                     47.31,"Rodolfo Hernandez") %>%
  dplyr::mutate(plato = "Resultado")

# Encuestadoras ####
semaforo_2da_2022 <- encuestas_2022 %>%
  dplyr::select(n,fecha,encuestadora,tidyselect::contains("_"), blanco,otros,muestra,merror=margen_error) %>%
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>% 
  dplyr::mutate(e_max = int_voto + merror,
                e_min = int_voto - merror,
                fecha = lubridate::as_date(fecha),
                nombres = dplyr::case_when(
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    ) %>%
                  factor(),
                order_colors = as.numeric(nombres)) %>%
  dplyr::filter(dplyr::between(lubridate::as_date(fecha),
                        #Start
                        lubridate::as_date("2022-05-29"),
                        #End
                        lubridate::as_date("2022-06-20")),
                  !is.na(nombres)) %>%
  dplyr::group_by(nombres,encuestadora)  %>%
  dplyr::summarize(promedio_encuestadora = mean(int_voto, na.rm=TRUE),
                max_encuestadora = max(int_voto, na.rm=TRUE),
                min_encuestadora = min(int_voto, na.rm=TRUE)) %>%
  dplyr::select(pronostico=promedio_encuestadora,high=max_encuestadora,low=min_encuestadora,plato=encuestadora) %>%
  # Join resultados 
  dplyr::left_join(resultado_2da_vuelta_2022 %>%
                     dplyr::select(Resultado=pronostico,nombres),
                   by="nombres") %>%
  # Distancia media pronostico-resultado
  dplyr::mutate(evaluacion = abs(Resultado  - pronostico)) %>%
  dplyr::group_by(plato) %>% 
  dplyr::summarize(score = sum(evaluacion, na.rm = TRUE)) %>%
  # Join semaforo
  dplyr::left_join(tibble::tribble(~plato,~semaforo,
                           "Invamer",10,
                           "CNC",7.1,
                           "GAD3",7,
                           "Guarumo",10,
                           "TYSE",5.5,
                           "YanHaas",5.3,
                           "CELAG",5.1,
                           "AtlasIntel",7.5,
                           "MassiveCaller",3.5
                           
                           ),
                   by="plato") %>%
  # Plot
  ggplot2::ggplot(ggplot2::aes(x=semaforo,y=score))+
  ggplot2::geom_point(data=. %>% dplyr::filter(plato!="Resultado"),
             ggplot2::aes(
               text = paste("Encuestadora: ", plato,
                              "\nScore Recetas Electorales: ", round(score, digits = 2),
                              "\nPuntaje Semaforo La Silla Vacia: ", semaforo),
               color=plato, fill=plato, shape=plato),
             size=4,
             show.legend = FALSE)+
  ggrepel::geom_text_repel(ggplot2::aes(label=plato))+
  ggplot2::geom_smooth(method="lm")+
  ggplot2::theme(legend.position = "none",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        strip.text.x = ggplot2::element_text(size = 8),
        axis.text=ggplot2::element_text(size=11),
        axis.ticks.x=ggplot2::element_blank(),
        axis.text.x=ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="Puntaje Semáforo La Silla Vacía",y="Score evaluación resultados",
       caption="\nFuente: Cálculos www.recetas-electorales.com basados en La Silla Vacía")+
  ggplot2::scale_shape_manual(values=shape_entrada_2022)

# ggplotly ####
plotly::ggplotly(semaforo_2da_2022, tooltip = "text")

Café post electoral: Evaluación del semáforo de La Silla Vacía en 2da vuelta

Ñapa del trabajo con Linterna Verde

Gracias al equipo de Linterna Verde, fue posible analizar algunas de las más populares encuestas hechas en Twitter sobre las elecciones.

Estas encuestas son un reflejo directo de lo que dicen y piensan los seguidores de estas populares cuentas, por lo que se espera que tengan una distancia abismal con la realidad. Al final del día, es mejor tener una muestra bien tomada de 2 000 ciudadanos que cientos de miles de respuestas digitales que representan poco más que el perfil de seguidores de una cuenta de Twitter.

Abajo se muestra algo que faltó en el primer análisis: el resultado de las elecciones. Además, gracias a la gráfica interactiva, se puede ver cada uno de los puntos en detalle.

Ver código
# Packages ####
library(ggdist)
library(ggridges)
library(tidyverse)
library(RColorBrewer)
library(gganimate)
library(plotly)

# Load data ####
twitter_polls <- readr::read_csv(here("elecciones","2022-colombia","2022-05-31-cafe-2022","linterna_verde","df_polls_procesados.csv"))
twitter_posts <- readr::read_csv(here("elecciones","2022-colombia","2022-05-31-cafe-2022","linterna_verde","df_posts_procesados.csv"))

# Wrangle ####
twitter_linterna <- 
  twitter_polls %>%
  # Join handle and name
  dplyr::inner_join(twitter_posts %>%
                     dplyr::select(twitter_id,post_id,name,handle,followers), by=c("status_id"="post_id")) %>%
  # Count choices in each poll
  dplyr::group_by(poll_id) %>%
  dplyr::mutate(poll_id_simple = dplyr::cur_group_id()) %>%
  dplyr::ungroup() %>%
  dplyr::group_by(poll_id_simple) %>%
  dplyr::mutate(poll_choices = dplyr::n()) %>%
  # Keep same choices: All 4 candidates to the 1st round
  dplyr::filter(poll_choices==4, label_estandar %in% c("Gustavo Petro","Federico Gutiérrez","Rodolfo Hernández","Sergio Fajardo")) %>%
  # Create percentage poll results
  dplyr::mutate(result = 100*votes/sum(votes) %>% round(digits=1),
                poll_responses = sum(votes)) %>%
  dplyr::mutate(label_estandar = factor(label_estandar, levels = c("Gustavo Petro","Federico Gutiérrez","Rodolfo Hernández","Sergio Fajardo"))) %>%
  dplyr::ungroup()

# Result 1: Twitter vs La realidad ####
twitter_vs_realidad <- 
  twitter_linterna %>%
  dplyr::mutate(label_estandar = dplyr::case_when(stringr::str_detect(label_estandar,"Rodolfo") ~ "Rodolfo Hernandez",
                                           stringr::str_detect(label_estandar,"Fede")    ~ "Federico Gutierrez",
                                           stringr::str_detect(label_estandar,"Fajardo") ~ "Sergio Fajardo",
                                           stringr::str_detect(label_estandar,"Petro")   ~ "Gustavo Petro")) %>%
  dplyr::mutate(label_estandar = factor(label_estandar, levels=c("Gustavo Petro","Federico Gutierrez","Rodolfo Hernandez","Sergio Fajardo"))) %>%
  # PLOT
  ggplot2::ggplot(ggplot2::aes(x=label_estandar %>% reorder(dplyr::desc(label_estandar)),y=result))+
  ggplot2::coord_flip()+
  ggplot2::geom_hline(yintercept = c(0,10,20,30,40,50,60,70,80,90,100),alpha=0.4, linetype="dashed")+
  ggplot2::geom_boxplot(ggplot2::aes(fill=label_estandar),alpha=0.5, show.legend = FALSE)+
  # Twitter
  ggplot2::geom_point(ggplot2::aes(size=poll_responses,
                 text=paste("Cuenta:", handle,
                            "<br>Nombre:", name,
                            "<br>Seguidores:", followers,
                            "<br>Resultado:", paste(round(result, digits = 2)," %")),
                 color=label_estandar), alpha=0.4,shape=19, position = "jitter", show.legend = FALSE) +
  # Resultados
  ggplot2::geom_point(data =  readr::read_csv(here("elecciones","2022-colombia","2022-05-31-cafe-2022","sancocho_resultados.csv"))  %>%
               dplyr::select(plato,label_estandar=nombres,result=pronostico) %>%
               dplyr::filter(plato=="Resultado"),
             ggplot2::aes(text = paste0("Resultado ",label_estandar,": ", paste(round(result, digits = 2)," %"))),
             fill="lawngreen", 
             color="black", 
             size=16, shape=24) +
  #Encuestas
  ggplot2::geom_point(data = readr::read_csv(here("elecciones","2022-colombia","2022-05-31-cafe-2022","sancocho_resultados.csv")) %>%
               dplyr::select(plato,label_estandar=nombres,result=pronostico) %>%
               dplyr::filter(plato=="Encuestas"),
             ggplot2::aes(text = paste0("Promedio Encuestas ",label_estandar,": ", paste(round(result, digits = 2)," %"))),
             color="red2", size=8, shape=16) +
  
  ggplot2::labs(y="Resultado poll Twitter/Encuestas: % votos para cada candidato",
       x=NULL,
       title = "Encuestas en Twitter vs Realidad",
       subtitle = "Distribucion de resultados Polls en Twitter (N = 546)\nEncuestas con muestreo probabilistico (circulo rojo) (N = 27)\nResultado primera vuelta (triangulo verde)",
       caption = "Fuente: @RecetaElectoral basado en datos recuperados por @linterna y resultados electorales")+
  ggplot2::scale_fill_manual(values=c("purple","blue","gold2","forestgreen"))+
  ggplot2::scale_color_manual(values=c("purple","blue","gold2","forestgreen"))+
  ggplot2::theme_classic() +
  ggplot2::theme(legend.position = "none")

# ggplotly
plotly::ggplotly(twitter_vs_realidad, tooltip = "text")

Cafe 2022: Encuestas en Twitter vs La realidad

Notas

  1. En la primera evaluación se excluyó a Cálculo Electoral de la primera evaluación del 30 de Mayo (culpa del trasnocho). Con la actualización de los resultados con el escrutinio, La Silla Vacía recuperó el primer puesto.↩︎

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {☕ Café post-electoral},
  date = {2022-05-31},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-31-cafe-2022/2022-cafe.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “☕ Café post-electoral.” May 31. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-31-cafe-2022/2022-cafe.html.
]]> encuestas el país la silla vacia ajiaco pronósticos elecciones https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-31-cafe-2022/2022-cafe.html Mon, 30 May 2022 22:00:00 GMT 🥣 Sancocho de pronósticos Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-20-sancocho/2022-sancocho.html

“A wise man proportions his belief to his evidence”
– David Hume

El Sancocho mezcla todos los pronósticos, promedios, ponderaciones y ejercicios similares que están públicamente disponibles para la primera vuelta del 29 de mayo 2022.

Cualquier estimación pública y verificable que resulte en un pronóstico de votación, o un intervalo de votos posibles, es incluida. Debe estar descrita en alguna parte, y debe ser de acceso público.

El Sancocho para la primera vuelta de 2022

El primer ingrediente del Sancocho es una referencia: Encuestas, un promedio simple de la intención de voto y su rango (el menor y mayor valor registrado para cada candidato), entre todas las encuestas que han salido desde las elecciones legislativas de marzo 13 de 2022.

Los demás ingredientes son todas las estimaciones puntuales según sus cocineros.

Ver código
library(tidyverse)
library(lubridate)
library(here)

# 0. Resultado 1era vuelta ####
resultado_1era_vuelta_2022 <- tibble::tribble(~pronostico,~nombres,
                     39.84,"Gustavo Petro",
                     23.64,"Federico Gutierrez",
                     4.13,"Sergio Fajardo",
                     27.82,"Rodolfo Hernandez") %>%
  dplyr::mutate(plato = "Resultado")

# 1. Base: promedio de las encuestas ####
encuestas_ulr_2022 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"
encuestas_2022 <- readr::read_csv(encuestas_ulr_2022)

encuestas_sancocho_2022 <- encuestas_2022 %>%
  # Filter despues de consultas 
  dplyr::filter(fecha >= lubridate::as_date("2022-03-13")) %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,tidyselect::contains(c("petro","gutierrez","fajardo","hernandez","betancourt")),blanco,otros) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>%
  # Promedios
  dplyr::group_by(candidato) %>%
  dplyr::summarise(pronostico = mean(int_voto,na.rm=TRUE),
                   high = max(int_voto,na.rm=TRUE),
                   low = min(int_voto,na.rm=TRUE)) %>%
  dplyr::mutate(plato= paste0("Encuestas"),
                nombres = dplyr::case_when(candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro",
                                    candidato=="blanco" ~ "Voto en blanco",
                                    candidato=="otros" ~ "Otros candidatos",
                                    )
                ) %>%
    dplyr::filter(nombres!="Ingrid Betancourt")

# 2. Calentao ####
calentao_sancocho_2022 <- readr::read_csv(here("elecciones","2022-colombia","2022-05-20-sancocho","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,~nombres,
                            "gp","Gustavo Petro",
                            "fg","Federico Gutierrez",
                            "sf","Sergio Fajardo",
                            "rh","Rodolfo Hernandez"),
                       by=c("candidato"))  %>%
  dplyr::rename(pronostico=m_all,low=p10,high=p90)

# 3. Ajiaco ####
ajiaco_sancocho_2022 <- readr::read_csv(here("elecciones","2022-colombia","2022-05-20-sancocho","ajiaco_fit.csv")) %>%
  dplyr::group_by(parameter) %>%
  dplyr::summarise(pronostico = quantile(estimate,0.5),
                   low = quantile(estimate,0.1),
                   high = quantile(estimate,0.9)) %>%
  dplyr::mutate(n=stringr::str_extract(parameter,"[:digit:]") %>% as.numeric()) %>%
  #Join names
  dplyr::left_join(tibble::tribble(~n,~nombres,
                           1,"Gustavo Petro",
                           2,"Federico Gutierrez",
                           3,"Sergio Fajardo",
                           4,"Rodolfo Hernandez",
                           #5,"Ingrid Betancourt",
                           5,"Resto (Otros, Blanco e Indecisos)"),
                   by="n") %>%
      dplyr::mutate(plato = "Ajiaco")

# 4. El País ####
elpais_2022 <- readr::read_csv("https://raw.githubusercontent.com/JorgeGalindo/co-elect-2022/main/modelo_1av/promedio_norm.csv") %>%   dplyr::mutate(plato= "@JorgeGalindo El Pais",
                nombres = dplyr::case_when(candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    ),
                pronostico=promedio
                ) %>%
  dplyr::select(plato,nombres,pronostico) %>%
  dplyr::filter(nombres!="Ingrid Betancourt")

  
# 5. La Silla Vacia ####
lsv_2022 <- tibble::tribble(~pronostico,~nombres,
                     39,"Gustavo Petro",
                     25,"Federico Gutierrez",
                     5,"Sergio Fajardo",
                     20,"Rodolfo Hernandez",
                     #NA,"Ingrid Betancourt",
                     4,"Voto en blanco") %>%
  dplyr::mutate(plato = "La Silla Vacia")

# 6. PoliticaConDato ####
politicacondato <- readr::read_csv(here("elecciones","2022-colombia","2022-05-20-sancocho","recetario","2022-05-21_PoliticaConDato.csv")) %>%
  dplyr::mutate(nombres = dplyr::case_when(candidato=="Fajardo" ~ "Sergio Fajardo",
                                    candidato=="Fico" ~ "Federico Gutierrez",
                                    candidato=="Petro" ~ "Gustavo Petro",
                                    candidato=="Ingrid" ~ "Ingrid Betancourt",
                                    candidato=="Rodolfo" ~ "Rodolfo Hernandez",
                                    candidato=="Perez" ~ "Luis Perez",
                                    candidato=="Milton" ~ "John M. Rodriguez",
                                    candidato=="Gomez" ~ "Enrique Gomez",
                                    candidato=="Blanco" ~ "Voto en blanco"),
                plato = "@PoliticaConDato") %>% 
  dplyr::rename(pronostico=int_voto) %>%
  tidyr::separate(inter,sep="-",into = c("low","high")) %>%
  dplyr::mutate(dplyr::across(c("low","high"),as.numeric)) %>%
  dplyr::filter(nombres!="Ingrid Betancourt")
  

# 7. Colombia Risk Analysis ####
colombiarisk_2022 <- tibble::tribble(~pronostico,~nombres,
                     34.99,"Gustavo Petro",
                     19.24,"Federico Gutierrez",
                     7.49,"Sergio Fajardo",
                     12.46,"Rodolfo Hernandez",
                     #1.68,"Ingrid Betancourt",
                     NA,"Voto en blanco") %>%
  dplyr::mutate(plato = "@ColombiaRisk")

# 8. Calculo Electoral ####
calculo_electoral <- tibble::tribble(~nombres,~pronostico,~low,~high,
                     "Gustavo Petro",43.1,32.7,53.9,
                     "Federico Gutierrez",24.9,17.6,32.8,
                     "Sergio Fajardo",5.7,2.9,9.5,
                     "Rodolfo Hernandez",22.3,15.8,29.7
                     ) %>%
  dplyr::mutate(plato = "@calc_electoral")
  
  


# Preparar Sancocho ####
sancocho_2022 <- dplyr::bind_rows(
                             resultado_1era_vuelta_2022,
                             encuestas_sancocho_2022,
                             calentao_sancocho_2022,
                             ajiaco_sancocho_2022,
                             elpais_2022,
                             lsv_2022,
                             colombiarisk_2022,
                             politicacondato,
                             calculo_electoral
                             ) %>%
  dplyr::select(plato,nombres,pronostico,high,low) %>%
  dplyr::mutate(nombres = factor(nombres, levels=c("Gustavo Petro","Federico Gutierrez","Rodolfo Hernandez","Sergio Fajardo","Ingrid Betancourt")),
                plato = factor(plato,levels = c("Resultado","Ajiaco","Mixto 2022","Simple 2022","@JorgeGalindo El Pais","La Silla Vacia","@PoliticaConDato","@ColombiaRisk","@calc_electoral","Encuestas"))) %>%
    dplyr::filter(nombres!="Ingrid Betancourt")

# Guardar sancocho ####
sancocho_2022 %>%
  readr::write_csv(here("elecciones","2022-colombia","2022-05-20-sancocho","sancocho_resultados.csv"))
Ver código
library(tidyverse)
library(lubridate)
library(RColorBrewer)
library(plotly)

colors_sancocho_2022 <- c("orangered","orangered","orangered","green4","darkturquoise","blue","gold2","royalblue3","purple3")
shape_sancocho_2022 <- c(15,18,17,15,16,15,16,1,6)

# El sancocho
sancocho_2022 %>%
  dplyr::filter(!stringr::str_detect(nombres,"Otros|Voto"), plato!="Resultado") %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(dplyr::desc(nombres)),y=pronostico))+
  ggplot2::geom_point(ggplot2::aes(shape=plato,
                 #text = paste('Candidato: ', nombres,
                #              '<br>Estimacion: ', round(pronostico, digits=2),
                 #             '<br>Cocinero: ',plato),
                color=plato),
             size=4,
             position=position_dodge(0.5))+
  ggplot2::geom_errorbar(ggplot2::aes(color=plato,ymax=high,ymin=low),position = position_dodge(0.5),width=0.5, show.legend = FALSE)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50,60), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position = "right",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=9),
        axis.text=ggplot2::element_text(size=11),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
  ggplot2::labs(x=NULL,y="\n% votos pronosticados/estimados por candidato",
       title="Sancocho 2022",
       subtitle="Pronósticos y promedios para la primera vuelta disponibles a 21 Mayo 2022",
       caption="\nFuente: Cálculos www.recetas-electorales.com")+
  ggplot2::scale_y_continuous(limits = c(0,60),breaks=c(10,20,30,40,50,60))+
  ggplot2::scale_color_manual(values=colors_sancocho_2022)+
  ggplot2::scale_shape_manual(values=shape_sancocho_2022)+
  ggplot2::coord_flip()

Sancocho de pronósticos electorales

Sancocho de pronósticos electorales
Ver código
#plotly::ggplotly(sancocho_2022_plot, tooltip ="text") %>%
#  plotly::layout(title = list(text = paste0('Sancocho 2022',
#                                    '<br>',
#                                    '<sup>',
#                                     'Pronósticos y promedios para la primera vuelta disponibles a 21 Mayo #2022','</sup>')))

Estos son algunos puntos comunes de los ingredientes del Sancocho:

ImportanteLo que dicen los pronosticos:

  • Habrá segunda vuelta. Ningún pronóstico estima la votación de un candidato por encima de 50%.

  • Gustavo Petro y Federico Gutierrez pasarán a segunda vuelta. Todos los pronósticos coinciden en que estos dos candidatos obtendrán las mayores votaciones en primera vuelta.

  • La veda de las encuestas no permitió ver la trayectoria completa de Rodolfo Hernández. La semana anterior a la primera vuelta el candidato Rodolfo Hernández tuvo un repunte importante en las encuestas, pero no es posible verlo completo por la restricción a publicar mediciones una semana antes de las elecciones.

  • Primer modelo probabilístico. El 🥑 Ajiaco es el primer modelo probabilístico que se publica para unas elecciones de primera vuelta en Colombia. Es un modelo abierto y replicable. Le da una probabilidad de 2-3% a Gustavo Petro de ganar en primera vuelta, y 0% a cualquier otro candidato.

Antes de ver los detalles de cada receta, una tabla para tener presente las diferencias entre cada plato que incluye los resultados del escrutinio del 1 de Junio.

Ver código
library(tidyverse)
library(lubridate)
library(RColorBrewer)
library(DT)

sancocho_2022 %>%
  dplyr::filter(!is.na(nombres),nombres!="Ingrid Betancourt") %>%
  dplyr::mutate(dplyr::across(where(is.numeric),round,2)) %>%
  DT::datatable(filter = "top",
                extensions = "Buttons",
                options = list(dom = 'Bfrtip',
                               buttons = c('copy', 'csv', 'excel'),
                               autoWidth = TRUE,
                               scrollX = TRUE),
                colnames = c('Plato', 'Candidato', 'Valor', 'Intervalo (maximo)','Intervalo (minimo)'),
                caption = paste0('Tabla del Sancocho a 2022-05-21')) %>%
  DT::formatStyle('plato', 
                  color="white",
                  backgroundColor = styleEqual(c("Encuestas",
                                                 "Resultado",
                                                 "@calc_electoral",
                                                 "@PoliticaConDato",
                                                 "@ColombiaRisk",
                                                 "Simple 2022",
                                                 "Mixto 2022",
                                                 "Ajiaco",
                                                 "@JorgeGalindo El País",
                                                 "La Silla Vacia"),
                                               c("midnightblue",
                                                 "lawngreen",
                                                 "royalblue",
                                                 "blue",
                                                 "gold",
                                                 'orangered',
                                                 'orangered',
                                                 "orangered",
                                                 "darkgreen",
                                                 "darkcyan"))) %>%
  DT::formatStyle(columns = colnames(.), fontSize = '50%')

Sancocho 2022 en detalle

👨‍🍳 Recetas Electorales 2022

Abajo van los resultados de los platos para la primera vuelta preparados por las Recetas Electorales: Los platos del Calentao y el Ajiaco.

Ver código
library(tidyverse)

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

sancocho_2022 %>% 
  dplyr::filter(plato %in% c("Mixto 2022","Simple 2022","Ajiaco"),!is.na(nombres)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(dplyr::desc(nombres)),y=pronostico, color=nombres))+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=high, ymin=low),width=0.5)+
  ggplot2::geom_point(size=5)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=15),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
  ggplot2::labs(x=NULL,y="\nMediana e intervalo percentil 10 y 90 para cada distribución posterior predictiva", 
       title="Recetas Electorales 2022",
       subtitle=paste0("Modelos bayesianos basados en encuestas a 2022-05-21"),
       caption="\nFuente: www.recetas-electorales.com")+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))+   
  ggplot2::coord_flip()+
  ggplot2::facet_wrap(~plato)

Pronósticos Calentao y Ajiaco

Pronósticos Calentao y Ajiaco

🥔 La tortilla de El País

Desde el periódico El País, @JorgeGalindo publicó promedios con base en las encuestas y todos sus cálculos están en un repositorio de GitHub. Completa transparencia por parte de Jorge, excelente cocinero.

Ver código
library(tidyverse)

elpais_2022 %>% 
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(pronostico),y=pronostico, color=nombres))+
  ggplot2::geom_point(size=6)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=15),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
     ggplot2::labs(x=NULL,y="% votos estimados",
         title="Promedios @JorgeGalindo El País",
         subtitle="Resultado más reciente a 2022-05-21",
         caption="Fuente: El País")+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))

La tortilla de El País

La tortilla de El País

🍲 La changua de La Silla Vacía

La Silla Vacia publicó un ponderado de las encuestas que se basa en su evaluación de encuestadoras. El portal aclara que “Como promedio ponderado, este ejercicio no es un pronóstico electoral”, así que ellos se centran en tratar de describir las cosas en vez de predecirlas.

De todas maneras, el evaluador de encuestadoras de La Silla Vacía puede ser también evaluado como predictor del desempeño de las encuestadoras en las elecciones, así que se incluye en el Sancocho.

Ver código
library(tidyverse)

lsv_2022 %>% 
  dplyr::filter(!stringr::str_detect(nombres,"blanco"),!is.na(pronostico)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(pronostico),y=pronostico, color=nombres))+
  ggplot2::geom_point(size=6)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=14),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
     ggplot2::labs(x=NULL,y="% votos estimados",
         title="Ponderador de encuestas La Silla Vacia",
         subtitle="Resultado más reciente a 2022-05-21",
         caption="Fuente: La Silla Vacia")+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))

La changua de La Silla Vacía

La changua de La Silla Vacía

🍛 El ensamble de @PoliticaConDatos

La primera receta enviada para el recetario abierto. Es el resultado de ensamblar 3 modelos que están en el repositorio de GitHub de su autor.

Es un ejercicio cuidadoso y verificado por las recetas electorales, que además incluye estimaciones para todos los candidats que van a primera vuelta.

Ver código
library(tidyverse)

politicacondato %>% 
  dplyr::filter(!stringr::str_detect(nombres,"blanco|Luis|John|Enrique"),!is.na(pronostico)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(pronostico),y=pronostico, color=nombres))+
  ggplot2::geom_point(size=6)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=high, ymin=low),width=0.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=14),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
     ggplot2::labs(x=NULL,y="% votos estimados",
         title="Ensamble de @PoliticaConDato",
         subtitle="Resultado más reciente a 2022-05-21",
         caption="Fuente: @PoliticaConDato")+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))

El ensamble de @PoliticaConDato

El ensamble de @PoliticaConDato

🌭 La kielbasa de Colombia Risk Analysis

El índice agregado de intención de voto de Colombia Risk Analysis también usa únicamente las encuestas para estimar un agregado de la votación esperada.

En letra diminuta, en la esquina inferior izquierda de una gráfica, se especifica que el índice “Pondera teniendo en cuenta la antigüedad de la encuesta y el tamaño de la muestra”. Sin embargo, el anexo técnico no dice cómo lo hacen.

Se rajan en transparencia metodológica, porque nada les impide explicar claramente cómo miden el índice, pero igual es una fuente verificable, así que se incluyen en el Sancocho.

Ver código
library(tidyverse)

colombiarisk_2022 %>% 
  dplyr::filter(!stringr::str_detect(nombres,"blanco|Ingrid"),!is.na(pronostico)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(pronostico),y=pronostico, color=nombres))+
  ggplot2::geom_point(size=6)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=14),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
     ggplot2::labs(x=NULL,y="% votos estimados",
         title="Colombia Risk Analysis",
         subtitle="Resultado más reciente a 2022-05-21",
         caption="Fuente: @ColombiaRisk")+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))

La kielbasa de Colombia Risk Analysis

La kielbasa de Colombia Risk Analysis

🥧 El hornado de Calculo Electoral @calc_electoral

Desde Ecuador, llega un análisis también basado en las encuestas que vale la pena incluir en el Sancocho. Además, se publicó antes del 21 de mayo.

Los autores decidieron sobre publicar el código asociado, y se encuentra en este repositorio de GitHub.

Sobresalen comparados con las otras recetas por los enormes intervalos de confianza. Por ejemplo, el intervalo para Gustavo Petro va de 32.7% a 53.9%, más de 20% de rango.

Ver código
library(tidyverse)

calculo_electoral %>% 
  dplyr::filter(!stringr::str_detect(nombres,"blanco|Ingrid"),!is.na(pronostico)) %>%
  ggplot2::ggplot(ggplot2::aes(x=nombres %>% reorder(pronostico),y=pronostico, color=nombres))+
  ggplot2::geom_point(size=6)+
  ggplot2::geom_text(ggplot2::aes(label=round(pronostico, digits=1)), size=4,color="black",vjust=-1.5)+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=high, ymin=low),width=0.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50,60), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=14),
        panel.background=ggplot2::element_rect(fill="grey90", color="white"))+
     ggplot2::labs(x=NULL,y="% votos estimados",
         title="Cálculo Electoral @calc_electoral",
         subtitle="Resultado más reciente a 2022-05-21",
         caption="Fuente: www.calculoelectoral.com")+
  ggplot2::coord_flip()+
  ggplot2::scale_color_manual(values=colors_entrada_2022) +
  ggplot2::scale_fill_manual(values=colors_entrada_2022)+
  ggplot2::scale_y_continuous(limits = c(0,60),breaks=c(10,20,30,40,50,60))

El hornado de @calc_electoral

El hornado de @calc_electoral

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🥣 Sancocho de pronósticos},
  date = {2022-05-15},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-20-sancocho/2022-sancocho.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🥣 Sancocho de pronósticos.” May 15. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-20-sancocho/2022-sancocho.html.
]]> encuestas el país la silla vacia pronósticos https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-20-sancocho/2022-sancocho.html Sat, 14 May 2022 22:00:00 GMT 🥑 Ajiaco electoral Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-01-ajiaco/2022-ajiaco.html

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

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: www.recetas-electorales.com")+
  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")
  )

Resultados del Ajiaco

Resultados del Ajiaco
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 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)))
Priors por candidato
Candidato
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 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 recoge al mismo tiempo todas las proporciones de votos estimadas por las encuestas para cada candidato1. 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:

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

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
)

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

Ajiaco: Parámetros vs Observaciones

Ajiaco: Parámetros vs Observaciones
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: www.recetas-electorales.com")+
  theme_ridges()

Ajiaco: Parámetros vs Observaciones

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)

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: www.recetas-electorales.com")+
  ggplot2::theme(legend.position = "bottom")+
  theme_ridges()

Ajiaco: Densidades posteriores

Ajiaco: Densidades posteriores
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
)
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")))
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
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.↩︎

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🥑 Ajiaco electoral},
  date = {2022-05-01},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-01-ajiaco/2022-ajiaco.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🥑 Ajiaco electoral.” May 1. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-01-ajiaco/2022-ajiaco.html.
]]> encuestas dirichlet probabilístico regresión stan bayesplot https://www.recetas-electorales.com/elecciones/2022-colombia/2022-05-01-ajiaco/2022-ajiaco.html Sat, 30 Apr 2022 22:00:00 GMT 🍲 Calentao, reciclando platos viejos Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html

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

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: www.recetas-electorales.com"
       )

Calentao 2022

Calentao 2022

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()
numeric(0)
Ver código
# 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)))
Priors por candidato
Candidato
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.

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

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 y . 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
)

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

Calentao: Cadenas

Calentao: Cadenas
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))

Calentao: Parámetros vs Observaciones

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.

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
)

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

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🍲 Calentao, reciclando platos viejos},
  date = {2022-04-24},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🍲 Calentao, reciclando platos viejos.” April 24. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html.
]]> encuestas simple mixto regresión https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-24-calentao/2022-calentao.html Sat, 23 Apr 2022 22:00:00 GMT 🏳️️️¿Con qué se come la indecisión y el voto en blanco? Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-14-voto-blanco/2022-voto-blanco.html

“Ignorance is a blank sheet, on which we may write, but error is a scribbled one, on which we must first erase”
– Charles Caleb Cotton

¿Qué esconde el voto en blanco?

Tal vez una de las cosas más inusuales de las encuestas de intención de voto es la dinámica de las mediciones del voto en blanco. Es extraña de principio a fin: a pesar de que el voto en blanco no supera el 2-4% de la votación en las elecciones, las encuestas miden en 15%, 20% y hasta 30%. Más extraño aún, el voto en blanco no siempre disminuye entre más se acerca la jornada electoral; a veces incluso aumenta antes de las elecciones.

¿Qué representa el voto en blanco en las encuestas de intención de voto? Este plato trata de responder esa pregunta, introduciendo unos problemas de las encuestas que nunca van a ver en los medios de comunicación, aunque al final queden más preguntas que respuestas.

Retrospectiva: El voto en blanco en las elecciones presidenciales de 2018

Aunque las elecciones presidenciales de 2018 fueron inusuales con el voto en blanco, particularmente en la segunda vuelta por cuenta de la decisión de Sergio Fajardo de anunciar que iba a votar en blanco, la ola que se formó durante esos meses refleja algo menos evidente.

La volatilidad y enorme distancia que hay entre lo que aparece en diferentes encuestas hace pensar que cada encuestadora está midiendo algo distinto cuando describen voto en blanco en sus fichas técnicas. Para entender mejor qué puede estar pasando, vale la pena repasar una idea importante que no se discute lo suficiente: los errores no muestrales de las encuestas.

Ver código
# Paquetes ####
library(tidyverse)
library(plotly)

voto_blanco_2018 <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Elecciones%202018/encuestas2018.csv") %>%
  dplyr::rename(ns_nr=`ns/nr`) %>%
  tidyr::pivot_longer(cols = c(ivan_duque,german_vargas_lleras,humberto_delacalle,sergio_fajardo,gustavo_petro), 
                      names_to = "candidato",
                      values_to = "int_voto") %>%
  #Standarize
  dplyr::mutate(blanco_std = (blanco-mean(blanco)/sd(blanco))) %>%
  dplyr::group_by(candidato) %>%
  dplyr::mutate(int_voto_std = (int_voto-mean(int_voto)/sd(int_voto))) %>%
  dplyr::mutate(vuelta = ifelse(n<27,0,1)) %>%
  dplyr::filter(n>11) 
   #Resultados
  #dplyr::bind_rows(tibble::tribble(~fecha,~ivan_duque,~gustavo_petro,~blanco,~encuestadora,
  #                         lubridate::as_date("2018-06-17"),54,42,4,"Resultado")) 

voto_blanco_2018_plot <- voto_blanco_2018 %>%
  ggplot2::ggplot(ggplot2::aes(x=lubridate::as_date(fecha),y=blanco))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,
                 text = paste('Voto en blanco:', blanco,
                              '<br>Muestra:',muestra,
                              '<br>Encuestadora:',encuestadora,
                              '<br>Fecha:', fecha)), 
             position = "jitter",
             size=3,
             color="black",
             show.legend = FALSE)+
   ggplot2::geom_point(data=tibble::tribble(~fecha,~ivan_duque,~gustavo_petro,~blanco,~encuestadora,
                           lubridate::as_date("2018-05-27"),39.34,25.08,1.7,"Resultado",
                           lubridate::as_date("2018-06-17"),54,42,4,"Resultado"),
                                       ggplot2::aes(shape=encuestadora,
                 text = paste('Voto en blanco:', blanco,
                              '<br>Resultado:',encuestadora,
                              '<br>Fecha:', fecha)), 
             #position = "jitter",
             size=8,
             color="red",
             show.legend = FALSE)+
  #ggplot2::geom_hline(yintercept = 338581/19336134, linetype="dashed", color="orangered2")+
  #ggplot2::geom_hline(yintercept = 807924/19247062, linetype="dashed",color="forestgreen")+
  # Vueltas
  ggplot2::geom_vline(xintercept = c(as.numeric(lubridate::as_date("2018-03-11")),
                            as.numeric(lubridate::as_date("2018-05-27")),
                            as.numeric(lubridate::as_date("2018-06-17"))), color="royalblue2")+
  #ggplot2::annotate("text",x=lubridate::as_date("2018-02-27"),y=29,label="Legislativas", angle=90,color="royalblue2")+
  #ggplot2::annotate("text",x=lubridate::as_date("2018-05-16"),y=29,label="1 vuelta", angle=90,color="royalblue2")+
  #ggplot2::annotate("text",x=lubridate::as_date("2018-06-10"),y=29,label="2 vuelta", angle=90,color="royalblue2")+
  # LOESS
  ggplot2::geom_smooth(method="loess",color="white",size=3,fill="grey10")+
  ggplot2::scale_shape_manual(values=c(4,16,17,3,15,25,10,11,8))+
  ggplot2::scale_x_date(date_breaks = "1 week")+
  ggplot2::labs(x=NULL,y="% voto en blanco reportado en cada encuesta")+
  ggplot2::theme_classic()+
  ggplot2::theme(legend.position="none",
        legend.title = ggplot2::element_blank(),
        #panel.background = ggplot2::element_rect(),
        axis.text.x=ggplot2::element_text(angle=90, hjust=1, size=6))

plotly::ggplotly(voto_blanco_2018_plot, tooltip = "text")

El voto en blanco en las encuestas de 2018

Errores no muestrales –más allá del márgen de error

Las encuestas pueden tener dos tipos de errores: 1) errores muestrales, que vienen de tomar una sola muestra y no examinar toda la población que se busca estudiar, y 2) errores no muestrales, que incluyen, además de otras pesadillas para los encuestadores, errores de medición y sesgos de participación y respuesta.1

El voto en blanco que miden las encuestas puede estar recogiendo varios tipos de errores muestrales y no muestrales. Por el lado de los errores muestrales, es posible que las encuestas no lleguen a partes de la población con cierta inclinación ideológica y las muestras excluyan sistemáticamente, por ejemplo, municipios pequeños que se inclinan hacia un lado de la balanza. Por el lado de los errores no muestrales, las personas que responden voto en blanco pueden ser de dos tipos: los que responden eso por salir del paso o realmente no saben por quién votar (“no sé, ponga que voto en blanco”) o los que responden que van a votar en blanco a pesar de saben que van a votar por algún candidato pero prefieren no revelarlo. (“sí sé, pero no le voy a decir, así que ponga voto en blanco”). La historia es muy diferente si el voto en blanco recoge un tipo de error no muestral más que otro.

Ver código
library(kableExtra)
library(tidyverse)

tibble::tribble(~tipo,~descripcion,~ejemplo,
        "Demarcación", "La muestra no refleja la población objetivo","La encuesta se llevó a cabo en Bogotá, Barranquilla y Cali",
        "Medición", "Cuando la encuesta misma afecta los resultados","¿Piensa votar por el candidato de derecha en las próximas elecciones?",
        "No respuesta","Cuando los datos que no se ven están muy relacionados con la probabilidad de respuesta","Cuando llaman al teléfono fijo de la casa a las 12 pm a hacer la encuesta y solo está la abuela para responderla",
        "Especificación", "Cuando hay variabilidad en la forma de entender una pregunta","¿Está seguro de votar en las próximas elecciones? ¿Está seguro de estar seguro?",
        "Actitudes cambiantes","Cuando una encuesta quiere medir intención de voto, la medida depende mucho del momento en que se pregunte.","A 3 meses de las elecciones, cuando no se sabe quiénes serán los candidatos, ¿está seguro de saber por quién va a votar?") %>%
   knitr::kable("html", 
        digits=2,
        caption = "Algunos errores no muestrales") %>% 
  kableExtra::kable_styling(full_width = FALSE, font_size = 13) %>% 
  kableExtra::column_spec(1,bold=TRUE,italic = TRUE, background = "#FF4900", color = "white") %>% 
  kableExtra::column_spec(3,italic = TRUE) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#191919", color = "white")
Algunos errores no muestrales
tipo descripcion ejemplo
Demarcación La muestra no refleja la población objetivo La encuesta se llevó a cabo en Bogotá, Barranquilla y Cali
Medición Cuando la encuesta misma afecta los resultados ¿Piensa votar por el candidato de derecha en las próximas elecciones?
No respuesta Cuando los datos que no se ven están muy relacionados con la probabilidad de respuesta Cuando llaman al teléfono fijo de la casa a las 12 pm a hacer la encuesta y solo está la abuela para responderla
Especificación Cuando hay variabilidad en la forma de entender una pregunta ¿Está seguro de votar en las próximas elecciones? ¿Está seguro de estar seguro?
Actitudes cambiantes Cuando una encuesta quiere medir intención de voto, la medida depende mucho del momento en que se pregunte. A 3 meses de las elecciones, cuando no se sabe quiénes serán los candidatos, ¿está seguro de saber por quién va a votar?

Los que no se pueden regular: Errores no muestrales

Error 1: “No sé, ponga que voto en blanco”

La indecisión puede venir de la gente que realmente no sabe por quién va a votar hasta que está alistándose para salir a votar, o toma la decisión en frente de la urna. No sé cuál sea la prevalencia de esa forma de tomar decisiones, pero seguro existe. Más aún, medir la distribución de los indecisos después de las elecciones es muy difícil porque el número de candidatos que resulta no vuelve a ser mismo; después de la primera vuelta nadie pregunta en las encuestas por quién se votó en la primera vuelta sino por quién va a votar en la segunda vuelta.

¿Cómo podrían medirse los indecisos? ¿Cómo podrían separarse de los que realmente votan en blanco o se abstienen? Una opción es que las encuestas midan la certeza declarada con que alguien va a votar, por ejemplo en una escala de 1 a 10, como hacen las encuestadoras en Francia, y utilizando mediciones repetidas pueden revelar la disminución del voto indeciso de cara a las elecciones condicionando en esa certeza.

Otra opción es ver qué pasa en diferentes escenarios donde los indecisos pueden ser pivotales en las elecciones. Un escenario, por ejemplo, es que los indecisos se distribuyan uniformemente entre los candidatos cuando llegan las elecciones, los que piensan votar en blanco efectivamente voten en blanco y nadie se abstiene de votar. Esto aplica el principio de ignorancia, que dice que cuando uno no sabe qué evento entre varios es más probable, lo menos grave que puede hacer es asumir que todos ocurren con la misma probabilidad. Así, uno podría imputarle la diferencia entre los indecisos y lo que históricamente ha sido el voto en blanco a todos los candidatos a la vez, ponderando por la intención de voto que ya tenga cada uno 2. El riesgo es que, como cualquier premisa incorrecta, lo que resulte también estará mal: si los indecisos tienden a apoyar más a unos candidatos que otros, entonces la imputación va a empeorar el problema que busca solucionar, creando un nuevo sesgo al sumar apoyos a algunos candidatos que nunca los van a recibir.

La figura abajo muestra este efecto. La intención de voto para dos candidatos hipotéticos Fulano y Mengano es similar y se distribuye al momento de las elecciones entre votos efectivos para Fulano y Mengano, respectivamente, pero también una parte de cada candidato se va al voto en blanco. La masa de indecisos se distribuye en 60% entre el candidato Fulano, 20% candidato Mengano y el restante 20% al voto en blanco. En esta situación, conocer el tamaño de los indecisos antes de las elecciones no ayuda mucho a conocer cómo se va a distribuir su votación porque representa la incertidumbre que los mismos votantes enfrentan, y si un pronóstico imputa a los indecisos en iguales proporciones para cada candidato, o según su proporción reflejada en las encuestas, le va a ir muy mal.

Ver código
library(tidyverse)
library(plotly)

node_error_1 <- list(
  label = c("Elecciones",
            "Fulano_Intencion","Fulano_Despues",
            "Mengano_Intencion","Mengano_Despues",
            "Indecisos",
            "Blanco/No vota_Intencion","Blanco/No vota_Despues"),
  color = c("blue","red","red","green","green","yellow","white","white"),
     pad = 15,
      thickness = 20,
      line = list(
        color = "black",
        width = 0.5
  ))

link_error_1 <- list(
      source = c(1,0,0,3,0,0,5,0,0,0),
      target = c(0,2,7,0,4,7,0,2,4,7),
      value =  c(6,5,1,6,5,1,5,3,1,1)
    )

plot_ly(
    type = "sankey",
    orientation = "h",
    node = node_error_1,
    link = link_error_1
  ) %>% 
  plotly::layout(
    title = "Error 1: Si los indecisos no se distribuyen uniformemente entre candidatos",
    font = list(
      size = 10
    ))

Error 1: Si los indecisos no se distribuyen uniformemente entre candidatos

Error 2: “Si sé, pero no le voy a decir, así que ponga voto en blanco”

Aquí se pone complicada la historia. Este sesgo de esconder la preferencia de voto, si existe algo así como un Bradley effect, hace aún más difícil escudriñar el voto en blanco. Además de indecisos, ese voto en blanco medido esconde intención de voto por uno o más candidatos, lo que distorsiona directamente las encuestas y solo se observa el día de las elecciones. Es un error no muestral que puede convertir a las encuestas en exageradores de tendencias que realmente no existen.

Las figuras abajo muestran un caso donde las personas que piensan votar por un candidato Mengano prefieren no revelar sus preferencias cuando son encuestadas, y las distorsiones que crean sobre lo que se ve en las encuestas –y lo que resulta en las elecciones. En este caso, la mayoría de los que piensan votar por Mengano le dicen a las encuestas que van a votar en blanco, y dado que los que van a votar por Fulano sí revelan su preferencia, se crea en las encuestas una ventaja artificial para el candidato Fulano sólo porque sus votantes sí revelan sus preferencias. Así, las encuestas reflejan no la intención de voto real sino la intención de voto revelada, y ambas pueden ser muy diferentes.

Ver código
library(tidyverse)
library(plotly)

node_error_2 <- list(
  label = c("Encuestas","Elecciones",
            "Fulano_Intencion real","Fulano_Despues",
            "Mengano_Intencion real","Mengano_Despues",
            "Indecisos",
            "Blanco/No vota Intencion","Blanco/No vota Despues"),
  color = c("purple","blue","red","red","green","green","yellow","white","white"),
   pad = 15,
      thickness = 20,
      line = list(
        color = "black",
        width = 0.5
  )
  )

link_error_21 <- list(
      source = c(2,0,0,4,0,0,6,0,7,0),
      target = c(0,3,8,0,5,8,0,8,0,8),
      value =  c(6,4,2,6,3,3,3,3,1,1)
    )

link_error_22 <- list(
      source = c(2,1,1,4,1,1,6,1,1,1,7,1),
      target = c(1,3,8,1,5,8,1,3,5,8,1,8),
      value =  c(6,5,1,6,4,2,3,1,1,1,1,1)
    )

plot_ly(
    type = "sankey",
    orientation = "h",
    node = node_error_2,
    link = link_error_21
  ) %>% 
  plotly::layout(
    title = "Error 2: Preferencias escondidas dentro del voto en blanco",
    font = list(
      size = 10
    ))

Error 2: Preferencias escondidas dentro del voto en blanco y encuestas

Cuando llegan las elecciones, sorpresa: las encuestas estaban reportando un sesgo no muestral brutal que favorecía al candidato Fulano, pero en las urnas las preferencias reales por el candidato Mengano se materializan y gana ese candidato gracias a que los indecisos optaron por Mengano. En este escenario, si las encuestas tienen este tipo de error no muestral, van a inflar al candidato que va a perder y desprestigiarse fuertemente en el camino a las elecciones.

Ver código
library(tidyverse)
library(plotly)

node_error_2 <- list(
  label = c("Encuestas","Elecciones",
            "Fulano_Intencion real","Fulano_Despues",
            "Mengano_Intencion real","Mengano_Despues",
            "Indecisos",
            "Blanco/No vota Intencion","Blanco/No vota Despues"),
  color = c("purple","blue","red","red","green","green","yellow","white","white"),
     pad = 15,
      thickness = 20,
      line = list(
        color = "black",
        width = 0.5
  ))

link_error_21 <- list(
      source = c(2,0,0,4,0,0,6,0,7,0),
      target = c(0,3,8,0,5,8,0,8,0,8),
      value =  c(6,4,2,6,3,3,3,3,1,1)
    )

link_error_22 <- list(
      source = c(2,1,1,4,1,1,6,1,1,1,7,1),
      target = c(1,3,8,1,5,8,1,3,5,8,1,8),
      value =  c(6,5,1,6,4,2,3,0,2,1,1,1)
    )

plot_ly(
    type = "sankey",
    orientation = "h",
    node = node_error_2,
    link = link_error_22
  ) %>% 
  plotly::layout(
    title = "Error 2: Preferencias escondidas dentro del voto en blanco",
    font = list(
      size = 10
    ))

Error 2: Preferencias escondidas dentro del voto en blanco y elecciones

Conclusión: ¿Cómo medimos mejor a los indecisos antes y después de las elecciones?

Esta receta resultó mucho más insípida de lo que esperaba. La realidad de la indecisión, y la manera como se refleja con tanta variabilidad en las encuestas pero nunca se observa bien, no permite dar muchas respuestas. Deja, más bien, algunas hipótesis sobre la mesa.

¿Qué representa el voto en blanco en las encuestas? ¿Son indecisos los que aparecen dentro del voto en blanco o algo más está pasando? ¿Hay efectos Bradley en Colombia, donde algunos prefieren no decirle a las encuestas lo que realmente piensan hacer? Existen muchas maneras de que la información que reflejan las encuestas sea diferente a lo que se materializa en las urnas. En algunos casos puede haber errores muestrales que pasan por azar, o por fallas en la recolección de datos por parte de las encuestadoras. En otros casos se pueden presentar errores no muestrales frente a los cuales las encuestas tienen pocas defensas. Tal vez la única defensa es que haya muchas encuestas, hechas de manera diferente por varios encuestadores, y que los errores de cada uno sean diferentes. Las encuestadoras podrían ayudar haciendo preguntas retrospectivas y midiendo la certeza del voto de cada persona que responde.

Lo importante es que las desviaciones entre las encuestas y los resultados no deben verse automáticamente como mala fe, fraude estadístico, incompetencia o evidencia de que se cocinan los resultados para que favorezcan a A o B. Los errores muestrales y, más importante, los errores no muestrales, pueden estar ahí enlodando todo lo que vemos.

Notas

  1. Hay más tipos de errores no muestrales, así que abajo va una lista corta y para los más entusiastas se recomienda leer Lohr (2021) y Shirani-Mehr et al (2018)↩︎

  2. Algo similar hizo @JorgeGalindo del El País↩︎

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🏳️️️¿Con qué se come la indecisión y el voto en blanco?},
  date = {2022-04-14},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-14-voto-blanco/2022-voto-blanco.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🏳️️️¿Con qué se come la indecisión y el voto en blanco?” April 14. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-14-voto-blanco/2022-voto-blanco.html.
]]> voto en blanco encuestas https://www.recetas-electorales.com/elecciones/2022-colombia/2022-04-14-voto-blanco/2022-voto-blanco.html Wed, 13 Apr 2022 22:00:00 GMT 🗳️ Calentando el horno, las consultas Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-14-consultas/2022-consultas.html

“Prejudice is a great time saver. You can form opinions without having to get the facts.”
– E. B. White

Aciertos y desaciertos

Las encuestas tuvieron una buena jornada ayer. Invamer, CNCSocial, Cifras y Conceptos, Guarumo y AtlasIntel capturaron juntas el orden de todas consultas. Los mayores aciertos fueron el Pacto Histórico y los mayores desaciertos fueron sobreestimar al ganador de la Coalición Centro Esperanza y subestimar a ganador de la Coalición Equipo por Colombia.

Veamos cada una de las consultas por separado.

🟨 Pacto Histórico

Todas las encuestas acertaron en precisión de proporción de votos y orden de los candidatos. Dado que era la consulta con las más amplias diferencias entre los candidatos, era de esperarse que una muestra bien tomada, incluso pequeña, detectara esas diferencias.

Ver código
# Paquetes ####
library(tidyverse)
library(plotly)

consultas_pacto <- readr::read_delim("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/consultas.csv", delim = "," , locale = locale(encoding = "UTF-8")) %>%
  # Adjust date
  dplyr::mutate(fecha = lubridate::as_date(fecha)) %>%
  # Resultados consultas
  dplyr::bind_rows(consultas_resultados) %>%
  dplyr::mutate(candidato = ifelse(stringr::str_detect(candidato,"alosa"),"Enrique Penalosa",candidato)) %>%
  # Filtrar consulta
  dplyr::filter(consulta %in% c("Pacto Historico","Resultado")) %>% 
  # Margenes de error
  dplyr::mutate(int_voto_max = int_voto+margen_error,
                int_voto_min = int_voto-margen_error) %>%
  # Plot
  ggplot2::ggplot(ggplot2::aes(x=candidato %>% reorder(dplyr::desc(votos)),y=int_voto))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,color=encuestadora,
                 text = paste('Candidato: ', candidato,
                              '<br>Intencion de voto/% votacion:', paste(int_voto,"%"),
                              '<br>Votos:', prettyNum(votos, big.mark = " "),
                              '<br>Encuestadora/Resultado:',encuestadora)),size=5,show.legend = FALSE)+
  ggplot2::coord_flip()+
  ggplot2::theme(legend.position = "bottom",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        panel.background = ggplot2::element_rect(fill="white",color="white"),
        strip.background = ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\n% votos")+
  ggplot2::scale_shape_manual(values=c(4,5,16,17,10))+ #
  ggplot2::scale_color_manual(values=c("gold2","gold2","gold2","gold2","#ff4800")) 
  
# ggplotly ####
plotly::ggplotly(consultas_pacto, tooltip = "text")

Consulta Pacto Historico

🟩 Centro Esperanza

Las encuestas sobrestimaron a Sergio Fajardo y a Alejandro Gaviria, y subestimaron a Carlos Amaya. Acertaron en la votación de Juan Manuel Galan y Jorge Enrique Robledo.

Ver código
# Paquetes ####
library(tidyverse)
library(plotly)

consultas_centro <- readr::read_delim("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/consultas.csv", delim = "," , locale = locale(encoding = "UTF-8")) %>%
  # Adjust date
  dplyr::mutate(fecha = lubridate::as_date(fecha)) %>%
  # Resultados consultas
  dplyr::bind_rows(consultas_resultados) %>%
  dplyr::mutate(candidato = ifelse(stringr::str_detect(candidato,"alosa"),"Enrique Penalosa",candidato)) %>%
  # Filtrar consulta
  dplyr::filter(consulta %in% c("Centro Esperanza","Resultado")) %>% 
  # Margenes de error
  dplyr::mutate(int_voto_max = int_voto+margen_error,
                int_voto_min = int_voto-margen_error) %>%
  #Order 
  dplyr::mutate(candidato = factor(candidato,levels=c("Jorge Enrique Robledo","Alejandro Gaviria","Carlos Amaya","Juan Manuel Galan","Sergio Fajardo"))) %>%
  # Plot
  ggplot2::ggplot(ggplot2::aes(x=candidato,y=int_voto))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,color=encuestadora,
                 text = paste('Candidato: ', candidato,
                              '<br>Intencion de voto/% votacion:', paste(int_voto,"%"),
                              '<br>Votos:', prettyNum(votos, big.mark = " "),
                              '<br>Encuestadora/Resultado:',encuestadora)),size=5,show.legend = FALSE)+
  ggplot2::coord_flip()+
  ggplot2::theme(legend.position = "bottom",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        panel.background = ggplot2::element_rect(fill="white",color="white"),
        strip.background = ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\n% votos")+
  ggplot2::scale_shape_manual(values=c(4,5,16,17,10))+ #
  ggplot2::scale_color_manual(values=c("forestgreen","forestgreen","forestgreen","forestgreen","#ff4800")) 
  
# ggplotly ####
plotly::ggplotly(consultas_centro, tooltip = "text")

Consulta Centro Esperanza

🟦 Equipo por Colombia

Las encuestas estuvieron muy lejos de detectar el resultado de esta consulta. Antes del 13 de marzo, 3 candidatos estaban disputándose el primer lugar, pero Federico Gutierrez superó por un amplio márgen a Alex Char y a David Barguil.

Ver código
# Paquetes ####
library(tidyverse)
library(plotly)

consultas_equipo <- readr::read_delim("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/consultas.csv", delim = "," , locale = locale(encoding = "UTF-8")) %>%
  # Adjust date
  dplyr::mutate(fecha = lubridate::as_date(fecha)) %>%
  # Resultados consultas
  dplyr::bind_rows(consultas_resultados) %>%
  dplyr::mutate(candidato = ifelse(stringr::str_detect(candidato,"alosa"),"Enrique Penalosa",candidato)) %>%
  # Filtrar consulta
  dplyr::filter(consulta %in% c("Equipo por Colombia","Resultado")) %>% 
  # Margenes de error
  dplyr::mutate(int_voto_max = int_voto+margen_error,
                int_voto_min = int_voto-margen_error) %>%
  #Order 
  dplyr::mutate(candidato = factor(candidato,levels=c("Enrique Penalosa","Aydee Lizarazo","David Barguil","Alex Char","Federico Gutierrez"))) %>%
  # Plot
  ggplot2::ggplot(ggplot2::aes(x=candidato,y=int_voto))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,color=encuestadora,
                 text = paste('Candidato: ', candidato,
                              '<br>Intencion de voto/% votacion:', paste(int_voto,"%"),
                              '<br>Votos:', prettyNum(votos, big.mark = " "),
                              '<br>Encuestadora/Resultado:',encuestadora)),size=5,show.legend = FALSE)+
  ggplot2::coord_flip()+
  ggplot2::theme(legend.position = "bottom",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        panel.background = ggplot2::element_rect(fill="white",color="white"),
        strip.background = ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\n% votos")+
  ggplot2::scale_shape_manual(values=c(4,5,21,16,17,10))+ #
  ggplot2::scale_color_manual(values=c("#2578B6","#2578B6","#2578B6","#2578B6","#2578B6","#ff4800")) 
  
# ggplotly ####
plotly::ggplotly(consultas_equipo, tooltip = "text")

Consulta Equipo por Colombia

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🗳️ Calentando el horno, las consultas},
  date = {2022-03-14},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-14-consultas/2022-consultas.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🗳️ Calentando el horno, las consultas.” March 14. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-14-consultas/2022-consultas.html.
]]> elecciones consultas encuestadoras encuestas https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-14-consultas/2022-consultas.html Sun, 13 Mar 2022 23:00:00 GMT 🥇 Recetario abierto, un concurso predictivo Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-18-concurso/2022-concurso.html

“As powerful as single models can be, a collection of models accomplishes even more.”
– Scott E. Page

Más recetas, más cocineros

Todos tenemos un modelo en la cabeza de lo que pasa durante unas elecciones –una representación de lo que vemos, de lo que creemos que ocurre y lo que creemos que ocurrirá.

Algunos modelos vienen en forma de especulaciones redactadas en columnas de opinión. Otros vienen de combinar chismes y la información de pasillos, reales o virtuales, sobre las campañas y sus candidatos. Así no sea una #recetaselectorales preparada con datos y modelos estadísticos, hay modelos electorales por todas partes.

Esta receta es una invitación abierta a hacer parte de un recetario electoral más completo, diverso y transparente. La idea es combinar múltiples perspectivas con el ánimo de que corrijan mútuamente sus limitaciones, y así entender mejor la carrera electoral. Es una forma de preparar más y mejores recetas electorales, involucrar más cocineros, y que cada receta se cocine de forma clara, transparente y evaluable. Sin salsas secretas.

Las mejores recetas se llevan un premio. Como es más difícil pronosticar la primera vuelta, el premio es mayor. Las recetas que se vayan recibiendo serán publicadas en una tabla en esta página.

TipPremios:

🥇 Ganador 1era vuelta: La Silla Vacia. Un bono de USD 50 de Amazon

🥇 Ganador 2da vuelta: @PolicitaConDato. Un bono de USD 40 de Amazon

🏆 Oro, plata y bronce electoral

El podio de recetas abiertas quedó así:

Ver código
library(tidyverse)
library(kableExtra)
library(RColorBrewer)
library(here)

# Evaluacion Cafe ####
readr::read_csv(here("elecciones","2022-colombia","2022-03-18-concurso","sancocho_resultados.csv")) %>%
  dplyr::select(nombres, plato,pronostico) %>%
  tidyr::pivot_wider(names_from = "plato", values_from = "pronostico") %>%
  tidyr::pivot_longer(cols = c("Encuestas","Simple 2022","Mixto 2022","Ajiaco","@PoliticaConDato","@ColombiaRisk","@JorgeGalindo El Pais","La Silla Vacia","@calc_electoral"), names_to = "plato",values_to = "pronostico") %>%
  # Evaluacion
  dplyr::mutate(evaluacion = abs(Resultado  - pronostico)) %>%
  dplyr::group_by(plato) %>% 
  dplyr::summarize(score = sum(evaluacion)) %>%
  dplyr::arrange(score) %>%
  knitr::kable("html", 
        digits=1,
        caption = "Evaluacion de pronósticos para la primera vuelta de 2022:",
        col.names = c("Fuente",
                      "Score Pronóstico")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  # Gold
  kableExtra::row_spec(1,bold=TRUE, italic = TRUE, background="#EEC900",color = "black") %>%
  # Silver
  kableExtra::row_spec(2,bold=TRUE, italic = TRUE, background="#B3B3B3",color = "black") %>%
  # Bronce
  kableExtra::row_spec(3,bold=TRUE, italic = TRUE, background="#CD651B", color = "black") %>%
  kableExtra::footnote(general = c("Score: Distancia absoluta promedio",
                      "Fuente: www.recetas-electorales.com"))
Evaluacion de pronósticos para la primera vuelta de 2022:
Fuente Score Pronóstico
Encuestas 10.0
La Silla Vacia 10.9
@calc_electoral 11.6
@JorgeGalindo El Pais 15.1
@PoliticaConDato 20.0
Ajiaco 21.9
@ColombiaRisk 28.0
Mixto 2022 28.1
Simple 2022 29.3
Note:
Score: Distancia absoluta promedio
Fuente: www.recetas-electorales.com

Recetas abiertas: Evaluación usando distancias absolutas 1era vuelta

Ver código
library(tidyverse)
library(kableExtra)
library(RColorBrewer)

# Encuestas 2022 ####
encuestas_ulr_2022 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"
encuestas_2022 <- readr::read_csv(encuestas_ulr_2022)

# 0. Resultado 2da vuelta ####
resultado_2da_vuelta_2022 <- tibble::tribble(~pronostico,~nombres,
                     50.44,"Gustavo Petro",
                     47.31,"Rodolfo Hernandez") %>%
  dplyr::mutate(plato = "Resultado")

# 1. Base: promedio de las encuestas ####
encuestas_2da_vuelta_2022 <- encuestas_2022 %>%
  # Filter despues de consultas 
  dplyr::filter(fecha >= lubridate::as_date("2022-05-29")) %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,tidyselect::contains(c("petro","hernandez")),blanco,otros) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>%
  # Promedios
  dplyr::group_by(candidato) %>%
  dplyr::summarise(pronostico = mean(int_voto,na.rm=TRUE),
                   high = max(int_voto,na.rm=TRUE),
                   low = min(int_voto,na.rm=TRUE)) %>%
  dplyr::mutate(plato= paste0("Encuestas"),
                nombres = dplyr::case_when(candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro",
                                    candidato=="blanco" ~ "Voto en blanco",
                                    candidato=="otros" ~ "Otros candidatos",
                                    )
                ) 

# 4. El País ####
elpais_2da_2022 <- readr::read_csv("https://raw.githubusercontent.com/JorgeGalindo/co-elect-2022/main/promedio_evol_2av.csv") %>% 
  dplyr::slice_tail(n=1) %>%
  dplyr::select(gustavo_petro, rodolfo_hernandez) %>%
  tidyr::pivot_longer(cols = dplyr::everything(),names_to = "candidato",values_to = "pronostico") %>%
  dplyr::mutate(plato= "@JorgeGalindo El Pais",
                nombres = dplyr::case_when(candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    )
                ) 
  
# 5. La Silla Vacia ####
lsv_2022_2da <- tibble::tribble(~pronostico,~nombres,
                     47.2,"Gustavo Petro",
                     46.5,"Rodolfo Hernandez",
                     4,"Voto en blanco") %>%
  dplyr::mutate(plato = "La Silla Vacia")

# 6. PoliticaConDato ####
politicacondato_2da_2022 <- tibble::tribble(~pronostico,~nombres,~high,~low,
                     48.3,"Gustavo Petro",54.1,44.8,
                     47.3,"Rodolfo Hernandez",50.7,41.4) %>%
  dplyr::mutate(plato = "@PoliticaConDato")

# 8. Calculo Electoral ####
calculo_electoral_2da_2022 <- tibble::tribble(~nombres,~pronostico,~low,~high,
                     "Gustavo Petro",48,NA,NA,
                     "Rodolfo Hernandez",47.3,NA,NA
                     ) %>%
  dplyr::mutate(plato = "@calc_electoral")
  
# 9 Sergio Calvo
sergio_calvo_2da_2022 <-  tibble::tribble(~nombres,~pronostico,~low,~high,
                     "Gustavo Petro",48.19,50.83,44.36,
                     "Rodolfo Hernandez",47.69,53.98,40.24
                     ) %>%
  dplyr::mutate(plato = "@Scalvo25")


# Preparar cafe 2da vuelta ####
concurso2022_2da_vuelta <- dplyr::bind_rows(
                             resultado_2da_vuelta_2022,
                             encuestas_2da_vuelta_2022,
                             elpais_2da_2022,
                             lsv_2022_2da,
                             politicacondato_2da_2022,
                             sergio_calvo_2da_2022,
                             calculo_electoral_2da_2022
                             ) %>%
  dplyr::select(plato,nombres,pronostico,high,low) %>%
  dplyr::mutate(nombres = factor(nombres, levels=c("Gustavo Petro","Rodolfo Hernandez")),
                plato = factor(plato,levels = c("Resultado","@JorgeGalindo El Pais","La Silla Vacia","@PoliticaConDato","@calc_electoral","@Scalvo25","Encuestas"))) 

# Concurso 2022 ####
concurso2022_2da_vuelta %>%
  dplyr::filter(!is.na(nombres)) %>%
  dplyr::select(nombres, plato,pronostico) %>%
  tidyr::pivot_wider(names_from = "plato", values_from = "pronostico") %>%
  tidyr::pivot_longer(cols = c("@JorgeGalindo El Pais","La Silla Vacia","@PoliticaConDato","@calc_electoral","@Scalvo25","Encuestas"), names_to = "plato",values_to = "pronostico") %>%
  # Evaluacion
  dplyr::mutate(evaluacion = abs(Resultado  - pronostico)) %>%
  dplyr::group_by(plato) %>% 
  dplyr::summarize(score = sum(evaluacion)) %>%
  dplyr::arrange(score) %>%
  knitr::kable("html", 
        digits=1,
        caption = "Evaluacion de pronósticos para la segunda vuelta de 2022:",
        col.names = c("Fuente",
                      "Score Pronóstico")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  # Gold
  kableExtra::row_spec(1,bold=TRUE, italic = TRUE, background="#EEC900",color = "black") %>%
  # Silver
  kableExtra::row_spec(2,bold=TRUE, italic = TRUE, background="#B3B3B3",color = "black") %>%
  # Bronce
  kableExtra::row_spec(3,bold=TRUE, italic = TRUE, background="#CD651B", color = "black") %>%
  kableExtra::footnote(general = c("Score: Distancia absoluta promedio",
                      "Fuente: www.recetas-electorales.com"))
Evaluacion de pronósticos para la segunda vuelta de 2022:
Fuente Score Pronóstico
@PoliticaConDato 2.2
@calc_electoral 2.5
@Scalvo25 2.6
@JorgeGalindo El Pais 3.6
La Silla Vacia 4.0
Encuestas 6.2
Note:
Score: Distancia absoluta promedio
Fuente: www.recetas-electorales.com

Recetas abiertas: Evaluación usando distancias absolutas 2da vuelta

¿Qué tengo que hacer para participar?

Para participar solo hay que enviar una receta a recetas.electorales@gmail.com antes del 22 de Mayo de 2022 para la primera vuelta y antes del 18 de Junio de 2022 para la segunda. Recetas recibidas después cada jornada electoral no cuentan, son descalificadas.

Como las recetas electorales, cada plato debe tener 4 componentes mínimos:

  1. 👨‍🍳 Cocinero y Nombre de la receta: Identidad del que preparó el plato, que puede ser personal o institucional, un nombre para el plato y autorización para publicar en las Recetas Electorales los Ingredientes, Cocina y Plato.
  2. 🍚 Ingredientes - Datos: Todos los datos que usa el modelo deben estar referenciados y deben hacerse públicamente disponibles. Lo mejor es que el modelo tenga un repositorio con todos los datos que utiliza, por ejemplo en GitHub. No hay restriciones sobre los datos que se utilicen mientras se puedan verificar y referenciar.
  3. 🍳 Cocina - Cálculos y Modelos: Cualquier cálculo o modelo estadístico debe incluir el código para estimarlo, evaluarlo, y calcular los pronósticos que resulten. Adicionalmente debe incluir cualquier transformación de los datos (limpieza, wrangling, etc.). Todas las técnicas, desde las más sencillas hasta las más complejas, son aceptadas siempre y cuando sean reproducibles. El código debe ser replicable y puede enviarse en múltiples lenguajes de programación (R, Python, Julia, Stan, etc.)
  4. 🍲 Plato - Resultados: Cada modelo debe resultar en un pronóstico numérico de la votación o proporción de votos que cada candidato obtendrá. Se deben hacer pronósticos sobre todos los candidatos, no solo unos cuantos. Los intervalos de confianza/credibilidad son opcionales, según los vea necesarios cada cocinero.

El ganador

La receta ganadora se determinará por la precisión del pronóstico: El ganador será el modelo con la menor suma del valor absoluto para todos los N candidatos, ponderados por igual, determinada así:

Si se pronostican proporciones, los votos se miden con respecto al total de votos válidos: votos totales menos votos nulos.

Ejemplo: Un promedio simple de las encuestas disponibles

Ingredientes - Datos

Esta receta usa los datos en el repositorio de GitHub, asi que este paso es solo una linea.

Ver código
# Paquetes ####
library(tidyverse)

# URL GitHub ####
ejemplo_url <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"

# Acceder datos ####
ejemplo_datos <- readr::read_csv(ejemplo_url)

Cocina (Modelos) y Plato (Resultados):

Para calcular los promedios para cada candidato se usa el siguiente código y el resultado se resume en una tabla. Dado que es un promedio simple, no incluye intervalos, así que se registra No disponible (ND) para cada candidato:

Ver código
library(tidyverse)
library(kableExtra)

ejemplo_datos %>% 
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,encuestadora,muestra,tidyselect::contains("_"),merror=margen_error,-tasa_respuesta,-ns_nr,-muestra_int_voto) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = tidyselect::contains("_"),
                      names_to = "candidato", values_to = "int_voto") %>% 
  # Crear algunas variables
  dplyr::mutate(nombres = dplyr::case_when(candidato=="alejandro_gaviria" ~ "Alejandro Gaviria",
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="juan_m_galan" ~ "Juan Manuel Galan",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="alex_char" ~ "Alex Char",
                                    candidato=="david_barguil" ~ "David Barguil",
                                    candidato=="enrique_penalosa" ~ "Enrique Peñalosa",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="oscar_i_zuluaga" ~ "Oscar I. Zuluaga",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro") %>%
                  factor()) %>%
  dplyr::group_by(nombres) %>% 
  dplyr::summarise(pronostico=mean(int_voto,na.rm=TRUE)) %>%
  dplyr::mutate(intervalo = "ND") %>%
  dplyr::arrange(dplyr::desc(pronostico)) %>%
  knitr::kable("html", 
        digits=1,
        caption = "Pronostico: % votos por candidato (Basado en encuestas N=3)",
        col.names = c("Candidato",
                      "Pronostico",
                      "Intevalo")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>% 
  kableExtra::footnote(number = c("Cocinero: Recetas Electorales",
                      "Fecha pronóstico: 2022-14-03",
                      "Twitter: @recetaelectoral"))
Pronostico: % votos por candidato (Basado en encuestas N=3)
Candidato Pronostico Intevalo
Gustavo Petro 38.5 ND
Federico Gutierrez 22.2 ND
Rodolfo Hernandez 22.1 ND
Sergio Fajardo 8.0 ND
Alex Char 6.9 ND
Oscar I. Zuluaga 3.8 ND
Juan Manuel Galan 3.5 ND
Alejandro Gaviria 2.3 ND
David Barguil 1.8 ND
Ingrid Betancourt 1.7 ND
Enrique Peñalosa 1.4 ND
1 Cocinero: Recetas Electorales
2 Fecha pronóstico: 2022-14-03
3 Twitter: @recetaelectoral

Evaluación (Hipotética)

Supongamos que se disuelven todas las consultas y se presentan todos los candidatos el 29 de mayo. Ese día se evalúan los resultados del pronóstico así:

Ver código
library(tidyverse)

ejemplo_datos %>% 
  dplyr::select(n,fecha,encuestadora,muestra,tidyselect::contains("_"),merror=margen_error,-tasa_respuesta,-ns_nr,-muestra_int_voto) %>%
  tidyr::pivot_longer(cols = tidyselect::contains("_"),
                      names_to = "candidato", values_to = "int_voto") %>% 
  dplyr::mutate(nombres = dplyr::case_when(candidato=="alejandro_gaviria" ~ "Alejandro Gaviria",
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="juan_m_galan" ~ "Juan Manuel Galan",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="alex_char" ~ "Alex Char",
                                    candidato=="david_barguil" ~ "David Barguil",
                                    candidato=="enrique_penalosa" ~ "Enrique Peñalosa",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="oscar_i_zuluaga" ~ "Oscar I. Zuluaga",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro") %>%
                  factor()) %>%
  dplyr::group_by(nombres) %>% 
  # Estimacion promedios
  dplyr::summarise(pronostico=mean(int_voto,na.rm=TRUE)) %>%
  # Join resultados hipoteticos
  dplyr::left_join(
    tibble::tribble(~nombres,~resultado_hipotetico,
        "Alejandro Gaviria",10,
        "Sergio Fajardo",15,
       "Juan Manuel Galan",6,
       "Ingrid Betancourt",6,
       "Alex Char",3,
       "David Barguil",3,
       "Enrique Peñalosa",2,
       "Federico Gutierrez",20,
       "Oscar I. Zuluaga",5,
       "Rodolfo Hernandez",5,
       "Gustavo Petro",20,
       "Blanco",5),
       by="nombres") %>%
  # Evaluacion individual
  dplyr::mutate(evaluacion = abs(resultado_hipotetico - pronostico),
                n = dplyr::n()) %>%
  # Puntaje
  dplyr::mutate(puntaje = cumall(evaluacion)/max(n)) %>%
  dplyr::distinct(puntaje) %>%
  knitr::kable("html", 
        digits=2,
        caption = "Puntaje final pronostico:") %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::column_spec(1,  bold=T, background = "#D7261E", color = "white") %>%
  kableExtra::footnote(number = c("Cocinero: Recetas Electorales","Twitter: @recetaelectoral","Fecha pronostico: 2022-14-03"))
Puntaje final pronostico:
puntaje
0.09
1 Cocinero: Recetas Electorales
2 Twitter: @recetaelectoral
3 Fecha pronostico: 2022-14-03

Sugerencias para cocineros creativos

Hay muchos aspectos de las elecciones que se pueden analizar a través de recetas basadas en datos y modelos reproducibles.

Algunas ideas sueltas:

  • Dinámicas regionales: ¿Cómo se distribuyen las votaciones de cada candidatos por departamento y municipio?
  • Voto inconforme: ¿Qué dice el voto en blanco sobre la dinámica electoral? ¿Cómo varía el voto en blanco por vuelta y por geografía?
  • Maquinarias: ¿Cómo se puede modelar la influencia de las maquinarias sobre las elecciones?
  • Sofisticaciones estadísticas: Procesos Gaussianos, ML, etc.

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🥇 Recetario abierto, un concurso predictivo},
  date = {2022-03-08},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-18-concurso/2022-concurso.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🥇 Recetario abierto, un concurso predictivo.” March 8. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-18-concurso/2022-concurso.html.
]]> elecciones pronósticos encuestas https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-18-concurso/2022-concurso.html Mon, 07 Mar 2022 23:00:00 GMT 🍽️ Entrada, las encuestas juntas Recetas Electorales https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-11-entrada/2022-entrada.html

“Information is the resolution of uncertainty.”
–Claude Shanonn

Los datos compilados de las encuestas están consolidados en Github gracias a la información que las encuestadoras Invamer, CNCSocial, Yanhaas, Guarumo, CELAGeopolitica, Mosqueteros, TYSE y AtlasIntel han hecho públicas.

De manera provisional se incluyen las encuestas telefónicas de la encuestadora mexicana MassiveCaller, ya que la firma sube un archivo en el mismo URL con cada publicación.

Luego de la primera vuelta entró GAD3 con un tracker diario. Este ejercicio es muy útil por la frecuencia de medición, pero probablemente tenga un poder muy bajo y no merezca la atención diaria que seguramente va a recibir1. En la Entrada, solo se registrará la más reciente estimación de GAD3.

Para que se desaparezcan rápido las encuestas fantasmas como la que detectó La Silla Vacía en un inusual sesgo de confirmación de la campaña de Alejandro Gaviria, es bueno tener presente la lista de las 92 encuestadoras autorizadas por el CNE en el país a Diciembre 2021. La tabla de encuestadoras está al final.

Todas las encuestas juntas, al día

Ver código
library(tidyverse)
library(plotly)
library(lubridate)
library(ggrepel)
library(DT)
library(RColorBrewer)

# Encuestas ####
encuestas_ulr_2022 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2022/main/Encuestas%202022/encuestas_2022.csv"
encuestas_2022 <- readr::read_csv(encuestas_ulr_2022)

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

# ggplot entrada 2022 ####
entrada_2022 <- encuestas_2022 %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,encuestadora,tidyselect::contains("_"), blanco,otros,muestra,merror=margen_error) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = c(tidyselect::contains("_"),"blanco","otros"),
                      names_to = "candidato", values_to = "int_voto") %>% 
  # Crear algunas variables
  dplyr::mutate(e_max = int_voto + merror,
                e_min = int_voto - merror,
                fecha = lubridate::as_date(fecha),
                nombres = dplyr::case_when(candidato=="alejandro_gaviria" ~ "Alejandro Gaviria",
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="juan_m_galan" ~ "Juan Manuel Galan",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="alex_char" ~ "Alex Char",
                                    candidato=="david_barguil" ~ "David Barguil",
                                    candidato=="enrique_penalosa" ~ "Enrique Peñalosa",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="oscar_i_zuluaga" ~ "Oscar I. Zuluaga",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro",
                                    candidato=="blanco" ~ "Voto en blanco",
                                    ) %>%
                  factor(),
                order_colors = as.numeric(nombres)) %>%
  # Filter non candidates
  dplyr::filter(!is.na(int_voto), !candidato %in% c("otros","ns_nr"),!is.na(nombres)) %>% 
  # ggplot
  ggplot2::ggplot(ggplot2::aes(x=fecha,y=int_voto, color=nombres))+ #,frame=lubridate::month(fecha) 
  # Antes de consulta 13 de marzo
  ggplot2::geom_point(data = . %>% dplyr::filter(fecha<=lubridate::as_date("2022-03-13")),
             ggplot2::aes(shape=encuestadora,
                 text = paste('Candidato: ', nombres,
                              '<br>Intencion de voto:', int_voto,
                              '<br>Encuestadora:',encuestadora,
                              '<br>Fecha:', fecha)),
             position = "jitter",
             size=4)+
  # Despues de consulta 13 de marzo
  ggplot2::geom_point(data = . %>% dplyr::filter(dplyr::between(fecha,
                                                lubridate::as_date("2022-03-13"),
                                                lubridate::as_date("2022-05-29")),
                                                !is.na(int_voto)),
             ggplot2::aes(shape=encuestadora,
                 text = paste('Candidato: ', nombres,
                              '<br>Intencion de voto:', int_voto,
                              '<br>Encuestadora:',encuestadora,
                              '<br>Fecha:', fecha)),
             position = "jitter",
             size=4)+
   # Despues de 1era vuelta
  ggplot2::geom_point(data = . %>% dplyr::filter(fecha>=lubridate::as_date("2022-05-29", !is.na(int_voto))),
             ggplot2::aes(shape=encuestadora,
                 text = paste('Candidato: ', nombres,
                              '<br>Intencion de voto:', int_voto,
                              '<br>Encuestadora:',encuestadora,
                              '<br>Fecha:', fecha)),
             position = "jitter",
             size=4)+
  # Resultados primera vuelta
  ggplot2::geom_point(data = tibble::tribble(~fecha,~int_voto,~nombres,
                     lubridate::as_date("2022-05-29"),39.84,"Gustavo Petro",
                     lubridate::as_date("2022-05-29"),23.64,"Federico Gutierrez",
                     lubridate::as_date("2022-05-29"),4.13,"Sergio Fajardo",
                     lubridate::as_date("2022-05-29"),27.82,"Rodolfo Hernandez"),
             ggplot2::aes(
                 text = paste('Candidato: ', nombres,
                              '<br>Resultado:', int_voto)), 
             position = "jitter",
             size=8,
             shape=10,
             show.legend = FALSE
             ) +
  # Resultados primera vuelta
  ggplot2::geom_point(data = tibble::tribble(~fecha,~int_voto,~nombres,
                     lubridate::as_date("2022-06-19"),50.44,"Gustavo Petro",
                     lubridate::as_date("2022-06-19"),47.31,"Rodolfo Hernandez"),
             ggplot2::aes(
                 text = paste('Candidato: ', nombres,
                              '<br>Resultado:', int_voto)), 
             position = "jitter",
             size=8,
             shape=10,
             show.legend = FALSE
             ) +
  # LOESS antes de la primera vuelta
  #ggplot2::geom_smooth(
  #  data = . %>% dplyr::filter(dplyr::between(fecha,
  #                                     lubridate::as_date("2022-03-13"),
  #                                     lubridate::as_date("2022-05-29")),
  #                                     !is.na(int_voto)),
  #            method="loess", linetype="dotdash", se=TRUE, show.legend = FALSE)+
  # LOESS para segunda vuelta
  #ggplot2::geom_smooth(
  #  data = . %>% dplyr::filter(fecha>=lubridate::as_date("2022-03-13"),
  #                                     !is.na(int_voto),candidato %in% c(" rodolfo_hernandez","gustavo_petro")
  #                             ),
  #            method="loess", linetype="dotdash", fill="orangered",se=TRUE, show.legend = FALSE)+
  # LOESS final
  ggplot2::geom_smooth(method="loess", linetype="dotdash",se=TRUE, show.legend = FALSE)+
  # Margenes de error
  ggplot2::geom_linerange(ggplot2::aes(ymax=e_max, ymin=e_min), 
                position = "jitter",
                 show.legend = FALSE) +
  #  Legislativas
  ggplot2::geom_vline(xintercept = as.numeric(lubridate::as_date("2022-03-13")), color="royalblue2")+
  #  1era vuelta
  ggplot2::geom_vline(xintercept = as.numeric(lubridate::as_date("2022-05-29")), color="orangered")+
  #  2da vuelta
  ggplot2::geom_vline(xintercept = as.numeric(lubridate::as_date("2022-06-19")), color="red")+
  # Opciones
  ggplot2::labs(x="", 
       y="% Intención voto",
       caption="Fuente: Encuestas de intención de voto")+
   ggplot2::scale_shape_manual(values=shape_entrada_2022)+
   ggplot2::scale_color_manual(values=colors_entrada_2022)+
   ggplot2::coord_cartesian(ylim=c(0,60))+
   ggplot2::guides(shape = "none", color = ggplot2::guide_legend(title = NULL))+
   ggplot2::theme(
     legend.position="bottom",
     panel.background=ggplot2::element_rect(fill="white", color="white")
     )

#ggplotly ####
plotly::ggplotly(entrada_2022, tooltip = "text") |>
  plotly::layout(
    legend = list(orientation = "h", y = -0.15, x = 0.5, xanchor = "center"),
    xaxis = list(
      rangeslider = list(visible = TRUE, thickness = 0.04),
      rangeselector = list(
        buttons = list(
          list(step = "all", label = "Todo"),
          list(count = 3, step = "month", stepmode = "backward", label = "3m"),
          list(count = 1, step = "month", stepmode = "backward", label = "1m")
        )
      )
    )
  )

Entrada 2022: Todas las encuestas juntas

Buscador de encuestas

Ver código
library(tidyverse)
library(lubridate)
library(htmlwidgets)
library(DT)

#DT ####
encuestas_2022 %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,encuestadora,tidyselect::contains("_"), muestra,merror=margen_error, fuente, link) %>%
  # Pivotear los datos
  tidyr::pivot_longer(cols = tidyselect::contains("_"), 
                      names_to = "candidato", values_to = "int_voto") %>% 
  # Crear algunas variables
  dplyr::mutate(e_max = int_voto + merror,
                e_min = int_voto - merror,
                fecha = lubridate::as_date(fecha),
                nombres = dplyr::case_when(candidato=="alejandro_gaviria" ~ "Alejandro Gaviria",
                                    candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                    candidato=="juan_m_galan" ~ "Juan Manuel Galán",
                                    candidato=="ingrid_betancourt" ~ "Ingrid Betancourt",
                                    candidato=="alex_char" ~ "Alex Char",
                                    candidato=="david_barguil" ~ "David Barguil",
                                    candidato=="enrique_penalosa" ~ "Enrique Peñalosa",
                                    candidato=="federico_gutierrez" ~ "Federico Gutierrez",
                                    candidato=="oscar_i_zuliaga" ~ "Oscar I. Zuluaga",
                                    candidato=="rodolfo_hernandez" ~ "Rodolfo Hernandez",
                                    candidato=="gustavo_petro" ~ "Gustavo Petro"
                                    )) %>%
  #Select variables
  dplyr::select(fecha,encuestadora,nombres,int_voto,merror,muestra, fuente,link) %>%
  dplyr::filter(!is.na(int_voto),!is.na(nombres)) %>%
  DT::datatable(filter = "top",
                extensions = "Buttons",
                options = list(dom = 'Bfrtip',
                               buttons = c('copy', 'csv', 'excel'),
                               autoWidth = TRUE,
                               scrollX = TRUE,
                               initComplete = htmlwidgets::JS(
          "function(settings, json) {",
          paste0("$(this.api().table().container()).css({'font-size': '", "11px", "'});"),
          "}")),
                colnames = c('Fecha', 'Encuestadora', 'Candidato', 'Intencion de voto', 'Margen de error',"Muestra","Fuente","Enlace"),
                caption = 'Tabla de encuestadoras')

Buscador de encuestadoras autorizadas

Ver código
library(tidyverse)
library(lubridate)
library(readxl)
library(DT)

#DT ####
readxl::read_excel(paste0(getwd(),"/cne/Firmas Encuestadoras Vigentes - 15 de Diciembre de 2021.xlsx")) %>%
  dplyr::select("encuestadora"=2,"representante_legal"=3,"direccion"=4,"ciudad"=5,"telefono"=6,"email"=7) %>%
  dplyr::filter(!stringr::str_detect(encuestadora,"FIRMA")) %>%
  DT::datatable(filter = "top",
                extensions = "Buttons",
                options = list(dom = 'Bfrtip',
                               buttons = c('copy', 'csv', 'excel'),
                               autoWidth = TRUE,
                               scrollX = TRUE,
                               initComplete = htmlwidgets::JS(
          "function(settings, json) {",
          paste0("$(this.api().table().container()).css({'font-size': '", "11px", "'});"),
          "}")),
                colnames = c('Encuestadora', 'Representante Legal', 'Direccion', 'Ciudad', 'Telefono',"Email"),
                caption = 'Tabla de encuestadoras basada en CNE') %>%
  DT::formatStyle(columns = colnames(.), fontSize = '50%')

Notas

  1. Algo más preocupante de este ejercicio es que parece hacer pooling de las muestras diarias que toma.↩︎

Cómo citar

BibTeX
@online{recetas_electorales2022,
  author = {{Recetas Electorales}},
  title = {🍽️ Entrada, las encuestas juntas},
  date = {2022-02-01},
  url = {https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-11-entrada/2022-entrada.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2022. “🍽️ Entrada, las encuestas juntas.” February 1. https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-11-entrada/2022-entrada.html.
]]> encuestas candidatos encuestadoras cne https://www.recetas-electorales.com/elecciones/2022-colombia/2022-03-11-entrada/2022-entrada.html Mon, 31 Jan 2022 23:00:00 GMT 🍫 Postre de la 2da vuelta Recetas Electorales https://www.recetas-electorales.com/elecciones/2018-colombia/2018-06-18-postre-2018/2018-postre.html

“The existence of a problem in knowledge depends on the future being different from the past, while the possibility of a solution of the problem depends on the future being like the past.”
– Frank Knight

El postre busca lograr lo que los anteriores no pudieron: estimar qué tan probable es que gane uno u otro candidato. Para hacer eso el postre le aplica una transformación sencillita al Plato Simple: en vez de servir dos recetas por candidato, se sirve un solo postre logístico para ambos. Esto genera un pronóstico probabilístico para la segunda vuelta.

¿Por qué hacerlo así? Porque según las encuestas la victoria es clara para Duque: todas coinciden en que el candidato de la coalición de derecha obtiene una mayor proporción de votos que su contrincante. Es más, el resultado del Plato Mixto, al que mejor le fue en la primera vuelta, si es aplicado a las encuestas que salieron después del 27 de mayo da como resultado que Duque obtendrá 51% de la votación, con un rango intervalo HPD de 95% de entre 46% y 57%, y Petro obtendría 37%, con un rango HPD de 95% entre 34% y 41%. Así que en vez de decir lo obvio, nos vamos por lo menos evidente, aunque sea más difícil de masticar.

Postre Logístico


Este postre recoge la probabilidad de que @IvanDuque sea presidente, estimada por el modelo que se describe abajo.

Estas probabilidades salen de sacar muchas simulaciones de cada uno de los parámetros del modelo estimado. El resultado es una densidad de la probabilidad de que Duque obtenga más de 50% de la votación. La distribución parece bimodal porque unas encuestas le dan menos de 50% de la votación a Duque, pero el grueso dice lo contrario: en 20% de las simulaciones el modelo estima que Duque gana con más o menos 53% de probabilidad.

ImportanteUn pronóstico probabilístico

@IvanDuque tiene más o menos 65% de probabilidad de obtener más del 50% de la votación.

Ver código
library(tidyverse)
library(posterior)

postre_2018_logis_fit |>
  posterior::as_draws_df() |>
  dplyr::transmute(
    dplyr::across(dplyr::starts_with("a_raw["), ~ stats::plogis(a_bar + s * .x))) |>
  tidyr::pivot_longer(dplyr::everything(),
                      names_to = "encuestadora",
                      values_to = "estimates") |>
  ggplot2::ggplot(ggplot2::aes(x=estimates))+
  ggplot2::geom_density(ggplot2::aes(x=estimates,fill="orangered3",color="grey60"))+
  ggplot2::geom_vline(xintercept=0.5,linetype="dotted")+
  ggplot2::labs(x="Probabilidad de que Duque obtenga más de 50% de la votación",y="Densidad probabilidades estimadas",
       title="Postre logistico 2018", 
       subtitle="10.000 simulaciones del modelo logístico para la 2da vuelta", 
       caption = "Fuente: www.recetas-electorales.com")+
  ggplot2::theme(legend.position = "none",
        panel.background = ggplot2::element_blank())+
  ggplot2::xlim(0.4,0.65)

Postre logistico 2018

Postre logistico 2018

Ingredientes


Los únicos ingredientes de esta receta son las encuestas que han salido desde la primera vuelta. Como priors se toman los promedios y desviaciones estándar de cada candidato.

Ver código
library(tidyverse)
library(lubridate)

# 1. Encuestas 2018 ####
encuestas_ulr_2018 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Elecciones%202018/encuestas2018.csv"
encuestas_2018 <- readr::read_csv(encuestas_ulr_2018)

# 2. Alistamiento de los datos
encuestas_postre_2018 <- encuestas_2018 %>%
  # Seleccionar candidatos que encabezan las encuestas
  dplyr::select(n,fecha,encuestadora,ivan_duque,gustavo_petro, m_error=margen_error, muestra_int_voto,tipo, municipios) %>%
  # Seleccionar solo las encuestas hechas despues de la primera vuelta
  dplyr::filter(lubridate::as_date(fecha)>=lubridate::as_date("2018-05-31")) %>% 
  # Crear algunas variables
  mutate(id = ivan_duque*muestra_int_voto/100, 
         gp = gustavo_petro*muestra_int_voto/100,
         tipo = ifelse(tipo=="Presencial",1,0),
         fecha = as.Date(fecha),
         enc = factor(encuestadora),
         encuestadora=as.numeric(enc)) %>%
  #Crear variable duracion:
  dplyr::mutate(dd = as.Date(as.character(lubridate::today()), format="%Y-%m-%d") - as.Date(as.character(fecha), format="%Y-%m-%d")) %>%
  dplyr::mutate(dd = as.numeric(dd)) %>% 
  dplyr::mutate(dd = 100*(dd/sum(dd))) %>%
  dplyr::mutate(dplyr::across(c("id","gp"),~round(.,digits=0)))

Receta


Este postre modela directamente las encuestas como una distribución binomial donde cada encuesta es un ensayo:

donde es la muestra de cada encuesta y es la proporción de la intención de voto para Iván Duque.

Ahora, la proporción de intención de voto para Duque se determina a través de una función logística (log-link function) y, como es costumbre en este recetario, efectos aleatorios por encuestadora así:


Preparación


Este es el postre completo, con los priors del caso:

Estimación


Este es el modelo en el siempre espeluznante código de RStan:

Ver código
data {
  int<lower=1> N;
  int<lower=1> N_encuestadora;

  // successes
  array[N] int<lower=0> id;

  // trials
  array[N] int<lower=0> muestra_int_voto;

  // pollster index (1..N_encuestadora)
  array[N] int<lower=1, upper=N_encuestadora> encuestadora;
}

parameters {
  real a_bar;                         // population mean logit
  vector[N_encuestadora] a_raw;       // non-centered pollster effects
  real<lower=0> s;                    // between-encuestadora SD (logit scale)
}

transformed parameters {
  vector[N_encuestadora] a;           // pollster-specific logits
  vector[N] eta;                      // linear predictor per observation

  a = a_bar + s * a_raw;
  eta = a[encuestadora];
}

model {
  a_bar ~ normal(0, 0.20);
  s ~ student_t(3, 0, 0.5);          // half-t via <lower=0>

  a_raw ~ std_normal();

  // Likelihood
  id ~ binomial_logit(muestra_int_voto, eta);
}

generated quantities {
  real dev;
  dev = -2 * binomial_logit_lpmf(id | muestra_int_voto, eta);
}


Ahora meter el postre al horno de RStan:

Ver código
library(cmdstanr)

postre_2018_logis_stan <- cmdstanr::cmdstan_model(
  here("elecciones","2018-colombia","2018-06-18-postre-2018","logis.stan"),
  force_recompile = TRUE
)

postre_2018_logis_fit <- postre_2018_logis_stan$sample(
                  data=list(
                    N=dplyr::n_distinct(encuestas_postre_2018$n),
                    N_encuestadora= dplyr::n_distinct(encuestas_postre_2018$encuestadora),
                    muestra_int_voto=encuestas_postre_2018$muestra_int_voto,
                    encuestadora=encuestas_postre_2018$encuestadora,
                    id=encuestas_postre_2018$id),
                  seed = 123,
                  chains = 4,
                  parallel_chains = 4,
                  iter_warmup = 1000,
                  iter_sampling = 4000,
                  adapt_delta = 0.95
                  )


Con algo de trabajo, y a pesar de muchas divergencias iniciales en el muestreo, el postre no se quema y sale del horno.


Para terminar, vamos las densidades de los parámetros estimados usando bayesplot y lanzar shinystan:

Ver código
library(bayesplot)

bayesplot::color_scheme_set("orange")

posterior_logis <- posterior::as_draws_df(postre_2018_logis_fit)
bayesplot::mcmc_areas(posterior_logis,
           prob=0.95,prob_outer = 0.99,
           point_est="mean",
           pars=ggplot2::vars(tidyselect::starts_with("a_raw[")))

Postre 2018: Densidades parametros

Postre 2018: Densidades parametros


Ñapa: Estimación con ulam


Además de la siempre abstrusa representación del código en RStan, en este postre incluyo una alternativa que de paso le hace bombo al paquete rethinking que preparó uno de los mejores cocineros: Richard McElreath.

La especificación del modelo en el código del paquete rethinking, que traduce a un lenguaje más amable el código de RStan, se ve así:

Ver código
library(rethinking)

# Modelo logístico en ulam:
postre_ulam <- rethinking::ulam(
  alist(
    id ~ dbinom(muestra_int_voto, p),
    logit(p) <- a[encuestadora],

    a[encuestadora] ~ dnorm(a_bar, s),
    a_bar ~ dnorm(0, 0.20),
    s ~ dexp(1)
  ),
  data = list(
    id = encuestas_postre_2018$id,
    muestra_int_voto = encuestas_postre_2018$muestra_int_voto,
    encuestadora = encuestas_postre_2018$encuestadora
  ),
  control=list(adapt_delta=0.96),
  iter=4000, warmup=1000, chains=4, cores=2)


Referencias


Este proyecto de Pierre-Antoine Kremp, para las presidenciales en EEUU de 2016, fue la inspiración para estas recetas.

McElreath, R. (2015). Statistical Rethinking. Texts in Statistical Science. Bendito sea Richard McElreath por este texto.

Stan Development Team (2016) Stan Modeling Language: User’s Guide and Reference Manual. Version 2.14.0.

Gelman, A. (2006). Prior distributions for variance parameters in hierarchical models (comment on article by Browne and Draper). Bayesian analysis, 1(3), pp.515-534.

Linzer, D. A. (2013). Dynamic Bayesian forecasting of presidential elections in the states. Journal of the American Statistical Association, 108(501), 124-134.

Wickham, H., & Grolemund, G. (2016). R for data science: import, tidy, transform, visualize, and model data. O’Reilly Media, Inc.

Cómo citar

BibTeX
@online{recetas_electorales2018,
  author = {{Recetas Electorales}},
  title = {🍫 Postre de la 2da vuelta},
  date = {2018-06-10},
  url = {https://www.recetas-electorales.com/elecciones/2018-colombia/2018-06-18-postre-2018/2018-postre.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2018. “🍫 Postre de la 2da vuelta.” June 10. https://www.recetas-electorales.com/elecciones/2018-colombia/2018-06-18-postre-2018/2018-postre.html.
]]> logístico probabilidad pronósticos elecciones https://www.recetas-electorales.com/elecciones/2018-colombia/2018-06-18-postre-2018/2018-postre.html Sat, 09 Jun 2018 22:00:00 GMT ☕ Café después de la 1era vuelta Recetas Electorales https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-28-cafe-2018/2018-cafe.html

“The credibility of inference decreases with the strength of the assumptions maintained”
–Charles Manski

La primera vuelta fue generosa con las encuestas y, claro, con las recetas electorales basadas en encuestas. El mejor pronóstico fue el que resultó de las recetas bayesianas Plato Simple y Plato Mixto. Las recetas fracasaron en identificar la proporción de votos de Sergio Fajardo, la sorpresa de la jornada, pero acertaron para todos los otros candidatos. Más que cualquier otro pronóstico y que cualquier encuesta individual.

TipConclusión: las encuestas son ingredientes valiosos si se cocinan todas juntas
Ver código
library(tidyverse)
library(plotly)
library(here)

colors_cafe <- c("grey50","grey50","grey50","grey50","#ff4800","#ff4800")
shape_cafe <- c(12,18,17,15,10,8)

# Cafe plot ####
cafe_2018_plot <- readr::read_csv(here("elecciones","2018-colombia","2018-05-28-cafe-2018","sancocho_2018.csv")) %>%
  dplyr::filter(fuente!="Resultado") %>%
  ggplot2::ggplot(ggplot2::aes(x=candidato,y=int_voto))+
  ggplot2::geom_point(ggplot2::aes(shape=fuente,color=fuente),size=4,position = position_dodge(0.8))+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=int_voto_max,ymin=int_voto_min,color=fuente),position = position_dodge(0.8),width=0.5)+
  ggplot2::theme(legend.position = "bottom",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        strip.text.x = ggplot2::element_text(size = 8),
        axis.text=ggplot2::element_text(size=11),
        axis.ticks.x=ggplot2::element_blank(),
        axis.text.x=ggplot2::element_blank(),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\n% votos",
       title="Cafe post electoral 2018",
       subtitle="Pronosticos (puntos) vs Resultados (linea punteada)",
       caption="\nFuente: www.recetas-electorales.com")+
  ggplot2::scale_shape_manual(values=shape_cafe)+
  ggplot2::scale_color_manual(values=colors_cafe) +
 # Resultados
  ggplot2::geom_hline(data=readr::read_csv(here("elecciones","2018-colombia","2018-05-28-cafe-2018","sancocho_2018.csv")) %>%
               dplyr::filter(fuente=="Resultado"),ggplot2::aes(yintercept=int_voto,group=candidato),linetype="dashed")+
  # Facets
  ggplot2::facet_wrap(~factor(candidato,levels=c("Ivan Duque","Gustavo Petro","Sergio Fajardo","German Vargas Lleras","Humberto de la Calle")),nrow = 1, scales = "free")

cafe_2018_plot

Café post electoral

Café post electoral
Ver código
#plotly::ggplotly(cafe_plot)

Ñapa: Desviación absoluta promedio para cada pronóstico

Si aplicáramos la fórmula que se utilizará en 🥇 Recetas Abiertas a los pronósticos de la primera vuelta de 2018, este sería el resultado. Los platos Simple y Mixto fueron los más precisos.

::: {#tbl-cap: “Café post electoral: Evaluación usando distancias absolutas” .cell}

Ver código
library(tidyverse)
library(kableExtra)

# Evaluacion Cafe ####
readr::read_csv(here("elecciones","2018-colombia","2018-05-28-cafe-2018","sancocho_2018.csv")) %>%
  dplyr::select(candidato, fuente,int_voto) %>%
  tidyr::pivot_wider(names_from = "fuente", values_from = "int_voto") %>%
  tidyr::pivot_longer(cols = c("18 Encuestas","Simple","Mixto","ANIF","El Pais","Cifras y Conceptos"), names_to = "fuente",values_to = "pronostico") %>%
  # Evaluacion
  dplyr::mutate(evaluacion = abs(Resultado - pronostico)) %>%
  dplyr::group_by(fuente) %>% 
  dplyr::summarize(score = sum(evaluacion)) %>%
  dplyr::arrange(score) %>%
  knitr::kable("html", 
        digits=1,
        caption = "Evaluacion de pronosticos para la primera vuelta de 2018:",
        col.names = c("Fuente",
                      "Score")) %>% 
  kableExtra::kable_styling(full_width = F) %>% 
  kableExtra::row_spec(0,bold=TRUE, background = "#FF4900", color = "white") %>%
  kableExtra::row_spec(1:2,bold=TRUE, italic = TRUE, color = "#FF4900") %>%
  kableExtra::footnote(general = c("Score: Distancia absoluta promedio",
                      "Fuente: www.recetas-electorales.com"))
Evaluacion de pronosticos para la primera vuelta de 2018:
Fuente Score
Simple 14.2
Mixto 14.4
El Pais 16.2
18 Encuestas 16.5
Cifras y Conceptos 32.2
ANIF 49.2
Note:
Score: Distancia absoluta promedio
Fuente: www.recetas-electorales.com

:::

Cómo citar

BibTeX
@online{recetas_electorales2018,
  author = {{Recetas Electorales}},
  title = {☕ Café después de la 1era vuelta},
  date = {2018-05-28},
  url = {https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-28-cafe-2018/2018-cafe.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2018. “☕ Café después de la 1era vuelta.” May 28. https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-28-cafe-2018/2018-cafe.html.
]]> encuestas el país cifras & conceptos anif mixto simple pronósticos elecciones https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-28-cafe-2018/2018-cafe.html Sun, 27 May 2018 22:00:00 GMT 🥣 Sancocho, mezclando recetas Recetas Electorales https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-20-sancocho-2018/2018-sancocho.html

“Far better an approximate answer to the right question, which is often vague, than an exact answer to the wrong question, which can always be made precise”
–John Tukey

El Sancocho recoge todos los pronósticos disponibles para la primera vuelta del 27 de mayo 2018.

No cualquier lista o proporción de votos es un pronóstico. #LaPollaporlaPrimeraVuelta que se hace en Twitter tampoco vale. La tiranía metodológica no es capricho ni arbitrariedad: simplemente no tiene sentido atribuirle nada más que suerte a alguien que se gana la lotería por escoger un número entre billones posibles. De eso no se aprende nada.

Todo lo demás vale mientras resulte en un punto o intervalo por candidato. No importa la metodología que se utilice mientras haya un documento verificable que la describa, ese documento esté en línea y sea de acceso público. Los pronósticos se pueden basar en encuestas, elecciones pasadas, alianzas políticas, en el clima, clicks en una página o en cualquier otra cosa mientras cumplan con las tres características anteriores.

El sancocho


Este sancocho incluye todos los pronósticos que encontré. El primer ingrediente es una referencia: Encuestas, un promedio simple de la intención de voto, para cada candidato, entre todas las 18 encuestas que han salido desde las elecciones legislativas de marzo 11 de 2017. Los otros ingredientes son estimaciones puntuales, intervalos, o puntos e intervalos, dependiendo de lo que cada cocinero haya revelado.

Ver código
library(tidyverse)
library(lubridate)
library(here)

# 1. Base: promedio de las encuestas ####
encuestas_2018 <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Elecciones%202018/encuestas2018.csv")

# 1.2 Sancocho ####
encuestas_sancocho_2018 <- encuestas_2018 %>% 
  dplyr::filter(dplyr::between(lubridate::as_date(fecha),lubridate::as_date("2018-03-01"),lubridate::as_date("2018-05-19"))) %>% 
  dplyr::select(ivan_duque,gustavo_petro,sergio_fajardo,german_vargas_lleras,humberto_delacalle,fecha) %>% 
  tidyr::pivot_longer(cols = c("ivan_duque","gustavo_petro","sergio_fajardo","german_vargas_lleras","humberto_delacalle"),names_to = "candidato",values_to="int_voto") %>%
  dplyr::group_by(candidato) %>% 
  dplyr::summarize(int_voto=mean(int_voto)) %>%
  dplyr::mutate(fecha = "2018-05-19",
                int_voto=round(int_voto,digits = 0),
                candidato = dplyr::case_when(candidato=="ivan_duque" ~ "Ivan Duque",
                                      candidato=="gustavo_petro" ~ "Gustavo Petro",
                                      candidato=="sergio_fajardo" ~ "Sergio Fajardo",
                                      candidato=="german_vargas_lleras" ~ "German Vargas Lleras",
                                      candidato=="humberto_delacalle" ~ "Humberto de la Calle"),
                fuente = "18 Encuestas")


# 2. Cifras y Conceptos ####
cyc <- tibble::tribble(~fecha, ~candidato, ~int_voto_max,~int_voto_min,
               "2018-04-04","Ivan Duque",37.7,37.2,
               "2018-04-04","Gustavo Petro",17.4,15.7,
               "2018-04-04","Sergio Fajardo",13.3,12.8,
               "2018-04-04","German Vargas Lleras",21.0,18.2,
               "2018-04-04","Humberto de la Calle",6.3,5.9,
               "2018-04-18","Ivan Duque",36.4,35.6,
               "2018-04-18","Gustavo Petro",18.9,17,
               "2018-04-18","Sergio Fajardo",12.4,12.3,
               "2018-04-18","German Vargas Lleras",23.8,20.9,
               "2018-04-18","Humberto de la Calle",5.1,4.8,
               "2018-04-18","Ivan Duque",36.9,33.7,
               "2018-04-18","Gustavo Petro",21.6,20.8,
               "2018-04-18","Sergio Fajardo",14.2,11.3,
               "2018-04-18","German Vargas Lleras",24.1,20.8,
               "2018-04-18","Humberto de la Calle",5.1,3.3,
               "2018-05-16","Ivan Duque",36.9,32.9,
               "2018-05-16","Gustavo Petro",19.9,16.8,
               "2018-05-16","Sergio Fajardo",15.5,12.6,
               "2018-05-16","German Vargas Lleras",23.5,20.3,
               "2018-05-16","Humberto de la Calle",5,3.4,
               "2018-05-20","Ivan Duque",37.2,33.7,
               "2018-05-20","Gustavo Petro",20.8,18.1,
               "2018-05-20","Sergio Fajardo",17.3,14.6,
               "2018-05-20","German Vargas Lleras",21.7,19,
               "2018-05-20","Humberto de la Calle",4.7,3.5
               ) %>%
  dplyr::mutate(int_voto=(int_voto_max+int_voto_min)*0.5,
                fuente = "Cifras y Conceptos") 

# 3. El País ####
elpais <- tibble::tribble(~fecha,~candidato,~int_voto,
                  "2018-05-19","Sergio Fajardo",15.8,
                  "2018-05-19","Gustavo Petro",27,
                  "2018-05-19","Ivan Duque",37,
                  "2018-05-19","Humberto de la Calle",3,
                  "2018-05-19","German Vargas Lleras",10.5) %>%
  dplyr::mutate(fuente= "El Pais")
  
# 4. ANIF ####
anif <- tibble::tribble(~fecha,~candidato,~int_voto,
      "2018-05-07","Ivan Duque",(5/17)*100,
      "2018-05-07","German Vargas Lleras",(4.5/17)*100,
      "2018-05-07","Gustavo Petro",(3.2/17)*100,
      "2018-05-07","Sergio Fajardo",(2.3/17)*100,
      "2018-05-07","Humberto de la Calle",(1/17)*100) %>%
  dplyr::mutate(fuente= "ANIF")

# 5. Recetas propias ####
recetas_2018 <- readr::read_csv(here("elecciones","2018-colombia","2018-05-20-sancocho-2018","simple-2018","simple_2018_resultados.csv")) %>%
  dplyr::group_by(nombre) %>%
  dplyr::summarise(m_all = median(value),
                   p10 = quantile(value,0.1),
                   p90 = quantile(value,0.9)) %>%
  dplyr::mutate(fuente="Simple") %>%
  dplyr::select(fuente,candidato=nombre,int_voto=m_all,int_voto_min=p10,int_voto_max=p90) %>%
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","German Vargas Lleras","Sergio Fajardo","Gustavo Petro","Ivan Duque"))) %>%
  dplyr::bind_rows(
    readr::read_csv(here("elecciones","2018-colombia","2018-05-20-sancocho-2018","mixto-2018","mixto_2018_resultados.csv")) %>%
      dplyr::group_by(nombre) %>%
      dplyr::summarise(m_all = median(value),
                       p10 = quantile(value,0.1),
                       p90 = quantile(value,0.9)) %>%
      dplyr::mutate(fuente="Mixto") %>%
      dplyr::select(fuente,candidato=nombre,int_voto=m_all,int_voto_min=p10,int_voto_max=p90) %>%
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","German Vargas Lleras","Sergio Fajardo","Gustavo Petro","Ivan Duque")))
  ) %>%
  dplyr::mutate(fecha="2018-05-20")

# 6. Resultado 1era vuelta ####
resultado_1era_vuelta_2018 <- tibble::tribble(~fecha,~candidato,~int_voto,
      "2018-05-27","Ivan Duque",39.14,
      "2018-05-27","German Vargas Lleras",7.28,
      "2018-05-27","Gustavo Petro",25.08,
      "2018-05-27","Sergio Fajardo",23.73,
      "2018-05-27","Humberto de la Calle",2.06) %>%
  dplyr::mutate(fuente = "Resultado")

# 7. Preparar ####
sancocho_2018 <- dplyr::bind_rows(encuestas_sancocho_2018,
                                  recetas_2018,
                                  anif,
                                  elpais,
                                  resultado_1era_vuelta_2018,
                                  cyc %>%
                                    dplyr::filter(fecha==lubridate::as_date("2018-05-20"))) %>%
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","German Vargas Lleras","Sergio Fajardo","Gustavo Petro","Ivan Duque")))

sancocho_2018 %>%
  readr::write_csv(here("elecciones","2018-colombia","2018-05-20-sancocho-2018","sancocho_2018.csv"))
Ver código
library(tidyverse)

colors_sancocho <- c("green4","gold2","purple3", "darkturquoise","firebrick1","firebrick1")
shape_sancocho <- c(12,18,17,15,10,8)

# El sancocho
sancocho_2018 %>%
  dplyr::filter(fuente!="Resultado") %>%
  ggplot2::ggplot(ggplot2::aes(x=candidato,y=int_voto))+
  ggplot2::geom_point(ggplot2::aes(shape=fuente,color=fuente),size=4,position = position_dodge(0.5))+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=int_voto_max,ymin=int_voto_min,color=fuente),position = position_dodge(0.5),width=0.5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position = "right",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11),
        axis.text=ggplot2::element_text(size=11),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\n% votos pronosticados/estimados por candidato",
       title="Sancocho 2018",
       subtitle="Pronósticos  y promedios para la primera vuelta",
       caption="\nFuente: Cálculos @RecetaElectoral")+
  ggplot2::scale_color_manual(values=c("red4","red2","green4","gold2","orangered")) +
  ggplot2::scale_fill_manual(values=c("red4","red2","green4","gold2","orangered"))+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))+
  ggplot2::scale_shape_manual(values=shape_sancocho)+
  ggplot2::scale_color_manual(values=colors_sancocho) +
  ggplot2::scale_fill_manual(values=colors_sancocho) +
  ggplot2::coord_flip()

Sancocho de pronósticos electorales

Sancocho de pronósticos electorales

Estas son algunas generalidades del sancocho:

ImportanteConclusiones de los pronosticos electorales

  • Nadie gana las elecciones en primera vuelta. Ningún pronóstico le da más de 50% de la votación a un candidato. El primer resultado general es que habrá segunda vuelta.

  • Ivan Duque pasa a segunda vuelta. Ningún pronóstico sugiere que el candidato de la coalición de derecha no pasa a la segunda vuelta, y que pasa con la mayor votación.

  • A Duque lo acompaña Petro, según las encuestas, o Vargas Lleras, según las otras recetas. Hay dos tipos de recetas: las que se basan solo en encuestas y las otras. Todas las que se basan en encuestas dan el mismo resultado, en términos del órden de votación, a pesar de las enormes diferencias metodológicas y que algunas no especifican incertidumbre sobre la votación. Las que no se basan solo en las encuestas pronostican una carrera pareja entre Petro y Vargas Lleras por el segundo puesto para la segunda vuelta.

  • No hubo un solo modelo probabilístico para la primera vuelta. Lo más cercano fue la receta de ANIF, donde se presentan unas probabilidades de quién gana las elecciones. Sin embargo, lo que hizo ANIF no parece ser realmente un pronóstico probabilístico porque le da 0% de probabilidad a Fajardo y no presenta ningún intervalo de incertidumbre –ambas señales de que esa receta pretende ser una cosa que no es.

Recetas electorales 2018


Estos son los resultados de las últimas estimaciones de las recetas bayesianas Plato Simple y Plato Mixto. En cada caso, el resultado es un promedio de la distribución posterior de los parámetros, así como su HPDI de 90%. No alcancé a terminar la receta multinomial, así que quedaron solo estas dos.

Ver código
library(tidyverse)

recetas_2018 %>% 
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","German Vargas Lleras","Sergio Fajardo","Gustavo Petro","Ivan Duque"))) %>%
  ggplot2::ggplot(ggplot2::aes(x=candidato, group=candidato, color=candidato))+
  ggplot2::geom_errorbar(ggplot2::aes(ymax=int_voto_max, ymin=int_voto_min),width=0.5)+
  ggplot2::geom_point(ggplot2::aes(y=int_voto, shape=candidato), size=5)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50), linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        text = ggplot2::element_text(size=15),
        panel.background=ggplot2::element_rect(fill="white",color="white"))+
  ggplot2::labs(x="",y="\nPromedios e intervalos HPD de 90%", 
       title="Pronostico recetas electorales",
       subtitle="Modelos bayesianos basados en encuestas",
       caption="\nFuente: @RecetaElectoral")+
  ggplot2::scale_color_manual(values=c("red4","red2","green4","gold2","orangered")) +
  ggplot2::scale_fill_manual(values=c("red4","red2","green4","gold2","orangered"))+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))+   
  ggplot2::coord_flip()+
  ggplot2::facet_wrap(~fuente)

Pronósticos Platos Simple y Mixto

Pronósticos Platos Simple y Mixto

🥚 Los huevos de Cifras y Conceptos


El polémico pronóstico de Cifras y Conceptos es el ingrediente más creativo del sancocho. Trata de hacer algo que ningún otro intentó: modelar el sesgo, que parece comparten todas las encuestas, de subestimar la movilización de votos que pueden hacer las estructuras políticas. Ésta es la metodología que utilizan para generar los intervalos de pronóstico por candidato. A pesar de que publicaron la metodología tarde, y no se animaron a mostrar la cocina completa, este ingrediente es el que más me gusta.

Abajo va una reproducción de todas las actualizaciones de los intervalos que ha producido Cifras y Conceptos:

Ver código
library(tidyverse)
cyc %>% 
  dplyr::mutate(candidato=factor(candidato,levels=c("Ivan Duque","German Vargas Lleras","Gustavo Petro","Sergio Fajardo","Humberto de la Calle"))) %>%
  ggplot2::ggplot(ggplot2::aes(x=fecha, group=candidato, color=candidato))+
  ggplot2::geom_linerange(ggplot2::aes(ymax=int_voto_max, ymin=int_voto_min))+
  ggplot2::geom_line(ggplot2::aes(y=int_voto_max))+
  ggplot2::geom_line(ggplot2::aes(y=int_voto_min))+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50),linetype="dashed",color="grey60")+
  #Texto
  ggplot2::theme(legend.position="right",
        legend.title = ggplot2::element_blank(),
        legend.key=ggplot2::element_blank(),
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        panel.background=ggplot2::element_rect(fill="white",color="white"),text = ggplot2::element_text(size=15))+
ggplot2::scale_y_continuous(limits = c(0,40),breaks=c(10,20,30,40))+  ggplot2::labs(x="",y="Intervalos estimados",title="Pronóstico Cifras y Conceptos",subtitle="Modelo basado en encuestas y alianzas políticas",caption="Fuente: Cifras y Conceptos")+
  ggplot2::scale_color_manual(values=c("orangered","red2","gold2","green4","red4")) +
  ggplot2::scale_fill_manual(values=c("orangered","red2","gold2","green4","red4"))

Los huevos de Cifras y Conceptos

Los huevos de Cifras y Conceptos

🥓 El chicharrón de El País


Desde el periódico El País, @JorgeGalindo y @kikollan publicaron el 19 de mayo un cálculo con base en las encuestas y múltiples asteríscos metodológicos.

El cálculo hace muchos supuestos de ponderación pero no los muestra, y aunque describen lo que hacen, esa transparencia a medias no me gusta. De todas maneras ahí está.

Ver código
library(tidyverse)

elpais %>% 
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","German Vargas Lleras","Sergio Fajardo","Gustavo Petro","Ivan Duque"))) %>%   
  ggplot2::ggplot(ggplot2::aes(x=candidato,color=candidato))+
  ggplot2::geom_point(ggplot2::aes(y=int_voto,shape=candidato),size=4)+
  ggplot2::geom_text(ggplot2::aes(y=int_voto,label=round(int_voto,digits=0)),vjust=-1)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50),linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        panel.background=ggplot2::element_rect(fill="white",color="white"),text = ggplot2::element_text(size=15))+
  ggplot2::scale_y_continuous(limits = c(0,50),breaks=c(10,20,30,40,50))+ 
  ggplot2::labs(x="",y="% votos pronosticados",title="Pronostico El Pais",subtitle="Promedio de encuestas",caption="Fuente: El Pais")+
  ggplot2::scale_color_manual(values=c("red4","red2","green4","gold2","orangered")) +
  ggplot2::scale_fill_manual(values=c("red4","red2","green4","gold2","orangered"))+
  ggplot2::coord_flip()

El chicharrón de El País

El chicharrón de El País

🌭 La kielbasa de ANIF


ANIF publicó éste pronóstico el pasado 7 de mayo de 2018. Cumple con los criterios de inclusión en el sancocho. Pero lo único peor a saber cómo se prepara una salchicha es no saber.

En este sancocho solo se incluye lo que llaman método de contabilidad de votos porque lo demás es un buen ejemplo de rigor impostado: probabilidades sin intervalos y sin rastro de cómo se calculan. ANIF dice que Duque tiene “65% de probabilidad de ganar” pero no muestra exactamente cómo llegaron a esa conclusión (¿por qué 65% y no 56%, o 73%? Ni idea).

Ver código
library(tidyverse)

anif %>% 
  dplyr::mutate(candidato=factor(candidato,levels=c("Humberto de la Calle","Sergio Fajardo","Gustavo Petro","German Vargas Lleras","Ivan Duque"))) %>%
  ggplot2::ggplot(ggplot2::aes(x=candidato,color=candidato))+
  ggplot2::geom_point(ggplot2::aes(y=int_voto,shape=candidato),size=4)+
  ggplot2::geom_text(ggplot2::aes(y=int_voto,label=round(int_voto,digits=0)),vjust=-1)+
  ggplot2::geom_hline(yintercept=c(10,20,30,40,50),linetype="dashed",color="grey60")+
  ggplot2::theme(legend.position="none",
        axis.title.y = ggplot2::element_text(size=10),
        axis.title.x = ggplot2::element_text(size=10),
        panel.background=ggplot2::element_rect(fill="white",color="white"),text = ggplot2::element_text(size=15))+
  ggplot2::scale_y_continuous(limits = c(0,40),breaks=c(10,20,30,40))+  ggplot2::labs(x="",y="% votos pronosticados",title="Pronostico ANIF",subtitle="Modelo de contabilidad de votos",caption="Fuente: ANIF")+
  ggplot2::scale_color_manual(values=c("red4","green4","gold2","red2","orangered")) +
  ggplot2::scale_fill_manual(values=c("red4","green4","gold2","red2","orangered"))+
  ggplot2::coord_flip()

La kielbasa de ANIF

La kielbasa de ANIF

Cómo citar

BibTeX
@online{recetas_electorales2018,
  author = {{Recetas Electorales}},
  title = {🥣 Sancocho, mezclando recetas},
  date = {2018-05-20},
  url = {https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-20-sancocho-2018/2018-sancocho.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2018. “🥣 Sancocho, mezclando recetas.” May 20. https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-20-sancocho-2018/2018-sancocho.html.
]]> encuestas el país cifras & conceptos anif mixto simple encuestadoras https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-20-sancocho-2018/2018-sancocho.html Sat, 19 May 2018 22:00:00 GMT 🥗 El poder de la ensalada Recetas Electorales https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-05-ensalada/2018-ensalada.html

“This self-deceit, this fatal weakness of mankind, is the source of half the disorders of human life”
- Adam Smith

Esta ensalada es opcional pero es el plato más saludable.

¿Qué puede y qué no puede decir una encuesta? La respuesta depende de un concepto estadístico clave: poder estadístico1.

El poder permite distinguir una señal, un patrón real en los datos, del ruido. Una encuesta con bajo poder estadístico no puede identificar diferencias estadísticamente significativas entre la intención de voto de los candidatos que busca medir. Puede, incluso, revelar efectos o tendencias que realmente no están ahí. Dado que las encuestas tienden a interpretarse ligeramente, vale la pena averiguar qué puede decir creíblemente una encuesta de acuerdo a su diseño y el poder estadístico que tenga.

Para entender qué es esto del poder estadístico, comencemos por un episodio de hace unos años: la medición de intención del voto en el plebiscito para ratificar los Acuerdos de Paz en 2016.

Retrospeciva: ¿Por qué las encuestas se descacharon en el plebiscito de 2016?

En el plebiscito de 2016, votaron 13 millones de personas. El Si obtuvo 49.78% de los votos y el No 50.21%. La diferencia fue de 0.43%, unos 53 mil votos.

Las encuestas estuvieron muy lejos del resultado, y una parte de su desprestigio actual se debe a esa muy visible imprecisión.

Ver código
library(tidyverse)
library(plotly)
library(lubridate)

# Cargar las encuestas desde GitHub
plebiscito <- readr::read_csv("https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Plebiscito%202016/encuestas2016.csv") %>%
  dplyr::mutate(fecha=as.Date(fecha),
                e_max=si+as.numeric(margen_error),
                e_min=si-as.numeric(margen_error)) %>%
  dplyr::filter(encuestadora!="Resultado",n!=1) %>%
  ggplot2::ggplot(ggplot2::aes(x=fecha,y=si))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,color=encuestadora,
                 text = paste('Encuestadora: ', encuestadora,
                              '<br>Si (%):', si,
                              '<br>Muestra:',muestra)), 
             position = "jitter",
             #size=4,
             show.legend = FALSE)+
  ggplot2::geom_linerange(ggplot2::aes(ymin=e_min,ymax=e_max, color=encuestadora))+
  ggplot2::geom_hline(yintercept=49.78,linetype="dashed")+
  ggplot2::annotate("text", label="Si: 49.78%", x=as.Date("2016-09-25"), y=48, size=4) +
  ggplot2::theme_classic()+
  ggplot2::scale_color_brewer(palette="Set1")+
  ggplot2::scale_shape_manual(values=c(15,16,17,25))+
  ggplot2::theme(legend.position="none",
        panel.background=ggplot2::element_rect(fill="white"),
        legend.title=ggplot2::element_blank(),
        legend.text=ggplot2::element_text(size=11)) +
  ggplot2::labs(x="",y="% Votos 'Si'",
       title="El descache de las encuestas en el plebistico 2016",
       subtitle="13 encuestas antes del plebiscito 2016 entre 18/08/2016 y 27/09/2016 con sus márgenes de error", 
       caption="https://es.wikipedia.org/wiki/Plebiscito_sobre_los_acuerdos_de_paz_de_Colombia_de_2016")

#ggplotly ####
plotly::ggplotly(plebiscito, tooltip = "text")

El descache de las encuestas en el plebistico 2016

¿Qué pasó? Pues que las encuestas tenían muestras muy pequeñas que no eran capaces de detectar ese diminuto margen. ¿Qué tan grande hubieran tenido que ser las encuestas en la previa del plebiscito para detectar una diferencia de 0.43% en el resultado? Esta es una pregunta que se puede responder con cierta precisión utilizando análisis de poder estadístico.

Utilizando unos supuestos estándar, como un poder de detección de 80%, un nivel de significancia de 95% y bajo la hipótesis de que el Si iba a ganar (51%), el siguiente test permite responder la pregunta.

Ver código
library(pwr)
pwr.p.test(h=ES.h(0.5+0.0043, 0.51), sig.level=0.05, power=0.8, alternative = "less")

     proportion power calculation for binomial distribution (arcsine transformation) 

              h = -0.01140123
              n = 47562.53
      sig.level = 0.05
          power = 0.8
    alternative = less

Para detectar el resultado del plebiscito en 4 de cada 5 intentos, las encuestas debieron encuestar a cerca de 47 mil personas. Ningún intento con mil o mil y pico de encuestados hubiera podido detectar eso.

ImportanteConclusion

Las encuestas de intención de voto no están hechas para detectar diferencias pequeñas

¿Qué es poder estadístico?

El poder representa la probabilidad de que un test estadístico detecte un efecto cuando ese efecto realmente existe. Así, cuando un test tiene bajo poder, no es capaz de hacer lo que pretende. Cuando un test tiene bajo poder, puede confundir el ruido con la señal; si eso se hace con suficiente frecuencia, puede acabar con una disciplina completa, como pasó en psicología.

AdvertenciaOjo, el poder no es el márgen de error!

Para analizar el poder, aunque depende de la situación específica, se necesitan 4 ingredientes:

  • El tamaño de una muestra ()
  • El nivel de significancia, o probabilidad de falsos positivos ()
  • El poder, o probabilidad de un falso negativo ()
  • El tamaño del efecto (). Para un experimento aleatorio, por ejemplo, =(-)/.
  • La correlación intra-cluster (), el número de clusters y la distribución de la muestra en cada cluster. Este ingrediente no se incluye en este análisis.

¿Cómo se calcula el poder de una encuesta?

No es del todo claro cómo se calcula el poder de una encuesta cuando no se conoce exactamente su diseño muestral.

Este ejercicio ofrece una alternativa a no poder decir nada sobre el poder de las encuestas. Ya que algunas fichas técnicas de las encuestas reportan márgenes de error para cierto tipo de pruebas (e.g. “el margen de error para una confianza del Y% es X% para proporciones mayores a Z%”), se utilizan esos márgenes para calcular el poder post hoc de cada encuesta utilizando la muestra efectiva, el tipo de prueba (i.e. diferencias entre proporciones), el nivel de significancia (casi siempre 95%) y se deja como variable el tamaño del efecto.

Los cálculos de poder a continuación se realizan para proporciones (). Todos son test de una sola cola (i.e. mayor a ) de la siguiente forma:



, donde es la proporción especificada en la ficha técnica de la encuesta y el tamaño del efecto a estimar.

Se utiliza pwr.p.test del paquete pwr, que se define así: h (H1, H0), n (muestra), sig.level (alpha), y la opción de una sola cola (alternative = “greater”).

Limitaciones del análisis

  1. No se incluyen clusters, así que la correlación intra-cluster se asume cero. Eso infla el poder para todas las encuestas, pero desafortunadamente no es posible reconstruir la varianza dentro de la estratificación de las muestras que hacen las encuestas.

  2. Para las encuestas que no mencionan el tipo de prueba se asume una prueba de diferencia de proporciones mayor a 50%.

Preparación para la estimación de poder

Para agilizar los cálculos, se definen algunos parámetros por grupos de encuestas según lo que diga la ficha técnica:

Ver código
library(tidyverse)

#1. Diferencias de proporciones en fichas técnicas
#1.1 Diferencias de proporciones 0.5 para encuestas #: 3-4, 6-9, 16, 29, 33 y Default: 1,10,12,14,18,21,22,24,25,28,31,32,35,37,39,40
cons.1 <- 0.5       
gr1 <- c(1,3,4,6,7,8,9,10,12,14,16,18,21,22,24,25,26,28,29,31,32,33,35,37,39,40)

#1.2 Diferencias de proporciones 0.2 para encuestas #: 2,5,13,17,19,23,34
cons.2 <- 0.2   
gr2 <- c(2,5,13,17,19,23,34)
  
#1.3 Diferencias de proporciones 0.25 para encuestas #11
cons.3 <- 0.25
gr3 <- 11

#1.4 Diferencias de proporciones 0.14 para encuestas # 15 y 20
cons.4 <- 0.14
gr4 <- c(15,20)
  
#1.5 Diferencias de proporciones 0.24 para encuestas # 27
cons.5 <- 0.24
gr5 <- 27
  
#1.6 Diferencias de proporciones 0.35 para encuestas # 30 y 36
cons.6 <- 0.35
gr6 <- c(30,36)

#1.7 Diferencias de proporciones 0.28 para encuestas #38
cons.7 <- 0.28     #Encuestas: 38
gr7 <- 38
  
#2. Tamaños de los efectos
eff.1 <- 0.01   #Efecto a detectar: Diferencia de 1%
eff.2 <- 0.03   #Efecto a detectar: Diferencia de 3%
eff.3 <- 0.05   #Efecto a detectar: Diferencia de 5%
a = 0.05        #Nivel de confianza 95%

#3. Nivel de significancia
a = 0.05         #Nivel de confianza 95%

Poder 1-3-5%: Efectos diminutos, pequeños y medianos

¿Es la muestra de las encuestas suficiente para detectar una diferencia de 1% entre candidatos?

Utilizando el paquete pwr de R y, el más ineficiente código imaginable, el poder de cada encuesta para detectar una diferencia de 1%, 3% y 5% entre la votación de los candidatos.

Ver código
library(pwr)
library(tidyverse)

encuestas_ulr_2018 <- "https://raw.githubusercontent.com/nelsonamayad/Elecciones-presidenciales-2018/master/Elecciones%202018/encuestas2018.csv"
encuestas_2018 <- readr::read_csv(encuestas_ulr_2018)

#1. Grupo 1, Efecto 1  ####
pow.1 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[1])
pow.3 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[3])
pow.4 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[4])
pow.6 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[6])
pow.7 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[7])
pow.8 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[8])
pow.9 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[9])
pow.10 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[10])
pow.12 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[12])
pow.14 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[14])
pow.16 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[16])
pow.18 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[18])
pow.21 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[21])
pow.22 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[22])
pow.24 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[24])
pow.25 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[25])
pow.26 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[26])
pow.28 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[28])
pow.29 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[29])
pow.31 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[31])
pow.32 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[32])
pow.33 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[33])
pow.35 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[35])
pow.37 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[37])
pow.39 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[39])
pow.40 <- pwr.p.test(h = ES.h(eff.1+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[40])

#2. Grupo 2, Efecto 1 ####
pow.2 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[2])
pow.5 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[5])
pow.13 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[13])
pow.17 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[17])
pow.19 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[19])
pow.23 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[23])
pow.34 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[34])

#3. Grupo 3, Efecto 1 ####
pow.11 <- pwr.p.test(h = ES.h(eff.1+cons.3, cons.3), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[11])

#4. Grupo 4, Efecto 1 ####
pow.15 <- pwr.p.test(h = ES.h(eff.1+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[15])
pow.20 <- pwr.p.test(h = ES.h(eff.1+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[20])

#5. Grupo 5, Efecto 1 ####
pow.27 <- pwr.p.test(h = ES.h(eff.1+cons.5, cons.5), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[27])

#6. Grupo 6, Efecto 1 ####
pow.30 <- pwr.p.test(h = ES.h(eff.1+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[30])
pow.36 <- pwr.p.test(h = ES.h(eff.1+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[36])

#7. Grupo 7, Efecto 1 ####
pow.38 <- pwr.p.test(h = ES.h(eff.1+cons.7, cons.7), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[38])

# Tribble con los resultados: ####
d.eff.1 <- tibble::tribble(~n, ~power1, 
                   1, pow.1[[4]],
                   2, pow.2[[4]],
                   3, pow.3[[4]],
                   4, pow.4[[4]],
                   5, pow.5[[4]],
                   6, pow.6[[4]],
                   7, pow.7[[4]],
                   8, pow.8[[4]],
                   9, pow.9[[4]],
                   10, pow.10[[4]],
                   11, pow.11[[4]],
                   12, pow.12[[4]],
                   13, pow.13[[4]],
                   14, pow.14[[4]],
                   15, pow.15[[4]],
                   16, pow.16[[4]],
                   17, pow.17[[4]],
                   18, pow.18[[4]],
                   19, pow.19[[4]],
                   20, pow.20[[4]],
                   21, pow.21[[4]],
                   22, pow.22[[4]],
                   23, pow.23[[4]],
                   24, pow.24[[4]],
                   25, pow.25[[4]],
                   26, pow.26[[4]],
                   27, pow.27[[4]],
                   28, pow.28[[4]],
                   29, pow.29[[4]],
                   30, pow.30[[4]],
                   31, pow.31[[4]],
                   32, pow.32[[4]],
                   33, pow.33[[4]],
                   34, pow.34[[4]],
                   35, pow.35[[4]],
                   36, pow.36[[4]],
                   37, pow.37[[4]],
                   38, pow.38[[4]],
                   39, pow.39[[4]],
                   40, pow.40[[4]]
                   )
Ver código
library(pwr)
library(tidyverse)

#1. Grupo 1, Efecto 2  ####
pow.1 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[1])
pow.3 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[3])
pow.4 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[4])
pow.6 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[6])
pow.7 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[7])
pow.8 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[8])
pow.9 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[9])
pow.10 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[10])
pow.12 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[12])
pow.14 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[14])
pow.16 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[16])
pow.18 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[18])
pow.21 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[21])
pow.22 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[22])
pow.24 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[24])
pow.25 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[25])
pow.26 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[26])
pow.28 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[28])
pow.29 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[29])
pow.31 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[31])
pow.32 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[32])
pow.33 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[33])
pow.35 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[35])
pow.37 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[37])
pow.39 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[39])
pow.40 <- pwr.p.test(h = ES.h(eff.2+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[40])


#2. Grupo 2, Efecto 2 ####
pow.2 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[2])
pow.5 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[5])
pow.13 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[13])
pow.17 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[17])
pow.19 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[19])
pow.23 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[23])
pow.34 <- pwr.p.test(h = ES.h(eff.2+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[34])

#3. Grupo 3, Efecto 2 ####
pow.11 <- pwr.p.test(h = ES.h(eff.2+cons.3, cons.3), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[11])

#4. Grupo 4, Efecto 2 ####
pow.15 <- pwr.p.test(h = ES.h(eff.2+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[15])
pow.20 <- pwr.p.test(h = ES.h(eff.2+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[20])

#5. Grupo 5, Efecto 2 ####
pow.27 <- pwr.p.test(h = ES.h(eff.2+cons.5, cons.5), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[27])

#6. Grupo 6, Efecto 2 ####
pow.30 <- pwr.p.test(h = ES.h(eff.2+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[30])
pow.36 <- pwr.p.test(h = ES.h(eff.2+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[36])

#7. Grupo 7, Efecto 3 ####
pow.38 <- pwr.p.test(h = ES.h(eff.2+cons.7, cons.7), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[38])

# Tribble con los resultados: ####
d.eff.2 <- tibble::tribble(~n, ~power2, 
                   1, pow.1[[4]],
                   2, pow.2[[4]],
                   3, pow.3[[4]],
                   4, pow.4[[4]],
                   5, pow.5[[4]],
                   6, pow.6[[4]],
                   7, pow.7[[4]],
                   8, pow.8[[4]],
                   9, pow.9[[4]],
                   10, pow.10[[4]],
                   11, pow.11[[4]],
                   12, pow.12[[4]],
                   13, pow.13[[4]],
                   14, pow.14[[4]],
                   15, pow.15[[4]],
                   16, pow.16[[4]],
                   17, pow.17[[4]],
                   18, pow.18[[4]],
                   19, pow.19[[4]],
                   20, pow.20[[4]],
                   21, pow.21[[4]],
                   22, pow.22[[4]],
                   23, pow.23[[4]],
                   24, pow.24[[4]],
                   25, pow.25[[4]],
                   26, pow.26[[4]],
                   27, pow.27[[4]],
                   28, pow.28[[4]],
                   29, pow.29[[4]],
                   30, pow.30[[4]],
                   31, pow.31[[4]],
                   32, pow.32[[4]],
                   33, pow.33[[4]],
                   34, pow.34[[4]],
                   35, pow.35[[4]],
                   36, pow.36[[4]],
                   37, pow.37[[4]],
                   38, pow.38[[4]],
                   39, pow.39[[4]],
                   40, pow.40[[4]]
                   )
Ver código
library(pwr)
library(tidyverse)

#1. Grupo 1, Efecto 3  ####
pow.1 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[1])
pow.3 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[3])
pow.4 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[4])
pow.6 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[6])
pow.7 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[7])
pow.8 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[8])
pow.9 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[9])
pow.10 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[10])
pow.12 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[12])
pow.14 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[14])
pow.16 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[16])
pow.18 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[18])
pow.21 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[21])
pow.22 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[22])
pow.24 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[24])
pow.25 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[25])
pow.26 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[26])
pow.28 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[28])
pow.29 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[29])
pow.31 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[31])
pow.32 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[32])
pow.33 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[33])
pow.35 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[35])
pow.37 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[37])
pow.39 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[39])
pow.40 <- pwr.p.test(h = ES.h(eff.3+cons.1, cons.1), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[40])

#2. Grupo 2, Efecto 3 ####
pow.2 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[2])
pow.5 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[5])
pow.13 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[13])
pow.17 <- pwr.p.test(h = ES.h(eff.1+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[17])
pow.19 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[19])
pow.23 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[23])
pow.34 <- pwr.p.test(h = ES.h(eff.3+cons.2, cons.2), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[34])

#3. Grupo 3, Efecto 3 ####
pow.11 <- pwr.p.test(h = ES.h(eff.3+cons.3, cons.3), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[11])

#4. Grupo 4, Efecto 3 ####
pow.15 <- pwr.p.test(h = ES.h(eff.3+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[15])
pow.20 <- pwr.p.test(h = ES.h(eff.3+cons.4, cons.4), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[20])

#5. Grupo 5, Efecto 3 ####
pow.27 <- pwr.p.test(h = ES.h(eff.3+cons.5, cons.5), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[27])

#6. Grupo 6, Efecto 3 ####
pow.30 <- pwr.p.test(h = ES.h(eff.3+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[30])
pow.36 <- pwr.p.test(h = ES.h(eff.3+cons.6, cons.6), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[36])

#7. Grupo 7, Efecto 3 ####
pow.38 <- pwr.p.test(h = ES.h(eff.3+cons.7, cons.7), sig.level = a, alternative = "greater", n = encuestas_2018$muestra_int_voto[38])

# Tribble con los resultados: ####
d.eff.3 <- tibble::tribble(~n, ~power3, 
                   1, pow.1[[4]],
                   2, pow.2[[4]],
                   3, pow.3[[4]],
                   4, pow.4[[4]],
                   5, pow.5[[4]],
                   6, pow.6[[4]],
                   7, pow.7[[4]],
                   8, pow.8[[4]],
                   9, pow.9[[4]],
                   10, pow.10[[4]],
                   11, pow.11[[4]],
                   12, pow.12[[4]],
                   13, pow.13[[4]],
                   14, pow.14[[4]],
                   15, pow.15[[4]],
                   16, pow.16[[4]],
                   17, pow.17[[4]],
                   18, pow.18[[4]],
                   19, pow.19[[4]],
                   20, pow.20[[4]],
                   21, pow.21[[4]],
                   22, pow.22[[4]],
                   23, pow.23[[4]],
                   24, pow.24[[4]],
                   25, pow.25[[4]],
                   26, pow.26[[4]],
                   27, pow.27[[4]],
                   28, pow.28[[4]],
                   29, pow.29[[4]],
                   30, pow.30[[4]],
                   31, pow.31[[4]],
                   32, pow.32[[4]],
                   33, pow.33[[4]],
                   34, pow.34[[4]],
                   35, pow.35[[4]],
                   36, pow.36[[4]],
                   37, pow.37[[4]],
                   38, pow.38[[4]],
                   39, pow.39[[4]],
                   40, pow.40[[4]]
                   )

El poder estadístico de las encuestas

El estándar de poder (arbitrario, como todo lo frecuentista) para un test es 80%. Eso quiere decir que para detectar un efecto que existe, dado un tamaño de la muestra específico y con 95% de nivel de significancia, será posible identificar ese efecto el 4 de cada 5 veces (80%).

Este es el poder estadístico estimado para cada encuesta en cada uno de los 3 diferentes tamaños de efectos: diminutos (1%), pequeños (3%) y medianos (5%):

Ver código
library(tidyverse)
library(RColorBrewer)
library(plotly)

#1. Pegar calculos de poder a los datos de las encuestas
poder <- dplyr::bind_cols(d.eff.1,d.eff.2[2],d.eff.3[2]) %>%
  dplyr::left_join(encuestas_2018 %>%
                     dplyr::select(n, fecha, encuestadora, muestra_int_voto), by = "n") %>%
  tidyr::pivot_longer(cols = c("power1", "power2", "power3"), names_to = "power_level", values_to = "power") %>%
  dplyr::filter(n>15) %>%
  ggplot2::ggplot(ggplot2::aes(x=power,y=muestra_int_voto,group=encuestadora))+
  ggplot2::geom_point(ggplot2::aes(shape=encuestadora,color=power_level,
                 text = paste('Encuestadora: ', encuestadora,
                              '<br>Power (beta):', round(power, digits=2),
                              '<br>Muestra:',muestra_int_voto)), 
             position = "jitter",
             size=3,
             show.legend = FALSE)+
  #Corte arbitrario 80%
  ggplot2::geom_vline(xintercept=0.8, linetype="dashed") +   
  ggplot2::theme_classic()+
  ggplot2::theme(legend.position="none", 
        legend.title=ggplot2::element_blank(),
        #text = ggplot2::element_text(family = "NewsCycle-Regular"),
        panel.background=ggplot2::element_rect(fill="white",color="grey70")) +
  ggplot2::scale_y_continuous(limits=c(0,4000)) +
  ggplot2::scale_x_continuous(limits=c(0,1),breaks=c(0,0.2,0.4,0.6,0.8,1)) +
  ggplot2::annotate("rect",xmin=0.01,xmax=0.2,ymin=2500,ymax=4000,alpha = .1)+
  ggplot2::annotate("text",x=0.1,y=3800,label="Diferencia de 1%",color="red4", size=3)+
  ggplot2::annotate("text",x=0.1,y=3300,label="Diferencia de 3%",color="navy", size=3)+
  ggplot2::annotate("text",x=0.1,y=2800,label="Diferencia de 5%",color="green4", size=3)+
  ggplot2::labs(y="Muestra de la encuesta*", 
       x="Poder (beta)", 
       title="3 poderes de las encuestas",
       subtitle="Poder post hoc de las encuestas (N = 25) para detectar diferencias de 1%, 3% y 5%",
       caption="*Muestra que reporta la intención de voto, no necesariamente la muestra total \nFuente: Cálculos @nelsonamayad usando pwr.p.test en R.") +
  ggplot2::scale_shape_manual(values=c(4,16,17,3,15,25,8))+
  ggplot2::scale_color_brewer(palette = "Set1")


#ggplotly ####
plotly::ggplotly(poder, tooltip = "text")

Poderes de las encuestas

NotaConclusion

Las encuestas son muy pequeñas para detectar efectos pequeños en una carrera apretada. Pero son lo suficientemente grandes para detectar diferencias de más de 5% entre los candidatos.

Referencias


Ellis, P. D. (2010). The essential guide to effect sizes: Statistical power, meta-analysis, and the interpretation of research results. Cambridge University Press.

Gerber, A. S., & Green, D. P. (2012). Field experiments: Design, analysis, and interpretation. WW Norton. p. 93

EGAP, “10 Things to Know About Statistical Power”

Open Science Collaboration. (2015). Estimating the reproducibility of psychological science. Science, 349(6251), aac4716.

GPower 3.1 manual

Sullivan, L. Power and sample size determination

Notas

  1. También se conoce como potencia estadística]↩︎

Cómo citar

BibTeX
@online{recetas_electorales2018,
  author = {{Recetas Electorales}},
  title = {🥗 El poder de la ensalada},
  date = {2018-05-18},
  url = {https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-05-ensalada/2018-ensalada.html},
  langid = {es}
}
Por favor, cita este trabajo como:
Recetas Electorales. 2018. “🥗 El poder de la ensalada.” May 18. https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-05-ensalada/2018-ensalada.html.
]]> encuestas poder muestra pwr encuestadoras https://www.recetas-electorales.com/elecciones/2018-colombia/2018-05-05-ensalada/2018-ensalada.html Thu, 17 May 2018 22:00:00 GMT