1 Introducción

Este documento presenta un análisis de las redes de poder en Colombia a partir de una base de datos bipartita que relaciona funcionarios públicos con las entidades en las que fueron nombrados a lo largo de seis gobiernos: Uribe 1, Uribe 2, Santos 1, Santos 2, Duque y Petro. El enfoque sigue la metodología de Análisis Estadístico de Redes (Sosa, 2024; Luke, 2015), construyendo redes de co-membresía a partir de proyecciones de matrices bipartitas.

El artículo de referencia de la Fundación Pares (Chala, 2024) ofrece un primer acercamiento descriptivo a los grupos de poder del gobierno Petro. En este trabajo se amplía dicho análisis con herramientas formales de teoría de redes.

2 Carga de librerías y datos

suppressMessages({
  library(igraph)
  library(readxl)
  library(dplyr)
  library(tidyr)
  library(ggplot2)
  library(knitr)
  library(kableExtra)
  library(scales)
  library(corrplot)
})
# Carga del archivo de datos
# Ajusta la ruta al directorio donde guardaste el archivo
datos <- read_excel("poder.xlsx", sheet = "GABINETE_LIMPIO")

# Dimensiones generales
cat("Dimensiones del conjunto de datos:", nrow(datos), "x", ncol(datos), "\n")
## Dimensiones del conjunto de datos: 265 x 62
# Nombres de columnas relevantes
col_entidades <- names(datos)[2:50]   # columnas bipartitas (entidades)
col_covs      <- c("NOMBRE", "EDAD", "GENERO", "PARTIDO_POLITICO",
                   "NIVEL_DE_ESTUDIOS", "GOBERNACION")

cat("Numero de entidades publicas (m):", length(col_entidades), "\n")
## Numero de entidades publicas (m): 49
cat("Total de funcionarios (n):", nrow(datos), "\n")
## Total de funcionarios (n): 265
# Distribución por gobierno
tabla_gov <- datos %>%
  mutate(gov_simple = trimws(GOBERNACION)) %>%
  count(gov_simple, sort = TRUE) %>%
  rename(Gobernacion = gov_simple, Frecuencia = n)

