---
title: "Contratos públicos y bloques políticos"
subtitle: "Exploración, patrones de contratación y clasificación supervisada"
author:
- "María José Gómez González"
- "Paula Reinah Aponte"
- "Karen Cervantes Fernandez"
- "Luis Ramón Mercado Toledo"
date: today
date-format: "D [de] MMMM [de] YYYY"
lang: es
format:
html:
theme: cosmo
embed-resources: true
toc: true
toc-depth: 3
toc-title: "Contenido"
number-sections: true
code-fold: true
code-summary: "Ver código"
code-tools: true
fig-width: 10
fig-height: 6
execute:
echo: false
warning: false
message: false
---
```{r setup}
# Configuración general del reporte.
project_root <- if (file.exists("datos/contratos.csv")) normalizePath(".") else normalizePath("..")
knitr::opts_knit$set(root.dir = project_root)
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.align = "center", dpi = 300)
library(tidyverse)
library(janitor)
library(lubridate)
library(scales)
library(plotly)
library(DT)
library(gt)
library(glue)
paleta_partidos <- c(
"PAN" = "#1F77B4",
"PRI" = "#C0392B",
"PRD" = "#F2C94C",
"Morena" = "#8C1D40",
"MC" = "#F28E2B",
"PVEM" = "#2CA25F",
"PT" = "#D62728"
)
paleta_bloques <- c(
"oficialista" = "#8C1D40",
"oposición tradicional" = "#1F77B4",
"fuerzas locales" = "#2CA25F",
"otro" = "#7A7A7A"
)
color_secundario <- "#34495E"
color_acento <- "#8C1D40"
color_dorado <- "#F2A541"
color_matriz <- c("#F7FBFF", "#DDEAF6", "#9ECAE1", "#3182BD", "#08519C")
plotly_base <- function(p, margen_izq = 95) {
p |>
layout(
font = list(family = "Arial, sans-serif", color = "#17202A"),
paper_bgcolor = "white",
plot_bgcolor = "white",
margin = list(l = margen_izq, r = 35, t = 75, b = 75),
legend = list(orientation = "h", x = 0, y = -0.18)
) |>
config(displayModeBar = TRUE, displaylogo = FALSE, responsive = TRUE)
}
tabla_interactiva <- function(data, caption = NULL, page_length = 8) {
datatable(
data,
caption = caption,
rownames = FALSE,
filter = "top",
options = list(pageLength = page_length, autoWidth = TRUE, scrollX = TRUE)
)
}
fmt_mxn <- function(x) dollar(x, accuracy = 1, prefix = "$", big.mark = ",")
```
```{css}
.hero {
border-left: 6px solid #8C1D40;
padding: 1rem 1.25rem;
background: #F8FAFC;
margin: 1rem 0 1.5rem;
}
.hero strong {
color: #8C1D40;
}
.metric-grid {
display: grid;
grid-template-columns: repeat(auto-fit, minmax(170px, 1fr));
gap: 0.8rem;
margin: 1rem 0 1.25rem;
}
.metric-card {
border: 1px solid #E5E7EB;
border-top: 4px solid #8C1D40;
padding: 0.9rem 1rem;
background: white;
border-radius: 6px;
}
.metric-card .value {
font-size: 1.35rem;
font-weight: 700;
color: #17202A;
line-height: 1.2;
}
.metric-card .label {
color: #5D6D7E;
font-size: 0.88rem;
margin-top: 0.25rem;
}
.insight {
border-left: 4px solid #2CA25F;
background: #F6FBF8;
padding: 0.85rem 1rem;
margin: 1rem 0;
}
```
```{r datos-y-artefactos}
# Carga de datos y resultados del pipeline reproducible.
contratos <- read_csv("datos/contratos.csv", show_col_types = FALSE) |> clean_names()
montos <- read_csv("datos/contratos_montos.csv", show_col_types = FALSE) |>
clean_names() |>
select(-any_of("x1")) |>
mutate(
across(starts_with("fecha"), ymd),
costo = as.numeric(costo),
ano = as.integer(ano),
partido = factor(partido, levels = names(paleta_partidos)),
bloque_politico = case_when(
partido == "Morena" ~ "oficialista",
partido %in% c("PAN", "PRI", "PRD") ~ "oposición tradicional",
partido %in% c("MC", "PT", "PVEM") ~ "fuerzas locales",
TRUE ~ "otro"
),
bloque_politico = factor(bloque_politico, levels = names(paleta_bloques))
)
if (!file.exists("resultados/modelo_bloques_final.rds")) {
source("scripts/02_modelo_partidos.R")
}
resumen_datasets <- read_csv("resultados/resumen_datasets.csv", show_col_types = FALSE)
distribucion_bloques <- read_csv("resultados/distribucion_bloques.csv", show_col_types = FALSE)
ranking_modelos <- read_csv("resultados/ranking_modelos.csv", show_col_types = FALSE)
metricas_modelos <- read_csv("resultados/metricas_modelos.csv", show_col_types = FALSE)
metricas_test <- read_csv("resultados/metricas_test.csv", show_col_types = FALSE)
matriz_confusion <- read_csv("resultados/matriz_confusion.csv", show_col_types = FALSE)
importancia_variables <- read_csv("resultados/importancia_variables.csv", show_col_types = FALSE)
patrones_bloque <- read_csv("resultados/patrones_bloque.csv", show_col_types = FALSE)
top_proveedores <- read_csv("resultados/top_proveedores_bloque.csv", show_col_types = FALSE)
variables_modelado <- read_csv("resultados/variables_modelado.csv", show_col_types = FALSE)
modelo_final <- readRDS("resultados/modelo_bloques_final.rds")
mejor_modelo <- modelo_final$mejor_modelo
auc_test <- metricas_test |> filter(.metric == "roc_auc") |> pull(.estimate)
accuracy_test <- metricas_test |> filter(.metric == "accuracy") |> pull(.estimate)
kap_test <- metricas_test |> filter(.metric == "kap") |> pull(.estimate)
```
::: hero
**Respuesta central.** Los patrones de gasto, proveedor y temporalidad sí permiten distinguir bloques políticos en los contratos analizados. El mejor modelo fue **`r mejor_modelo`**, con ROC-AUC multiclase de **`r round(auc_test, 3)`**, accuracy de **`r round(accuracy_test, 3)`** y kappa de **`r round(kap_test, 3)`** en prueba. La lectura sustantiva no es que el modelo “pruebe corrupción”, sino que ayuda a priorizar señales de riesgo: concentración de proveedores, diferencias en tipos de contrato y estacionalidad del gasto.
:::
::: {.callout-note title="Declaración de uso de inteligencia artificial"}
Este reporte y su código fueron elaborados con apoyo de herramientas de inteligencia artificial generativa para estructurar el pipeline, documentar bloques de código, revisar consistencia metodológica y mejorar la redacción técnica. Las decisiones analíticas, la selección de variables, la interpretación sustantiva y la validación de resultados fueron realizadas por las personas autoras del proyecto y deben revisarse críticamente por la persona autora del proyecto. No se usaron datos externos a los dos CSV proporcionados.
:::
# Resumen ejecutivo
```{r metricas-superiores, results='asis'}
periodo <- paste(min(montos$ano, na.rm = TRUE), max(montos$ano, na.rm = TRUE), sep = "–")
monto_total <- sum(montos$costo, na.rm = TRUE)
mediana_monto <- median(montos$costo[montos$costo > 0], na.rm = TRUE)
cards <- tibble(
value = c(
comma(nrow(contratos)),
comma(nrow(montos)),
fmt_mxn(monto_total),
periodo,
round(auc_test, 3),
mejor_modelo
),
label = c(
"filas en contratos.csv",
"filas modelables en contratos_montos.csv",
"monto total observado",
"periodo cubierto",
"ROC-AUC en prueba",
"modelo ganador"
)
)
cat('<div class="metric-grid">')
for (i in seq_len(nrow(cards))) {
cat(glue('<div class="metric-card"><div class="value">{cards$value[i]}</div><div class="label">{cards$label[i]}</div></div>'))
}
cat('</div>')
```
El análisis usa `contratos_montos.csv` como base de modelado porque contiene la variable `partido` estandarizada. Esa variable solo se usa para crear el bloque político y después se excluye de los predictores para evitar fuga de información. También se excluyen explícitamente `tema` y `area`.
La clasificación final se define así:
- **Oficialista:** Morena.
- **Oposición tradicional:** PAN, PRI y PRD.
- **Fuerzas locales:** MC, PT y PVEM.
```{r tabla-datasets}
resumen_datasets |>
mutate(tiene_partido_estandarizado = if_else(tiene_partido_estandarizado, "Sí", "No")) |>
rename(
Dataset = dataset,
Filas = filas,
Columnas = columnas,
`Partido estandarizado` = tiene_partido_estandarizado
) |>
tabla_interactiva("Comparación de los dos datasets disponibles", page_length = 5)
```
# Exploración general de los datos
El universo completo tiene `r comma(nrow(contratos))` registros. Para modelado se usa el subconjunto con partido estandarizado: `r comma(nrow(montos))` registros. La pérdida de filas es metodológicamente aceptable porque permite entrenar una variable objetivo consistente.
```{r comparacion-anual}
bind_rows(
contratos |> transmute(dataset = "contratos.csv", ano),
montos |> transmute(dataset = "contratos_montos.csv", ano)
) |>
filter(!is.na(ano)) |>
count(dataset, ano) |>
mutate(etiqueta = paste0(dataset, "<br>Año: ", ano, "<br>Contratos: ", comma(n))) |>
plot_ly(
x = ~ano,
y = ~n,
type = "bar",
color = ~dataset,
colors = c("contratos.csv" = color_secundario, "contratos_montos.csv" = "#2CA25F"),
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Contratos por año en ambos datasets",
barmode = "group",
xaxis = list(title = "Año", dtick = 1),
yaxis = list(title = "Número de contratos", separatethousands = TRUE)
) |>
plotly_base()
```
```{r estructura-columnas}
tibble(
columna = names(montos),
tipo = map_chr(montos, \(x) class(x)[1]),
n_unicos = map_int(montos, \(x) n_distinct(x, na.rm = TRUE)),
n_na = map_int(montos, \(x) sum(is.na(x))),
pct_na = n_na / nrow(montos)
) |>
arrange(desc(pct_na), desc(n_unicos)) |>
mutate(pct_na = percent(pct_na, accuracy = 0.1)) |>
tabla_interactiva("Estructura, cardinalidad y faltantes en contratos_montos.csv", page_length = 10)
```
::: insight
**Lectura:** `contratos_montos.csv` conserva suficientes observaciones para modelar y tiene una ventaja clave sobre el dataset completo: la etiqueta de partido ya está estandarizada. Por eso fluye mejor para una clasificación supervisada reproducible.
:::
# Patrones de contratación
## Partidos y bloques
La distribución por partido está concentrada en PVEM y MC, mientras que Morena representa el bloque oficialista bajo la definición solicitada. Como existe desbalance, el pipeline de modelado usa validación estratificada y SMOTE durante el preprocesamiento.
```{r partidos}
montos |>
filter(!is.na(partido)) |>
count(partido, sort = TRUE) |>
mutate(
partido = fct_reorder(partido, n),
etiqueta = paste0(partido, "<br>Contratos: ", comma(n))
) |>
plot_ly(
x = ~n,
y = ~partido,
type = "bar",
orientation = "h",
color = ~partido,
colors = paleta_partidos,
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Contratos por partido político",
xaxis = list(title = "Contratos", separatethousands = TRUE),
yaxis = list(title = "")
) |>
plotly_base()
```
```{r bloques}
distribucion_bloques |>
mutate(
bloque_politico = fct_reorder(bloque_politico, n),
etiqueta = paste0(bloque_politico, "<br>", comma(n), " contratos<br>", percent(pct, accuracy = 0.1))
) |>
plot_ly(
x = ~n,
y = ~bloque_politico,
type = "bar",
orientation = "h",
color = ~bloque_politico,
colors = paleta_bloques,
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Distribución de contratos por bloque político",
xaxis = list(title = "Contratos", separatethousands = TRUE),
yaxis = list(title = "")
) |>
plotly_base()
```
```{r clases-raras, results='asis'}
bloques_menos_50 <- distribucion_bloques |> filter(n < 50)
if (nrow(bloques_menos_50) == 0) {
cat("::: {.callout-tip}\nNingún bloque político tiene menos de 50 observaciones; por eso no fue necesario fusionar clases en una categoría `Otro`.\n:::\n")
} else {
cat("::: {.callout-warning}\nAlgunos bloques tienen menos de 50 observaciones. Se recomienda fusionarlos en `Otro` para evitar una clase sin soporte estadístico suficiente.\n:::\n")
}
```
## Montos y tipos de contrato
Los montos son altamente asimétricos: la mayoría de contratos son pequeños o medianos, pero unos pocos contratos grandes elevan el promedio. Por esa razón, las lecturas sustantivas combinan monto total, promedio y mediana.
```{r distribucion-costo}
montos |>
filter(costo > 0) |>
mutate(log_costo = log10(costo)) |>
plot_ly(
x = ~log_costo,
type = "histogram",
nbinsx = 60,
marker = list(color = color_acento, line = list(color = "white", width = 0.4)),
hovertemplate = "Log10(monto): %{x:.2f}<br>Contratos: %{y:,}<extra></extra>"
) |>
layout(
title = "Distribución del monto de contratos",
xaxis = list(
title = "Monto MXN, escala log10",
tickvals = 3:9,
ticktext = c("$1K", "$10K", "$100K", "$1M", "$10M", "$100M", "$1B")
),
yaxis = list(title = "Frecuencia", separatethousands = TRUE)
) |>
plotly_base()
```
```{r monto-bloque}
patrones_bloque |>
select(bloque_politico, monto_promedio, monto_mediano) |>
pivot_longer(-bloque_politico, names_to = "metrica", values_to = "monto") |>
mutate(
metrica = recode(metrica, monto_promedio = "Promedio", monto_mediano = "Mediana"),
bloque_politico = fct_reorder(bloque_politico, monto, .fun = max),
etiqueta = paste0(bloque_politico, "<br>", metrica, ": ", fmt_mxn(monto))
) |>
plot_ly(
x = ~bloque_politico,
y = ~monto,
type = "bar",
color = ~metrica,
colors = c("Promedio" = color_dorado, "Mediana" = color_secundario),
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Monto promedio y mediano por bloque político",
barmode = "group",
xaxis = list(title = ""),
yaxis = list(title = "Monto MXN, escala log", type = "log")
) |>
plotly_base()
```
```{r tipo-contrato}
montos |>
filter(!is.na(tipo_contrato), !is.na(bloque_politico)) |>
count(bloque_politico, tipo_contrato) |>
group_by(bloque_politico) |>
mutate(pct = n / sum(n)) |>
ungroup() |>
mutate(etiqueta = paste0(bloque_politico, "<br>", tipo_contrato, "<br>", percent(pct, accuracy = 0.1), " del bloque")) |>
plot_ly(
x = ~tipo_contrato,
y = ~pct,
type = "bar",
color = ~bloque_politico,
colors = paleta_bloques,
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Mezcla de tipos de contrato por bloque",
barmode = "group",
xaxis = list(title = ""),
yaxis = list(title = "Proporción dentro del bloque", tickformat = ".0%")
) |>
plotly_base()
```
## Proveedores y temporalidad
La dimensión de proveedores es central porque el modelo no solo aprende montos, sino relaciones recurrentes: cuántos contratos acumula un proveedor, cuánto concentra por año y qué tan repetida es la relación con un bloque.
```{r top-proveedores}
top_proveedores |>
group_by(bloque_politico) |>
slice_max(contratos, n = 5, with_ties = FALSE) |>
ungroup() |>
mutate(
proveedor_key = str_trunc(proveedor_key, 45),
proveedor_key = fct_reorder(proveedor_key, contratos),
etiqueta = paste0(
bloque_politico, "<br>", proveedor_key,
"<br>Contratos: ", comma(contratos),
"<br>Monto total: ", fmt_mxn(monto_total)
)
) |>
plot_ly(
x = ~contratos,
y = ~proveedor_key,
type = "bar",
orientation = "h",
color = ~bloque_politico,
colors = paleta_bloques,
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Proveedores más recurrentes por bloque",
xaxis = list(title = "Número de contratos", separatethousands = TRUE),
yaxis = list(title = "")
) |>
plotly_base(margen_izq = 170)
```
```{r temporalidad}
montos |>
filter(!is.na(fecha_firma), !is.na(bloque_politico)) |>
mutate(trimestre_firma = paste0("T", quarter(fecha_firma))) |>
count(bloque_politico, trimestre_firma) |>
group_by(bloque_politico) |>
mutate(pct = n / sum(n)) |>
ungroup() |>
mutate(etiqueta = paste0(bloque_politico, "<br>", trimestre_firma, "<br>", comma(n), " contratos<br>", percent(pct, accuracy = 0.1))) |>
plot_ly(
x = ~trimestre_firma,
y = ~pct,
type = "bar",
color = ~bloque_politico,
colors = paleta_bloques,
text = ~etiqueta,
hovertemplate = "%{text}<extra></extra>"
) |>
layout(
title = "Estacionalidad de contratos por trimestre de firma",
barmode = "group",
xaxis = list(title = "Trimestre"),
yaxis = list(title = "% de contratos del bloque", tickformat = ".0%")
) |>
plotly_base()
```
::: insight
**Lectura:** los patrones de proveedores recurrentes y la estacionalidad por trimestre son útiles para priorizar auditorías. Si un bloque concentra muchos contratos en pocos proveedores o en el cierre del ejercicio, conviene revisar expedientes, procedimientos de contratación y justificaciones presupuestales.
:::
# Pipeline de clasificación supervisada
El pipeline se entrenó con `tidymodels`. La variable objetivo fue `bloque_politico`, construida únicamente desde `partido` y después separada de los predictores. El procesamiento eliminó identificadores, variables de fuga, varianza casi nula y colinealidad alta. Las variables categóricas se trataron con `step_other()` y `step_dummy()`, las numéricas se imputaron y normalizaron cuando correspondía, y el desbalance se manejó con SMOTE dentro del recipe.
```{r variables-modelado}
variables_modelado |>
filter(!variable %in% c("partido", "partido_archivo", "tema", "area")) |>
tabla_interactiva("Variables candidatas incluidas en la matriz de modelado", page_length = 12)
```
Modelos comparados:
- Regresión logística multinomial como línea base.
- Random Forest con tuning de `mtry`, `trees` y `min_n`.
- XGBoost con tuning de `learn_rate`, `tree_depth`, `min_n` y `loss_reduction`.
- Regularización multinomial con `glmnet`, ajustando `penalty` y `mixture`.
```{r ranking-modelos}
ranking_modelos |>
transmute(
Modelo = modelo,
`ROC-AUC CV` = round(mean, 4),
`Error estándar` = round(std_err, 4),
Configuración = .config
) |>
tabla_interactiva("Ranking de modelos por ROC-AUC en validación cruzada estratificada", page_length = 5)
```
```{r metricas-cv}
metricas_modelos |>
group_by(modelo, .metric) |>
slice_max(mean, n = 1, with_ties = FALSE) |>
ungroup() |>
select(modelo, .metric, mean, std_err, .config) |>
arrange(.metric, desc(mean)) |>
mutate(mean = round(mean, 4), std_err = round(std_err, 4)) |>
rename(
Modelo = modelo,
Métrica = .metric,
Media = mean,
`Error estándar` = std_err,
Configuración = .config
) |>
tabla_interactiva("Mejores métricas por familia de modelo", page_length = 10)
```
# Evaluación del modelo ganador
El modelo ganador se ajustó con `last_fit()` sobre la partición de prueba. La métrica principal es ROC-AUC multiclase por el desbalance entre bloques; accuracy y kappa se reportan como métricas secundarias.
```{r metricas-test}
metricas_test |>
transmute(
Modelo = modelo,
Métrica = .metric,
Estimación = round(.estimate, 4)
) |>
tabla_interactiva("Métricas finales en conjunto de prueba", page_length = 5)
```
```{r matriz-confusion}
orden_bloques <- c("oficialista", "oposición tradicional", "fuerzas locales")
confusion_plot_data <- matriz_confusion |>
group_by(bloque_real) |>
mutate(pct = n / sum(n)) |>
ungroup()
z_confusion <- confusion_plot_data |>
mutate(
bloque_real = factor(bloque_real, levels = orden_bloques),
bloque_predicho = factor(bloque_predicho, levels = orden_bloques)
) |>
arrange(bloque_predicho, bloque_real) |>
select(bloque_real, bloque_predicho, pct) |>
pivot_wider(names_from = bloque_real, values_from = pct, values_fill = 0) |>
select(all_of(orden_bloques)) |>
as.matrix()
texto_confusion <- confusion_plot_data |>
mutate(
bloque_real = factor(bloque_real, levels = orden_bloques),
bloque_predicho = factor(bloque_predicho, levels = orden_bloques),
etiqueta = paste0(n, "<br>", percent(pct, accuracy = 0.1))
) |>
arrange(bloque_predicho, bloque_real) |>
select(bloque_real, bloque_predicho, etiqueta) |>
pivot_wider(names_from = bloque_real, values_from = etiqueta, values_fill = "0<br>0.0%") |>
select(all_of(orden_bloques)) |>
as.matrix()
plot_ly(
x = orden_bloques,
y = orden_bloques,
z = z_confusion,
text = texto_confusion,
type = "heatmap",
colors = color_matriz,
hovertemplate = "Real: %{x}<br>Predicho: %{y}<br>%{text}<extra></extra>",
texttemplate = "%{text}",
textfont = list(color = "#17202A", size = 12)
) |>
layout(
title = "Matriz de confusión normalizada por bloque real",
xaxis = list(title = "Bloque real"),
yaxis = list(title = "Bloque predicho")
) |>
plotly_base()
```
# Interpretabilidad
Las variables más importantes apuntan a una combinación de señales: año, alcance, tipo de contratación, estructura temporal y comportamiento agregado de proveedores. Esto sugiere que la clasificación no depende de una sola columna obvia, sino de patrones acumulados de gasto y relación contractual.
```{r importancia}
top_importancia <- importancia_variables |>
slice_max(importancia, n = 20, with_ties = FALSE) |>
mutate(
variable_limpia = variable |>
str_replace_all("_", " ") |>
str_replace_all("\\.", " ") |>
str_trunc(55),
variable_limpia = fct_reorder(variable_limpia, importancia)
)
plot_ly(
top_importancia,
x = ~importancia,
y = ~variable_limpia,
type = "bar",
orientation = "h",
marker = list(color = color_secundario),
text = ~round(importancia, 3),
hovertemplate = "<b>%{y}</b><br>Importancia: %{x:.4f}<extra></extra>"
) |>
layout(
title = glue("Top 20 variables por importancia - {mejor_modelo}"),
xaxis = list(title = "Importancia relativa"),
yaxis = list(title = "", categoryorder = "total ascending")
) |>
plotly_base(margen_izq = 175)
```
```{r tabla-importancia}
importancia_variables |>
slice_max(importancia, n = 25, with_ties = FALSE) |>
mutate(importancia = round(importancia, 5)) |>
rename(Variable = variable, Importancia = importancia, Tipo = tipo) |>
tabla_interactiva("Ranking auditable de variables importantes", page_length = 10)
```
# Hallazgos sustantivos
```{r perfiles-bloque}
patrones_bloque |>
mutate(
monto_total = fmt_mxn(monto_total),
monto_promedio = fmt_mxn(monto_promedio),
monto_mediano = fmt_mxn(monto_mediano),
pct_persona_moral = percent(pct_persona_moral, accuracy = 0.1),
pct_prestacion = percent(pct_prestacion, accuracy = 0.1),
pct_adquisicion = percent(pct_adquisicion, accuracy = 0.1),
pct_fin_ejercicio = percent(pct_fin_ejercicio, accuracy = 0.1),
contratos_por_proveedor = round(contratos_por_proveedor, 2)
) |>
rename(
`Bloque político` = bloque_politico,
Contratos = n_contratos,
`Monto total` = monto_total,
`Monto promedio` = monto_promedio,
`Monto mediano` = monto_mediano,
`% persona moral` = pct_persona_moral,
`% prestación` = pct_prestacion,
`% adquisición` = pct_adquisicion,
`% cierre de ejercicio` = pct_fin_ejercicio,
`Proveedores únicos` = proveedores_unicos,
`Contratos/proveedor` = contratos_por_proveedor
) |>
tabla_interactiva("Perfil descriptivo por bloque político", page_length = 5)
```
**Concentración relacional.** Cuando un bloque tiene muchos contratos por proveedor, el modelo mejora su capacidad predictiva porque la red de contratación se vuelve reconocible. Esto es una señal de riesgo para auditoría, no una prueba de irregularidad.
**Estacionalidad presupuestal.** Las diferencias por trimestre y cierre de ejercicio pueden reflejar rutinas administrativas distintas. Cuando el gasto se concentra al final del año, conviene revisar si responde a planeación normal o a ejercicio acelerado de recursos.
**Mezcla tipo-monto.** La combinación entre tipo de contrato y monto separa bloques con compras pequeñas recurrentes de bloques con menos contratos pero montos más altos. Esa diferencia puede ser útil para focalizar revisión documental.
# Limitaciones
- El modelo es predictivo, no causal.
- Las variables de proveedor describen patrones observados, no relaciones jurídicas probadas.
- El universo modelado es menor que el dataset completo porque requiere partido estandarizado.
- No se usaron datos externos, por lo que no se validan beneficiarios finales, sanciones, militancia ni redes empresariales.
- `tema` y `area` se excluyeron por decisión metodológica para evitar señales textuales demasiado cercanas a la clasificación administrativa.
# Publicación en RPubs
Este archivo está preparado para publicarse como **una sola página** en RPubs. Esa es la diferencia frente a publicar los notebooks separados: RPubs no sube automáticamente todo el sitio Quarto multipágina, por eso antes no aparecían la exploración general ni el análisis de `contratos_montos.csv`.
Para generar el HTML:
```{r publicar-comandos, eval=FALSE, echo=TRUE}
Sys.setenv(
QUARTO_PATH = "/Applications/RStudio.app/Contents/Resources/app/quarto/bin/quarto"
)
quarto::quarto_render("notebooks/04_reporte_final_rpubs.qmd")
```
Para subirlo desde RStudio/R:
```{r rpubs-upload, eval=FALSE, echo=TRUE}
library(rsconnect)
rsconnect::rpubsUpload(
title = "Contratos públicos y bloques políticos",
contentFile = normalizePath("docs/notebooks/04_reporte_final_rpubs.html"),
originalDoc = normalizePath("notebooks/04_reporte_final_rpubs.qmd")
)
```