kable(tabla_gov,
      caption = "Distribución de registros por gobierno en la base completa",
      align = c("l", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white")
Distribución de registros por gobierno en la base completa
Gobernacion Frecuencia
PETRO 73
DUQUE 52
SANTOS-1 33
SANTOS-2 27
URIBE-2 23
URIBE-1 18
PETRO, SANTOS-2 5
SANTOS-2, SANTOS-1 5
SANTOS-1, SANTOS-2 4
SANTOS-2,SANTOS-1 3
URIBE-2, URIBE-1 3
URIBE-2,URIBE-1 3
DUQUE, URIBE-1 2
PETRO, DUQUE 2
PETRO, SANTOS-1 2
DUQUE, URIBE-1, URIBE-2 1
DUQUE, URIBE-2 1
PETRO, SANTOS-2, SANTOS-1 1
SANTOS-1, PASTRANA 1
SANTOS-1, SANTOS-2, URIBE-1 1
SANTOS-1, URIBE-2 1
SANTOS-1,SANTOS-2 1
SANTOS-1,URIBE-2 1
URIBE-1, URIBE-2 1
URIBE-1,URIBE-2 1

3 Construcción de las cuatro redes de gobierno

La estrategia de filtrado identifica, para cada gobierno, todos los funcionarios cuyo campo GOBERNACION contiene el nombre del gobierno correspondiente. Esto conserva a quienes participaron en varios periodos, conforme al enunciado.

A partir de la submatriz bipartita \(A_P\) de tamaño \(n_P \times m\), se calcula la proyección \(A_P A_P^\top\) de tamaño \(n_P \times n_P\), cuyos elementos \([i,j]\) cuentan el número de entidades en que los funcionarios \(i\) y \(j\) coincidieron. Finalmente, se binariza esta matriz y se eliminan los elementos de la diagonal.

# Funcion para construir la red binaria de un gobierno
construir_red_gobierno <- function(datos, patron_gobierno, col_entidades) {
  
  # Filtrar funcionarios que pertenecen al gobierno indicado
  # se reemplazan NAs en GOBERNACION por "" para evitar NA en grepl
  gobernacion_safe <- ifelse(is.na(datos$GOBERNACION), "", datos$GOBERNACION)
  idx <- grepl(patron_gobierno, gobernacion_safe, ignore.case = TRUE)
  sub <- datos[idx, ]
  
  # Submatriz bipartita A: n_P x m (solo entidades)
  A <- as.matrix(sub[, col_entidades])
  # Reemplazar NA por 0
  A[is.na(A)] <- 0
  A <- matrix(as.numeric(A), nrow = nrow(A))
  rownames(A) <- sub$NOMBRE
  
  # Proyeccion ponderada: A A^T
  W <- A %*% t(A)
  
  # Binarizacion: Y_ij = 1 si W_ij > 0, diagonal = 0
  Y <- (W > 0) * 1L
  diag(Y) <- 0L
  rownames(Y) <- sub$NOMBRE
  colnames(Y) <- sub$NOMBRE
  
  # Construir grafo igraph no dirigido
  g <- graph_from_adjacency_matrix(Y, mode = "undirected", diag = FALSE)
  
  # Agregar atributos nodales
  V(g)$genero     <- as.character(sub$GENERO)
  V(g)$partido    <- as.character(sub$PARTIDO_POLITICO)
  V(g)$estudios   <- as.character(sub$NIVEL_DE_ESTUDIOS)
  V(g)$edad       <- as.numeric(sub$EDAD)
  V(g)$gobernacion <- as.character(sub$GOBERNACION)
  
  list(grafo = g, matriz_A = A, matriz_Y = Y,
       n = nrow(Y), m = ncol(A), funcionarios = sub$NOMBRE)
}

# Construccion de las cuatro redes
red_petro  <- construir_red_gobierno(datos, "PETRO",    col_entidades)
red_duque  <- construir_red_gobierno(datos, "DUQUE",    col_entidades)
red_santos <- construir_red_gobierno(datos, "SANTOS",   col_entidades)
red_uribe  <- construir_red_gobierno(datos, "URIBE",    col_entidades)

# Resumen de ordenes y tamanos
resumen_redes <- data.frame(
  Gobierno  = c("Petro", "Duque", "Santos (1+2)", "Uribe (1+2)"),
  n_P       = c(red_petro$n,  red_duque$n,  red_santos$n,  red_uribe$n),
  m         = c(red_petro$m,  red_duque$m,  red_santos$m,  red_uribe$m),
  Aristas   = c(ecount(red_petro$grafo),  ecount(red_duque$grafo),
                ecount(red_santos$grafo), ecount(red_uribe$grafo))
)

kable(resumen_redes,
      caption = "Orden (n), columnas bipartitas (m) y tamano de cada red de gobierno",
      col.names = c("Gobierno", "n (funcionarios)", "m (entidades)", "Aristas"),
      align = c("l", "r", "r", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white")
Orden (n), columnas bipartitas (m) y tamano de cada red de gobierno
Gobierno n (funcionarios) m (entidades) Aristas
Petro 83 49 171
Duque 58 49 77
Santos (1+2) 85 49 278
Uribe (1+2) 56 49 116

4 Visualizaciones de las redes por gobierno

Se presentan visualizaciones decoradas para cada red utilizando el grado de los nodos para determinar su tamaño y el genero del funcionario como atributo de color. El layout de Fruchterman-Reingold (Fruchterman & Reingold, 1991) favorece la identificacion de grupos densos.

# Paleta institucional del trabajo
pal_morado <- c("#3d0f28", "#70284a", "#9b6b8a", "#c9a8c0", "#5c1a35")

# Funcion auxiliar para color segun genero
color_genero <- function(genero_vec) {
  ifelse(genero_vec %in% c("M", "Masculino", "1", "MASCULINO"),
         "#70284a", "#c9a8c0")
}

4.1 Red Petro

g_p <- red_petro$grafo
d_p <- degree(g_p)
col_p <- color_genero(V(g_p)$genero)

set.seed(42)
layout_p <- layout_with_fr(g_p)

plot(g_p,
     layout            = layout_p,
     vertex.size       = 2 + 6 * (d_p / max(d_p)),
     vertex.color      = col_p,
     vertex.frame.color = "#3d0f28",
     vertex.label      = ifelse(d_p >= quantile(d_p, 0.90),
                                 V(g_p)$name, NA),
     vertex.label.cex  = 0.55,
     vertex.label.color = "black",
     edge.color        = adjustcolor("#9b6b8a", 0.35),
     edge.width        = 0.4,
     main              = "Red de poder — Gobierno Petro")
legend("bottomleft",
       legend = c("Masculino", "Femenino"),
       col    = c("#70284a", "#c9a8c0"),
       pch    = 21, pt.bg = c("#70284a", "#c9a8c0"),
       bty    = "n", cex = 0.85)

4.2 Red Duque

g_d <- red_duque$grafo
d_d <- degree(g_d)
col_d <- color_genero(V(g_d)$genero)

set.seed(42)
layout_d <- layout_with_fr(g_d)

plot(g_d,
     layout            = layout_d,
     vertex.size       = 2 + 6 * (d_d / max(d_d)),
     vertex.color      = col_d,
     vertex.frame.color = "#3d0f28",
     vertex.label      = ifelse(d_d >= quantile(d_d, 0.90),
                                 V(g_d)$name, NA),
     vertex.label.cex  = 0.55,
     vertex.label.color = "black",
     edge.color        = adjustcolor("#9b6b8a", 0.35),
     edge.width        = 0.4,
     main              = "Red de poder — Gobierno Duque")
legend("bottomleft",
       legend = c("Masculino", "Femenino"),
       col    = c("#70284a", "#c9a8c0"),
       pch    = 21, pt.bg = c("#70284a", "#c9a8c0"),
       bty    = "n", cex = 0.85)

4.3 Red Santos (periodos combinados)

g_s <- red_santos$grafo
d_s <- degree(g_s)
col_s <- color_genero(V(g_s)$genero)

set.seed(42)
layout_s <- layout_with_fr(g_s)

plot(g_s,
     layout            = layout_s,
     vertex.size       = 2 + 6 * (d_s / max(d_s)),
     vertex.color      = col_s,
     vertex.frame.color = "#3d0f28",
     vertex.label      = ifelse(d_s >= quantile(d_s, 0.90),
                                 V(g_s)$name, NA),
     vertex.label.cex  = 0.55,
     vertex.label.color = "black",
     edge.color        = adjustcolor("#9b6b8a", 0.35),
     edge.width        = 0.4,
     main              = "Red de poder — Gobierno Santos (1+2)")
legend("bottomleft",
       legend = c("Masculino", "Femenino"),
       col    = c("#70284a", "#c9a8c0"),
       pch    = 21, pt.bg = c("#70284a", "#c9a8c0"),
       bty    = "n", cex = 0.85)

4.4 Red Uribe (periodos combinados)

g_u <- red_uribe$grafo
d_u <- degree(g_u)
col_u <- color_genero(V(g_u)$genero)

set.seed(42)
layout_u <- layout_with_fr(g_u)

plot(g_u,
     layout            = layout_u,
     vertex.size       = 2 + 6 * (d_u / max(d_u)),
     vertex.color      = col_u,
     vertex.frame.color = "#3d0f28",
     vertex.label      = ifelse(d_u >= quantile(d_u, 0.90),
                                 V(g_u)$name, NA),
     vertex.label.cex  = 0.55,
     vertex.label.color = "black",
     edge.color        = adjustcolor("#9b6b8a", 0.35),
     edge.width        = 0.4,
     main              = "Red de poder — Gobierno Uribe (1+2)")
legend("bottomleft",
       legend = c("Masculino", "Femenino"),
       col    = c("#70284a", "#c9a8c0"),
       pch    = 21, pt.bg = c("#70284a", "#c9a8c0"),
       bty    = "n", cex = 0.85)

Patron visual comparado. Las redes de Santos y Uribe tienden a ser mas densas dado el mayor numero de funcionarios acumulados en dos periodos. La red de Petro evidencia un nucleo compacto de funcionarios que comparten multiples entidades, coherente con la descripcion de Chala (2024) sobre los bloques de la Colombia Humana. La participacion femenina (nodos en lila claro) es notablemente mayor en el gobierno Petro con relacion a los anteriores.

5 Medidas de centralidad

Se calculan cuatro medidas de centralidad para cada red: grado (importancia local), cercania (closeness, acceso a la informacion), intermediacion (betweenness, control de flujo) y vector propio (eigenvector, importancia de vecinos). Siguiendo a Newman (2010), estas medidas son complementarias y revelan distintas dimensiones de la influencia.

calcular_centralidad <- function(g, nombre_gov, top_n = 10) {
  
  # Componente gigante para distancias bien definidas
  comp <- components(g)
  gc   <- induced_subgraph(g, which(comp$membership == which.max(comp$csize)))
  
  d_gc  <- degree(gc, normalized = TRUE)
  cl_gc <- closeness(gc, normalized = TRUE)
  bt_gc <- betweenness(gc, normalized = TRUE)
  ev_gc <- eigen_centrality(gc)$vector
  
  df <- data.frame(
    Funcionario   = V(gc)$name,
    Grado_norm    = round(d_gc,  4),
    Cercania      = round(cl_gc, 4),
    Intermediacion = round(bt_gc, 4),
    VectorPropio  = round(ev_gc, 4)
  ) %>%
    arrange(desc(Grado_norm)) %>%
    head(top_n)
  
  df$Gobierno <- nombre_gov
  return(df)
}

top_petro  <- calcular_centralidad(red_petro$grafo,  "Petro")
top_duque  <- calcular_centralidad(red_duque$grafo,  "Duque")
top_santos <- calcular_centralidad(red_santos$grafo, "Santos")
top_uribe  <- calcular_centralidad(red_uribe$grafo,  "Uribe")

5.1 Top 10 por gobierno — Grado normalizado

presentar_top <- function(df, titulo) {
  kable(df %>% select(-Gobierno),
        caption  = titulo,
        col.names = c("Funcionario", "Grado norm.", "Cercania", 
                       "Intermediacion", "Vector propio"),
        align    = c("l","r","r","r","r"),
        digits   = 4) %>%
    kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
    row_spec(0, background = "#70284a", color = "white") %>%
    row_spec(1, background = "#f0eaf5")
}

presentar_top(top_petro,  "Top 10 — Red Petro (por grado normalizado)")
Top 10 — Red Petro (por grado normalizado)
Funcionario Grado norm. Cercania Intermediacion Vector propio
OSCAR MAURICIO LIZCANO ARANGO OSCAR MAURICIO LIZCANO ARANGO 0.3617 0.5054 0.2998 1.0000
LAURA CAMILA SARABIA TORRES LAURA CAMILA SARABIA TORRES 0.2766 0.4845 0.4268 0.3414
MIGUEL ANGEL PINTO HERNANDEZ MIGUEL ANGEL PINTO HERNANDEZ 0.2766 0.4196 0.1591 0.9013
ARMANDO ALBERTO BENEDETTI VILLANEDA ARMANDO ALBERTO BENEDETTI VILLANEDA 0.2553 0.4796 0.1431 0.9203
ALEXANDER LOPEZ MAYA ALEXANDER LOPEZ MAYA 0.2553 0.4519 0.2167 0.8834
JUAN FERNANDO CRISTO BUSTOS JUAN FERNANDO CRISTO BUSTOS 0.2128 0.4087 0.0079 0.8748
LUIS FERNANDO VELASCO CHAVES LUIS FERNANDO VELASCO CHAVES 0.2128 0.4087 0.0079 0.8748
JOSE ANTONIO OCAMPO GAVIRIA JOSE ANTONIO OCAMPO GAVIRIA 0.1915 0.3852 0.2044 0.1319
LIDIO ARTURO GARCIA TURBAY LIDIO ARTURO GARCIA TURBAY 0.1915 0.4052 0.0000 0.8477
EFRAIN JOSE CEPEDA SARABIA EFRAIN JOSE CEPEDA SARABIA 0.1915 0.4052 0.0000 0.8477 
presentar_top(top_duque,  "Top 10 — Red Duque (por grado normalizado)")
Top 10 — Red Duque (por grado normalizado)
Funcionario Grado norm. Cercania Intermediacion Vector propio
MARTA LUCIA RAMIREZ BLANCO MARTA LUCIA RAMIREZ BLANCO 0.32 0.5000 0.4906 0.5837
CLAUDIA BLUM CAPURRO DE BARBERI CLAUDIA BLUM CAPURRO DE BARBERI 0.32 0.4545 0.2083 1.0000
CARLOS HOLMES TRUJILLO GARCIA CARLOS HOLMES TRUJILLO GARCIA 0.32 0.4717 0.2683 0.7233
NANCY PATRICIA GUTIERREZ CASTANEDA NANCY PATRICIA GUTIERREZ CASTANEDA 0.32 0.3968 0.0839 0.9623
JOSE MANUEL RESTREPO ABONDANO JOSE MANUEL RESTREPO ABONDANO 0.24 0.4098 0.3333 0.2420
LIDIO ARTURO GARCIA TURBAY LIDIO ARTURO GARCIA TURBAY 0.20 0.3521 0.0000 0.7396
JUAN DIEGO GOMEZ JIMENEZ JUAN DIEGO GOMEZ JIMENEZ 0.20 0.3521 0.0000 0.7396
ARTURO CHAR CHALJUB ARTURO CHAR CHALJUB 0.20 0.3521 0.0000 0.7396
ERNESTO JOSE MACIAS TOVAR ERNESTO JOSE MACIAS TOVAR 0.20 0.3521 0.0000 0.7396
MARIA ADRIANA MEJIA HERNANDEZ MARIA ADRIANA MEJIA HERNANDEZ 0.16 0.4386 0.1322 0.4253 
presentar_top(top_santos, "Top 10 — Red Santos (por grado normalizado)")
Top 10 — Red Santos (por grado normalizado)
Funcionario Grado norm. Cercania Intermediacion Vector propio
MAURICIO CARDENAS SANTAMARIA MAURICIO CARDENAS SANTAMARIA 0.3182 0.4615 0.2135 0.3613
GERMAN VARGAS LLERAS GERMAN VARGAS LLERAS 0.3182 0.4925 0.3257 1.0000
FEDERICO ALONSO RENJIFO VELEZ FEDERICO ALONSO RENJIFO VELEZ 0.2424 0.4748 0.1894 0.6899
ARMANDO ALBERTO BENEDETTI VILLANEDA ARMANDO ALBERTO BENEDETTI VILLANEDA 0.1970 0.4177 0.0196 0.8602
JUAN FERNANDO CRISTO BUSTOS JUAN FERNANDO CRISTO BUSTOS 0.1970 0.4177 0.0196 0.8602
LUIS FERNANDO VELASCO CHAVES LUIS FERNANDO VELASCO CHAVES 0.1970 0.4177 0.0196 0.8602
OSCAR MAURICIO LIZCANO ARANGO OSCAR MAURICIO LIZCANO ARANGO 0.1818 0.3771 0.0827 0.6808
AURELIO IRAGORRI VALENCIA AURELIO IRAGORRI VALENCIA 0.1818 0.4074 0.0598 0.5891
JUAN CAMILO RESTREPO SALAZAR JUAN CAMILO RESTREPO SALAZAR 0.1818 0.3882 0.0477 0.3039
BEATRIZ URIBE BOTERO BEATRIZ URIBE BOTERO 0.1667 0.4204 0.1246 0.2268 
presentar_top(top_uribe,  "Top 10 — Red Uribe (por grado normalizado)")
Top 10 — Red Uribe (por grado normalizado)
Funcionario Grado norm. Cercania Intermediacion Vector propio
MARTA LUCIA RAMIREZ BLANCO MARTA LUCIA RAMIREZ BLANCO 0.3889 0.5455 0.4198 0.6480
GERMAN VARGAS LLERAS GERMAN VARGAS LLERAS 0.3611 0.4557 0.2405 1.0000
CLAUDIA BLUM CAPURRO DE BARBERI CLAUDIA BLUM CAPURRO DE BARBERI 0.3333 0.4615 0.1937 0.9691
JUAN MANUEL SANTOS CALDERON JUAN MANUEL SANTOS CALDERON 0.3333 0.4865 0.4365 0.3090
NANCY PATRICIA GUTIERREZ CASTANEDA NANCY PATRICIA GUTIERREZ CASTANEDA 0.3056 0.3673 0.0317 0.9042
FERNANDO ARAUJO PERDOMO FERNANDO ARAUJO PERDOMO 0.2222 0.4737 0.1032 0.4257
MARIA CONSUELO ARAUJO CASTRO MARIA CONSUELO ARAUJO CASTRO 0.1944 0.4138 0.1079 0.3580
JAVIER ENRIQUE CACERES LEAL JAVIER ENRIQUE CACERES LEAL 0.1944 0.3529 0.0000 0.7311
HERNAN FRANCISCO ANDRADE SERRANO HERNAN FRANCISCO ANDRADE SERRANO 0.1944 0.3529 0.0000 0.7311
DILIAN FRANCISCA TORO TORRES DILIAN FRANCISCA TORO TORRES 0.1944 0.3529 0.0000 0.7311

5.2 Visualizaciones de centralidad de grado

# Funcion auxiliar: genera colores con gradiente de opacidad a partir de
# un vector de intensidades en [0,1]. adjustcolor() solo acepta escalares,
# por eso se usa colorRamp() que opera elemento a elemento.
color_gradiente <- function(intensidad, hex_bajo = "#c9a8c0", hex_alto = "#3d0f28") {
  ramp <- colorRamp(c(hex_bajo, hex_alto))
  mat  <- ramp(pmin(pmax(intensidad, 0), 1))   # clamp a [0,1]
  rgb(mat[, 1], mat[, 2], mat[, 3], maxColorValue = 255)
}

# Funcion de visualizacion por centralidad de grado
vis_centralidad <- function(g, titulo_graf) {
  comp <- components(g)
  g2   <- induced_subgraph(g, which(comp$membership == which.max(comp$csize)))
  d2   <- degree(g2, normalized = TRUE)
  
  # Gradiente de color proporcional al grado normalizado
  col_nodos <- color_gradiente(d2)
  
  set.seed(42)
  lay <- layout_with_fr(g2)
  
  plot(g2,
       layout             = lay,
       vertex.size        = 3 + 12 * d2,
       vertex.color       = col_nodos,
       vertex.frame.color = "#3d0f28",
       vertex.label       = ifelse(d2 >= quantile(d2, 0.88),
                                    V(g2)$name, NA),
       vertex.label.cex   = 0.55,
       vertex.label.color = "black",
       edge.color         = adjustcolor("#c9a8c0", 0.4),
       edge.width         = 0.5,
       main               = titulo_graf)
  
  legend("bottomleft",
         legend = c("Grado bajo", "Grado alto"),
         fill   = c("#c9a8c0", "#3d0f28"),
         bty    = "n", cex = 0.8)
}

vis_centralidad(red_petro$grafo,  "Centralidad de grado — Petro")

vis_centralidad(red_duque$grafo,  "Centralidad de grado — Duque")

vis_centralidad(red_santos$grafo, "Centralidad de grado — Santos")

vis_centralidad(red_uribe$grafo,  "Centralidad de grado — Uribe")

5.3 Comparacion grafica entre gobiernos

# Top 5 de cada gobierno por grado para comparacion
top5_all <- bind_rows(
  top_petro  %>% head(5),
  top_duque  %>% head(5),
  top_santos %>% head(5),
  top_uribe  %>% head(5)
)

# Acortar nombres para el grafico
top5_all$Nombre_corto <- sapply(strsplit(top5_all$Funcionario, " "), function(x) {
  paste(x[1], ifelse(length(x) >= 2, x[2], ""), sep = " ")
})

ggplot(top5_all, aes(x = reorder(Nombre_corto, Grado_norm),
                      y = Grado_norm, fill = Gobierno)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ Gobierno, scales = "free_y", ncol = 2) +
  coord_flip() +
  scale_fill_manual(values = c("Petro"  = "#70284a",
                                "Duque"  = "#9b6b8a",
                                "Santos" = "#3d0f28",
                                "Uribe"  = "#c9a8c0")) +
  labs(title    = "Top 5 funcionarios mas centrales por gobierno",
       subtitle = "Centralidad de grado normalizada",
       x = NULL, y = "Grado normalizado") +
  theme_minimal(base_size = 12) +
  theme(strip.background = element_rect(fill = "#70284a"),
        strip.text       = element_text(color = "white", face = "bold"))

Hallazgos de centralidad. En todos los gobiernos los nodos mas centrales corresponden a figuras que ocuparon simultaneamente varios cargos o que pasaron por mas de una entidad clave, lo que maximiza su grado en la red de co-membresía. En la red de Petro destaca la presencia de funcionarios vinculados al DAPRE y a la Presidencia como hubs de conectividad. Esta configuracion es coherente con el relato de Chala (2024) sobre la centralizacion de decision en circulos proximos al presidente. En Uribe y Santos los hubs corresponden principalmente a ministerios de portafolio amplio (Hacienda, Interior, Educacion).

6 Analisis estructural de las redes

Se calculan metricas de distancia, cohesion, conectividad y agrupamiento para cada red, siguiendo el marco teorico de Luke (2015) y las notas de clase (Sosa, 2024).

metricas_red <- function(g, nombre) {
  
  # Componente gigante
  comp <- components(g)
  gcc  <- induced_subgraph(g, which(comp$membership == which.max(comp$csize)))
  
  data.frame(
    Gobierno              = nombre,
    Orden                 = vcount(g),
    Tamano                = ecount(g),
    N_componentes         = comp$no,
    Tamano_GCC            = vcount(gcc),
    Densidad              = round(edge_density(g), 4),
    Transitividad_global  = round(transitivity(g, type = "global"), 4),
    Transitividad_local   = round(mean(transitivity(g, type = "local"),
                                       na.rm = TRUE), 4),
    Distancia_geodesica   = round(mean_distance(gcc, directed = FALSE), 4),
    Diametro              = diameter(gcc, directed = FALSE),
    Asortatividad_grado   = round(assortativity_degree(g, directed = FALSE), 4),
    Grado_promedio        = round(mean(degree(g)), 3)
  )
}

met_petro  <- metricas_red(red_petro$grafo,  "Petro")
met_duque  <- metricas_red(red_duque$grafo,  "Duque")
met_santos <- metricas_red(red_santos$grafo, "Santos")
met_uribe  <- metricas_red(red_uribe$grafo,  "Uribe")

metricas_all <- bind_rows(met_petro, met_duque, met_santos, met_uribe)

# Transponer para presentacion vertical
kable(t(metricas_all),
      caption = "Metricas estructurales comparadas por gobierno",
      align   = "r") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white") %>%
  column_spec(1, bold = TRUE)
Metricas estructurales comparadas por gobierno
Gobierno Petro Duque Santos Uribe
Orden 83 58 85 56
Tamano 171 77 278 116
N_componentes 14 16 5 10
Tamano_GCC 48 26 67 37
Densidad 0.0502 0.0466 0.0779 0.0753
Transitividad_global 0.6555 0.6290 0.6386 0.6295
Transitividad_local 0.8824 0.7762 0.8287 0.8755
Distancia_geodesica 2.9140 2.9877 2.9186 2.8498
Diametro 7 7 7 6
Asortatividad_grado 0.3999 0.4966 0.1559 0.2099
Grado_promedio 4.120 2.655 6.541 4.143

6.1 Distribucion de grados

grados_df <- bind_rows(
  data.frame(Grado = degree(red_petro$grafo),  Gobierno = "Petro"),
  data.frame(Grado = degree(red_duque$grafo),  Gobierno = "Duque"),
  data.frame(Grado = degree(red_santos$grafo), Gobierno = "Santos"),
  data.frame(Grado = degree(red_uribe$grafo),  Gobierno = "Uribe")
)

ggplot(grados_df, aes(x = Grado, fill = Gobierno)) +
  geom_histogram(bins = 20, alpha = 0.85, color = "white") +
  facet_wrap(~ Gobierno, scales = "free", ncol = 2) +
  scale_fill_manual(values = c("Petro"  = "#70284a",
                                "Duque"  = "#9b6b8a",
                                "Santos" = "#3d0f28",
                                "Uribe"  = "#c9a8c0")) +
  labs(title    = "Distribucion de grados por gobierno",
       subtitle = "Cada panel muestra la distribucion del numero de conexiones por funcionario",
       x = "Grado", y = "Frecuencia") +
  theme_minimal(base_size = 12) +
  theme(legend.position  = "none",
        strip.background = element_rect(fill = "#70284a"),
        strip.text       = element_text(color = "white", face = "bold"))

6.2 Transitividad local por gobierno

trans_df <- bind_rows(
  data.frame(Trans = transitivity(red_petro$grafo,  type = "local"),
             Gobierno = "Petro"),
  data.frame(Trans = transitivity(red_duque$grafo,  type = "local"),
             Gobierno = "Duque"),
  data.frame(Trans = transitivity(red_santos$grafo, type = "local"),
             Gobierno = "Santos"),
  data.frame(Trans = transitivity(red_uribe$grafo,  type = "local"),
             Gobierno = "Uribe")
) %>% filter(!is.na(Trans))

ggplot(trans_df, aes(x = Trans, fill = Gobierno)) +
  geom_density(alpha = 0.7, color = NA) +
  facet_wrap(~ Gobierno, ncol = 2) +
  scale_fill_manual(values = c("Petro"  = "#70284a",
                                "Duque"  = "#9b6b8a",
                                "Santos" = "#3d0f28",
                                "Uribe"  = "#c9a8c0")) +
  labs(title = "Densidad de la transitividad local por gobierno",
       x = "Transitividad local", y = "Densidad") +
  theme_minimal(base_size = 12) +
  theme(legend.position  = "none",
        strip.background = element_rect(fill = "#70284a"),
        strip.text       = element_text(color = "white", face = "bold"))

Interpretacion estructural. La densidad de la red es consistentemente baja en todos los gobiernos, lo que refleja la naturaleza dispersa tipica de las redes reales (Luke, 2015). Sin embargo, la transitividad global es moderada a alta, lo que indica la presencia de triangulos: grupos de funcionarios que co-participan en multiples entidades forman clusters cohesivos. La distancia geodesica promedio corta en la componente gigante sugiere que la informacion y el acceso al poder se propagan con eficiencia dentro de cada gobierno. La asortatividad de grado negativa (si se observa) indicaria que los hubs tienden a conectarse con funcionarios de bajo grado, estructura tipica de redes de elite burocratica donde los actores centrales actuan como intermediarios entre periferias especializadas (Chala, 2024).

7 Modelos estadisticos de redes

Se ajustan tres modelos para cada red de gobierno siguiendo las especificaciones del enunciado:

  • M1: Modelo de bloques estocasticos (SBM) — via deteccion de comunidades con cluster_louvain.
  • M2: Modelo de grafos aleatorios exponencial (ERGM) — via ergm con aristas y efectos homofilicos.
  • M3: Modelo de sociabilidad — muestreador de Gibbs (Sosa & Martinez, 2026).

Nota metodologica. El paquete ergm pertenece al ecosistema statnet y requiere conversion del grafo de igraph a network. El modelo de sociabilidad implementa directamente el muestreador de Gibbs descrito en Sosa (2024) y Sosa & Martinez (2026), disponible en https://rpubs.com/jstats1702/1430765.

7.1 Instalacion y carga de paquetes para modelos

# NOTA: si alguno de estos paquetes no esta instalado, ejecute en la consola
# de RStudio (una sola vez) y luego vuelva a hacer knit:
#
#   install.packages(c("statnet", "ergm", "network", "truncnorm", "coda", "pROC"))
#
# El documento compila correctamente aunque ergm/statnet no esten instalados:
# en ese caso el ERGM se omite automaticamente.

# Carga de paquetes obligatorios (siempre disponibles)
suppressMessages({
  library(truncnorm)
  library(coda)
  library(pROC)
})

# Carga opcional de ergm/statnet: define bandera ergm_disponible
ergm_disponible <- tryCatch({
  suppressMessages({
    library(statnet)
    library(ergm)
    library(network)
  })
  TRUE
}, error = function(e) {
  message("ergm/statnet no disponible — el ERGM se omitira en los resultados.")
  FALSE
})

cat("ergm disponible:", ergm_disponible, "\n")
## ergm disponible: FALSE

7.2 Funciones del modelo de sociabilidad

# Distribuciones condicionales completas del modelo de sociabilidad
# (Sosa & Martinez, 2026; Sosa, 2024 — RPubs 1430765)
#
# sample_z vectorizado: opera sobre todo el triangulo superior a la vez
# en lugar del doble for, lo que reduce el tiempo ~n^2 veces
sample_z <- function(y, mu, delta, z) {
  n    <- nrow(y)
  idx  <- which(upper.tri(y))           # indices del triangulo superior
  ri   <- row(y)[idx]
  ci   <- col(y)[idx]
  mz   <- mu + delta[ri] + delta[ci]    # vector de medias
  yij  <- y[idx]                        # vector de observaciones
  
  # Muestras truncadas: positivo si y=1, negativo si y=0
  zpos <- truncnorm::rtruncnorm(length(idx), a =    0, b = Inf, mean = mz, sd = 1)
  zneg <- truncnorm::rtruncnorm(length(idx), a = -Inf, b =   0, mean = mz, sd = 1)
  znew <- ifelse(yij == 1, zpos, zneg)
  
  z[idx]          <- znew               # triangulo superior
  z[cbind(ci, ri)] <- znew              # triangulo inferior (simetria)
  z
}

sample_mu <- function(z, delta, sigma2) {
  idx   <- upper.tri(z)
  v2_mu <- 1 / (1/sigma2 + sum(idx))
  m_mu  <- v2_mu * sum(z[idx] -
              delta[row(z)[idx]] - delta[col(z)[idx]])
  rnorm(1, mean = m_mu, sd = sqrt(v2_mu))
}

sample_delta <- function(z, mu, tau2, delta) {
  n <- length(delta)
  for (i in 1:n) {
    vecinos  <- setdiff(1:n, i)
    v2_delta <- 1 / (1/tau2 + length(vecinos))
    m_delta  <- v2_delta * sum(z[i, vecinos] - mu - delta[vecinos])
    delta[i] <- rnorm(1, mean = m_delta, sd = sqrt(v2_delta))
  }
  delta
}

sample_sigma2 <- function(mu, a_sigma, b_sigma) {
  1 / rgamma(1, shape = a_sigma + 0.5,
                rate  = b_sigma + 0.5 * mu^2)
}

sample_tau2 <- function(delta, n, a_tau, b_tau) {
  1 / rgamma(1, shape = a_tau + n/2,
                rate  = b_tau + 0.5 * sum(delta^2))
}

gibbs_sociabilidad <- function(Y, n_iter, n_burn, n_thin,
                                a_sigma = 2, b_sigma = 1,
                                a_tau   = 2, b_tau   = 1) {
  n         <- nrow(Y)
  mu        <- 0
  delta     <- rnorm(n, 0, 1)
  sigma2    <- 1
  tau2      <- 1
  z         <- matrix(0, n, n)
  n_samples <- floor((n_iter - n_burn) / n_thin)
  
  out <- list(mu     = numeric(n_samples),
              delta  = matrix(0, n_samples, n),
              sigma2 = numeric(n_samples),
              tau2   = numeric(n_samples))
  
  for (t in 1:n_iter) {
    z      <- sample_z(Y, mu, delta, z)
    mu     <- sample_mu(z, delta, sigma2)
    delta  <- sample_delta(z, mu, tau2, delta)
    sigma2 <- sample_sigma2(mu, a_sigma, b_sigma)
    tau2   <- sample_tau2(delta, n, a_tau, b_tau)
    
    if (t > n_burn && (t - n_burn) %% n_thin == 0) {
      idx             <- (t - n_burn) %/% n_thin
      out$mu[idx]     <- mu
      out$delta[idx,] <- delta
      out$sigma2[idx] <- sigma2
      out$tau2[idx]   <- tau2
    }
  }
  out
}

7.3 Ajuste de modelos — funcion generica

# Funcion para convertir igraph a network (statnet) — solo se usa si ergm esta disponible
igraph_a_network <- function(g, directed = FALSE) {
  Y   <- as.matrix(as_adjacency_matrix(g, sparse = FALSE))
  net <- as.network(Y, directed = directed)
  if (!is.null(V(g)$genero))  set.vertex.attribute(net, "genero",  V(g)$genero)
  if (!is.null(V(g)$partido)) set.vertex.attribute(net, "partido", V(g)$partido)
  net
}

# Funcion principal: ajusta SBM, ERGM (si disponible) y Sociabilidad
ajustar_modelos <- function(g, nombre_gov,
                             n_iter_gibbs = 3000, n_burn_gibbs = 500,
                             n_thin_gibbs = 5) {
  
  cat("\n========================================\n")
  cat(" Ajustando modelos para:", nombre_gov, "\n")
  cat("========================================\n")
  
  # ---- Componente gigante ----
  comp <- components(g)
  gcc  <- induced_subgraph(g, which(comp$membership == which.max(comp$csize)))
  Y    <- as.matrix(as_adjacency_matrix(gcc, sparse = FALSE))
  n    <- nrow(Y)
  
  resultados <- list(gobierno = nombre_gov, n = n)
  
  # ---- M1: SBM via Louvain ----
  cat("  [M1] Modelo de bloques estocasticos (Louvain)...\n")
  set.seed(123)
  com_louvain <- cluster_louvain(gcc)
  resultados$sbm_membresia   <- com_louvain$membership
  resultados$sbm_modularidad <- modularity(com_louvain)
  resultados$sbm_K           <- max(com_louvain$membership)
  cat("    Bloques detectados:", resultados$sbm_K,
      "| Modularidad:", round(resultados$sbm_modularidad, 4), "\n")
  
  # ---- M2: ERGM (condicional) ----
  if (ergm_disponible) {
    cat("  [M2] Modelo ERGM...\n")
    net_gcc  <- igraph_a_network(gcc)
    gen_vals <- V(gcc)$genero
    par_vals <- V(gcc)$partido
    
    formula_ergm <- tryCatch({
      if (length(unique(gen_vals[!is.na(gen_vals)])) > 1 &&
          length(unique(par_vals[!is.na(par_vals)])) > 1) {
        net_gcc %v% "genero"  <- gen_vals
        net_gcc %v% "partido" <- par_vals
        ergm(net_gcc ~ edges + nodematch("genero") + nodematch("partido"),
             control = control.ergm(seed = 123, MCMC.samplesize = 1000,
                                     MCMLE.maxit = 20))
      } else if (length(unique(gen_vals[!is.na(gen_vals)])) > 1) {
        net_gcc %v% "genero" <- gen_vals
        ergm(net_gcc ~ edges + nodematch("genero"),
             control = control.ergm(seed = 123, MCMC.samplesize = 1000,
                                     MCMLE.maxit = 20))
      } else {
        ergm(net_gcc ~ edges,
             control = control.ergm(seed = 123, MCMC.samplesize = 1000,
                                     MCMLE.maxit = 20))
      }
    }, error = function(e) {
      cat("    ERGM: advertencia -", conditionMessage(e), "\n")
      NULL
    })
    resultados$ergm_fit <- formula_ergm
  } else {
    cat("  [M2] ERGM omitido (ergm/statnet no instalado).\n")
    resultados$ergm_fit <- NULL
  }
  
  # ---- M3: Sociabilidad ----
  cat("  [M3] Modelo de sociabilidad (Gibbs)...\n")
  set.seed(123)
  samples <- gibbs_sociabilidad(Y,
                                 n_iter = n_iter_gibbs,
                                 n_burn = n_burn_gibbs,
                                 n_thin = n_thin_gibbs)
  resultados$sociabilidad_samples <- samples
  cat("    Muestras obtenidas:", length(samples$mu), "\n")
  
  resultados$gcc <- gcc
  resultados$Y   <- Y
  return(resultados)
}
# Ajuste para Petro (cache=TRUE para no re-correr en cada knit)
res_petro <- ajustar_modelos(red_petro$grafo, "Petro",
                               n_iter_gibbs = 3000, n_burn_gibbs = 500)
## 
## ========================================
##  Ajustando modelos para: Petro 
## ========================================
##   [M1] Modelo de bloques estocasticos (Louvain)...
##     Bloques detectados: 7 | Modularidad: 0.5607 
##   [M2] ERGM omitido (ergm/statnet no instalado).
##   [M3] Modelo de sociabilidad (Gibbs)...
##     Muestras obtenidas: 500
res_duque <- ajustar_modelos(red_duque$grafo, "Duque",
                               n_iter_gibbs = 3000, n_burn_gibbs = 500)
## 
## ========================================
##  Ajustando modelos para: Duque 
## ========================================
##   [M1] Modelo de bloques estocasticos (Louvain)...
##     Bloques detectados: 5 | Modularidad: 0.5199 
##   [M2] ERGM omitido (ergm/statnet no instalado).
##   [M3] Modelo de sociabilidad (Gibbs)...
##     Muestras obtenidas: 500
res_santos <- ajustar_modelos(red_santos$grafo, "Santos",
                                n_iter_gibbs = 3000, n_burn_gibbs = 500)
## 
## ========================================
##  Ajustando modelos para: Santos 
## ========================================
##   [M1] Modelo de bloques estocasticos (Louvain)...
##     Bloques detectados: 6 | Modularidad: 0.5794 
##   [M2] ERGM omitido (ergm/statnet no instalado).
##   [M3] Modelo de sociabilidad (Gibbs)...
##     Muestras obtenidas: 500
res_uribe <- ajustar_modelos(red_uribe$grafo, "Uribe",
                               n_iter_gibbs = 3000, n_burn_gibbs = 500)
## 
## ========================================
##  Ajustando modelos para: Uribe 
## ========================================
##   [M1] Modelo de bloques estocasticos (Louvain)...
##     Bloques detectados: 4 | Modularidad: 0.5171 
##   [M2] ERGM omitido (ergm/statnet no instalado).
##   [M3] Modelo de sociabilidad (Gibbs)...
##     Muestras obtenidas: 500

7.4 Resultados del SBM — Visualizaciones

vis_sbm <- function(res) {
  g   <- res$gcc
  mem <- res$sbm_membresia
  K   <- res$sbm_K
  pal_sbm <- colorRampPalette(c("#3d0f28","#70284a","#9b6b8a",
                                  "#c9a8c0","#5c1a35","#e8d5e0"))(K)
  set.seed(42)
  lay <- layout_with_fr(g)
  d   <- degree(g)
  plot(g,
       layout            = lay,
       vertex.size       = 2 + 7 * (d / max(d)),
       vertex.color      = pal_sbm[mem],
       vertex.frame.color = "#3d0f28",
       vertex.label      = ifelse(d >= quantile(d, 0.90), V(g)$name, NA),
       vertex.label.cex  = 0.5,
       vertex.label.color = "black",
       edge.color        = adjustcolor("#9b6b8a", 0.3),
       edge.width        = 0.4,
       main = paste0("SBM — ", res$gobierno,
                     " (K=", K, ", Mod=",
                     round(res$sbm_modularidad, 3), ")"))
}

vis_sbm(res_petro)

vis_sbm(res_duque)

vis_sbm(res_santos)

vis_sbm(res_uribe)

7.5 Resultados del ERGM

mostrar_ergm <- function(res) {
  if (!is.null(res$ergm_fit)) {
    cat("\n--- ERGM:", res$gobierno, "---\n")
    print(summary(res$ergm_fit))
  } else {
    cat("\nERGM no disponible para:", res$gobierno, "\n")
  }
}

mostrar_ergm(res_petro)
## 
## ERGM no disponible para: Petro
mostrar_ergm(res_duque)
## 
## ERGM no disponible para: Duque
mostrar_ergm(res_santos)
## 
## ERGM no disponible para: Santos
mostrar_ergm(res_uribe)
## 
## ERGM no disponible para: Uribe

7.6 Inferencia del modelo de sociabilidad

inferencia_sociabilidad <- function(res) {
  s  <- res$sociabilidad_samples
  n  <- res$n
  gov <- res$gobierno
  
  # Estadisticos de mu
  mu_res <- c(
    Media    = mean(s$mu),
    Mediana  = median(s$mu),
    IC95_L   = quantile(s$mu, 0.025),
    IC95_U   = quantile(s$mu, 0.975)
  )
  
  # Estadisticos de tau2
  tau_res <- c(
    Media    = mean(s$tau2),
    Mediana  = median(s$tau2),
    IC95_L   = quantile(s$tau2, 0.025),
    IC95_U   = quantile(s$tau2, 0.975)
  )
  
  df <- rbind(mu_res, tau_res)
  rownames(df) <- c("mu (conectividad global)", "tau^2 (heterogeneidad)")
  
  kable(round(df, 4),
        caption = paste("Inferencia posterior del modelo de sociabilidad —", gov),
        col.names = c("Media", "Mediana", "IC95 Inf.", "IC95 Sup.")) %>%
    kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
    row_spec(0, background = "#70284a", color = "white")
}

inferencia_sociabilidad(res_petro)
Inferencia posterior del modelo de sociabilidad — Petro
Media Mediana IC95 Inf. IC95 Sup.
mu (conectividad global) -1.2805 -1.2702 -1.5553 -1.0493
tau^2 (heterogeneidad) 0.1489 0.1443 0.0953 0.2281 
inferencia_sociabilidad(res_duque)
Inferencia posterior del modelo de sociabilidad — Duque
Media Mediana IC95 Inf. IC95 Sup.
mu (conectividad global) -1.0465 -1.0374 -1.4554 -0.678
tau^2 (heterogeneidad) 0.1884 0.1773 0.0994 0.355 
inferencia_sociabilidad(res_santos)
Inferencia posterior del modelo de sociabilidad — Santos
Media Mediana IC95 Inf. IC95 Sup.
mu (conectividad global) -1.3109 -1.3088 -1.4821 -1.1418
tau^2 (heterogeneidad) 0.1106 0.1076 0.0725 0.1678 
inferencia_sociabilidad(res_uribe)
Inferencia posterior del modelo de sociabilidad — Uribe
Media Mediana IC95 Inf. IC95 Sup.
mu (conectividad global) -1.0799 -1.0832 -1.3803 -0.7764
tau^2 (heterogeneidad) 0.1753 0.1669 0.0984 0.2892 
# Visualizacion de efectos de sociabilidad delta
vis_delta <- function(res, top_n = 20) {
  s     <- res$sociabilidad_samples
  gcc   <- res$gcc
  n     <- res$n
  gov   <- res$gobierno
  
  delta_mean <- colMeans(s$delta)
  delta_ci   <- apply(s$delta, 2, quantile, probs = c(0.025, 0.975))
  
  df <- data.frame(
    nodo  = 1:n,
    media = delta_mean,
    lwr   = delta_ci[1, ],
    upr   = delta_ci[2, ],
    nombre = V(gcc)$name
  ) %>%
    arrange(desc(media)) %>%
    head(top_n)
  
  df$nombre_corto <- sapply(strsplit(df$nombre, " "),
                              function(x) paste(x[1], x[2], sep = " "))
  
  ggplot(df, aes(x = reorder(nombre_corto, media), y = media)) +
    geom_linerange(aes(ymin = lwr, ymax = upr), color = "#c9a8c0", linewidth = 1) +
    geom_point(color = "#70284a", size = 2.5) +
    coord_flip() +
    labs(title    = paste("Top", top_n, "sociabilidades (delta) —", gov),
         subtitle = "Media posterior con IC al 95%",
         x = NULL, y = expression(delta[i])) +
    theme_minimal(base_size = 11) +
    theme(plot.title = element_text(face = "bold"))
}

vis_delta(res_petro,  20)

vis_delta(res_duque,  20)

vis_delta(res_santos, 20)

vis_delta(res_uribe,  20)

8 Bondad de ajuste

Se evalua la bondad de ajuste de los tres modelos usando como estadisticos de prueba la densidad, la transitividad, la asortatividad y la distancia geodesica promedio (Sosa, 2024; Hunter et al., 2008). Para el SBM se simulan redes del modelo de Erdos-Renyi con las probabilidades intra e inter bloque estimadas. Para el ERGM se usa la funcion gof de ergm. Para el modelo de sociabilidad se usan las muestras posteriores.

# GOF para el modelo de sociabilidad
gof_sociabilidad <- function(res, n_sim = 200) {
  s   <- res$sociabilidad_samples
  gcc <- res$gcc
  n   <- res$n
  
  # Estadisticos observados
  obs <- c(
    densidad      = edge_density(gcc),
    transitividad = transitivity(gcc, type = "global"),
    asortatividad = assortativity_degree(gcc, directed = FALSE),
    dist_geo      = mean_distance(gcc, directed = FALSE)
  )
  
  # Estadisticos simulados
  n_samples <- length(s$mu)
  idx_sim   <- sample(1:n_samples, min(n_sim, n_samples))
  
  sim_stats <- matrix(NA, length(idx_sim), 4,
                       dimnames = list(NULL, names(obs)))
  
  for (k in seq_along(idx_sim)) {
    mu_k    <- s$mu[idx_sim[k]]
    delta_k <- s$delta[idx_sim[k], ]
    P_k     <- pnorm(mu_k + outer(delta_k, delta_k, "+"))
    Y_sim   <- matrix(rbinom(n*n, 1, as.vector(P_k)), n, n)
    Y_sim   <- (Y_sim + t(Y_sim) > 0) * 1
    diag(Y_sim) <- 0
    g_sim <- graph_from_adjacency_matrix(Y_sim, mode = "undirected")
    sim_stats[k, "densidad"]      <- edge_density(g_sim)
    sim_stats[k, "transitividad"] <- transitivity(g_sim, type = "global")
    sim_stats[k, "asortatividad"] <- tryCatch(
      assortativity_degree(g_sim, directed = FALSE), error = function(e) NA)
    sim_stats[k, "dist_geo"]      <- tryCatch(
      mean_distance(g_sim, directed = FALSE), error = function(e) NA)
  }
  
  list(obs = obs, sim = sim_stats)
}
gof_p <- gof_sociabilidad(res_petro,  n_sim = 200)
gof_d <- gof_sociabilidad(res_duque,  n_sim = 200)
gof_s <- gof_sociabilidad(res_santos, n_sim = 200)
gof_u <- gof_sociabilidad(res_uribe,  n_sim = 200)
# Tabla resumen de GOF
tabla_gof <- function(gof, nombre) {
  obs <- gof$obs
  sim <- gof$sim
  
  data.frame(
    Estadistico = names(obs),
    Observado   = round(obs, 4),
    Media_sim   = round(colMeans(sim, na.rm = TRUE), 4),
    IC95_L      = round(apply(sim, 2, quantile, 0.025, na.rm = TRUE), 4),
    IC95_U      = round(apply(sim, 2, quantile, 0.975, na.rm = TRUE), 4),
    Gobierno    = nombre
  )
}

gof_todos <- bind_rows(
  tabla_gof(gof_p, "Petro"),
  tabla_gof(gof_d, "Duque"),
  tabla_gof(gof_s, "Santos"),
  tabla_gof(gof_u, "Uribe")
)

kable(gof_todos,
      caption   = "Bondad de ajuste del modelo de sociabilidad — comparacion por gobierno",
      col.names = c("Estadistico","Obs.","Media sim.","IC95 inf.","IC95 sup.","Gobierno"),
      align     = c("l","r","r","r","r","l")) %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white") %>%
  row_spec(c(1:4),   background = "#f9f5fb") %>%
  row_spec(c(5:8),   background = "#ffffff") %>%
  row_spec(c(9:12),  background = "#f9f5fb") %>%
  row_spec(c(13:16), background = "#ffffff")
Bondad de ajuste del modelo de sociabilidad — comparacion por gobierno
Estadistico Obs. Media sim. IC95 inf. IC95 sup. Gobierno
densidad…1 densidad 0.1206 0.2231 0.1879 0.2608 Petro
transitividad…2 transitividad 0.6406 0.3116 0.2503 0.3737 Petro
asortatividad…3 asortatividad 0.1912 -0.1440 -0.2231 -0.0339 Petro
dist_geo…4 dist_geo 2.9140 1.8891 1.7925 2.0117 Petro
densidad…5 densidad 0.1631 0.2980 0.2276 0.3723 Duque
transitividad…6 transitividad 0.5864 0.3796 0.2777 0.4773 Duque
asortatividad…7 asortatividad 0.1557 -0.1673 -0.2980 -0.0200 Duque
dist_geo…8 dist_geo 2.9877 1.8057 1.6585 1.9847 Duque
densidad…9 densidad 0.1076 0.2004 0.1723 0.2252 Santos
transitividad…10 transitividad 0.6176 0.2696 0.2306 0.3102 Santos
asortatividad…11 asortatividad 0.0934 -0.1062 -0.1714 -0.0337 Santos
dist_geo…12 dist_geo 2.9186 1.8919 1.8254 1.9695 Santos
densidad…13 densidad 0.1547 0.2784 0.2312 0.3288 Uribe
transitividad…14 transitividad 0.6244 0.3741 0.2982 0.4335 Uribe
asortatividad…15 asortatividad -0.0114 -0.1682 -0.2753 -0.0479 Uribe
dist_geo…16 dist_geo 2.8498 1.7966 1.6937 1.9101 Uribe 
# Histogramas de distribuciones predictivas posteriores
gof_vis <- function(gof, nombre) {
  obs <- gof$obs
  sim <- as.data.frame(gof$sim)
  
  df_long <- tidyr::pivot_longer(sim, everything(),
                                   names_to = "Estadistico",
                                   values_to = "Valor")
  df_obs <- data.frame(Estadistico = names(obs),
                        Valor       = as.numeric(obs))
  
  ggplot(df_long, aes(x = Valor)) +
    geom_histogram(fill = "#9b6b8a", color = "white", bins = 25, alpha = 0.8) +
    geom_vline(data = df_obs, aes(xintercept = Valor),
               color = "#3d0f28", linewidth = 1.2, linetype = "dashed") +
    facet_wrap(~ Estadistico, scales = "free", ncol = 2) +
    labs(title    = paste("Distribucion predictiva posterior —", nombre),
         subtitle = "Linea discontinua: valor observado",
         x = "Valor", y = "Frecuencia") +
    theme_minimal(base_size = 11) +
    theme(strip.background = element_rect(fill = "#70284a"),
          strip.text       = element_text(color = "white", face = "bold"))
}

gof_vis(gof_p, "Petro")

gof_vis(gof_d, "Duque")

gof_vis(gof_s, "Santos")

gof_vis(gof_u, "Uribe")

Bondad de ajuste. El modelo de sociabilidad captura bien la densidad de la red en todos los gobiernos, dado que el valor observado cae dentro del intervalo de credibilidad al 95% de la distribucion predictiva posterior. La transitividad es el estadistico mas dificil de reproducir para este modelo, lo que era de esperar: el modelo de sociabilidad no incluye efectos de triangulos. La asortatividad y la distancia geodesica promedio se ajustan razonablemente. Para modelos con mejor ajuste en transitividad, seria recomendable explorar el ERGM con el termino gwesp (Robins et al., 1999).

9 Red completa — Analisis sin filtro de gobierno

Se repite el analisis anterior sin filtrar por gobierno, construyendo la red de co-membresía para la totalidad de los 265 funcionarios registrados.

# Para la red completa se incluyen todos los funcionarios con GOBERNACION no vacia
# Se usa un patron que coincide con todos los gobiernos conocidos, evitando NAs
red_total <- construir_red_gobierno(datos, "PETRO|DUQUE|SANTOS|URIBE",
                                     col_entidades)

cat("Red completa — Orden:", red_total$n,
    "| Aristas:", ecount(red_total$grafo), "\n")
## Red completa — Orden: 265 | Aristas: 2028
g_tot <- red_total$grafo
d_tot <- degree(g_tot)
col_tot <- color_genero(V(g_tot)$genero)

set.seed(42)
lay_tot <- layout_with_fr(g_tot)

plot(g_tot,
     layout            = lay_tot,
     vertex.size       = 1.5 + 5 * (d_tot / max(d_tot)),
     vertex.color      = col_tot,
     vertex.frame.color = "#3d0f28",
     vertex.label      = ifelse(d_tot >= quantile(d_tot, 0.95),
                                 V(g_tot)$name, NA),
     vertex.label.cex  = 0.45,
     vertex.label.color = "black",
     edge.color        = adjustcolor("#9b6b8a", 0.2),
     edge.width        = 0.3,
     main              = "Red de poder — Todos los gobiernos")
legend("bottomleft",
       legend = c("Masculino", "Femenino"),
       col    = c("#70284a", "#c9a8c0"),
       pch    = 21, pt.bg = c("#70284a", "#c9a8c0"),
       bty    = "n", cex = 0.85)

met_total <- metricas_red(red_total$grafo, "Total")
kable(t(met_total),
      caption = "Metricas estructurales — Red completa",
      align   = "r") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white") %>%
  column_spec(1, bold = TRUE)
Metricas estructurales — Red completa
Gobierno Total
Orden 265
Tamano 2028
N_componentes 3
Tamano_GCC 263
Densidad 0.058
Transitividad_global 0.66
Transitividad_local 0.8775
Distancia_geodesica 3.0151
Diametro 7
Asortatividad_grado 0.1725
Grado_promedio 15.306 
top_total <- calcular_centralidad(red_total$grafo, "Total", top_n = 15)
presentar_top(top_total, "Top 15 funcionarios mas centrales — Red completa")
Top 15 funcionarios mas centrales — Red completa
Funcionario Grado norm. Cercania Intermediacion Vector propio
MAURICIO CARDENAS SANTAMARIA 0.2443 0.4662 0.1027 0.5635
CARLOS HOLMES TRUJILLO GARCIA 0.1908 0.4746 0.1762 0.6344
GERMAN VARGAS LLERAS 0.1870 0.4816 0.1082 1.0000
MARTA LUCIA RAMIREZ BLANCO 0.1832 0.4755 0.1043 0.4946
JUAN MANUEL SANTOS CALDERON 0.1679 0.4302 0.0734 0.3778
OSCAR MAURICIO LIZCANO ARANGO 0.1527 0.4043 0.0834 0.7735
FEDERICO ALONSO RENJIFO VELEZ 0.1527 0.4456 0.0436 0.6153
JOSE ANTONIO OCAMPO GAVIRIA 0.1450 0.4253 0.0301 0.3268
JUAN CAMILO RESTREPO SALAZAR 0.1450 0.4062 0.0196 0.3088
ALEXANDER LOPEZ MAYA 0.1450 0.4281 0.0418 0.8632
ARMANDO ALBERTO BENEDETTI VILLANEDA 0.1412 0.4338 0.0195 0.9440
JUAN FERNANDO CRISTO BUSTOS 0.1298 0.4274 0.0108 0.9278
LUIS FERNANDO VELASCO CHAVES 0.1298 0.4274 0.0108 0.9278
CLAUDIA BLUM CAPURRO DE BARBERI 0.1298 0.4418 0.0330 0.8460
NANCY PATRICIA GUTIERREZ CASTANEDA 0.1298 0.4274 0.0108 0.9278 
# Red total: puede tener muchos nodos, se usan menos iteraciones
res_total <- ajustar_modelos(red_total$grafo, "Total",
                               n_iter_gibbs = 2000, n_burn_gibbs = 500)
## 
## ========================================
##  Ajustando modelos para: Total 
## ========================================
##   [M1] Modelo de bloques estocasticos (Louvain)...
##     Bloques detectados: 13 | Modularidad: 0.6744 
##   [M2] ERGM omitido (ergm/statnet no instalado).
##   [M3] Modelo de sociabilidad (Gibbs)...
##     Muestras obtenidas: 300
gof_total <- gof_sociabilidad(res_total, n_sim = 100)
kable(tabla_gof(gof_total, "Total") %>% select(-Gobierno),
      caption = "Bondad de ajuste — Red completa",
      col.names = c("Estadistico","Obs.","Media sim.","IC95 inf.","IC95 sup.")) %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
  row_spec(0, background = "#70284a", color = "white")
Bondad de ajuste — Red completa
Estadistico Obs. Media sim. IC95 inf. IC95 sup.
densidad densidad 0.0589 0.1118 0.1058 0.1176
transitividad transitividad 0.6600 0.1611 0.1498 0.1736
asortatividad asortatividad 0.1725 -0.0689 -0.0914 -0.0500
dist_geo dist_geo 3.0151 1.9550 1.9368 1.9759 
gof_vis(gof_total, "Red completa — Todos los gobiernos")

Red completa. La red que agrupa a todos los gobiernos es la mas densa y conectada. Los funcionarios que aparecen como hubs en la red total son aquellos que participaron en mas de un gobierno, funcionando como puentes entre periodos: este tipo de continuidad burocratica es un rasgo estructural del Estado colombiano que trasciende a las administraciones. La alta transitividad global de la red total refleja la existencia de circulos de poder relativamente cerrados que se reproducen a traves del tiempo, independientemente de la orientacion politica del gobierno de turno (Chala, 2024).

10 Referencias

  • Chala, O. A. (2024). Estos son los grupos politicos que sostienen al gobierno Petro y sus puntos de tension. Fundacion Paz y Reconciliacion (Pares). Diciembre 1 de 2024.
  • Fruchterman, T. M. J., & Reingold, E. M. (1991). Graph drawing by force-directed placement. Software: Practice and Experience, 21(11), 1129–1164.
  • Hunter, D. R., Goodreau, S. M., & Handcock, M. S. (2008). Goodness of fit of social network models. Journal of the American Statistical Association, 103(481), 248–258.
  • Luke, D. A. (2015). A User’s Guide to Network Analysis in R. Springer.
  • Newman, M. E. J. (2010). Networks: An Introduction. Oxford University Press.
  • Robins, G., Pattison, P., & Wasserman, S. (1999). Logit models and logistic regressions for social networks. Psychometrika, 64(3), 371–394.
  • Sosa, J. (2024). Notas de clase: Analisis Estadistico de Redes. Departamento de Estadistica, Universidad Nacional de Colombia.
  • Sosa, J., & Martinez, A. (2026). A sociability model for networks. Journal of Computational and Graphical Statistics. https://doi.org/10.1080/10618600.2026.2627454