A continuación se presenta el desarrollo del taller correspondiente a la asignatura Análisis Estadístico de Redes, perteneciente a la Maestría en Ciencias – Estadística.

Presentado por:
Estudiante: Helen Granados Rodríguez  |  CC: 1000835249  |  Correo: hgranados@unal.edu.co


1 Ejercicio 1 — Propiedades del grado y la media global

1.1 1.a Demostración: en redes no dirigidas \(d_i^{out} = d_i^{in}\)

Demostración:

Sea \(\mathbf{Y} = [y_{i,j}]\) la matriz de adyacencia. Por definición:

\[d_i^{out} = \sum_{j: j \neq i} y_{i,j}, \qquad d_i^{in} = \sum_{j: j \neq i} y_{j,i}\]

Si la red es no dirigida, la matriz de adyacencia es simétrica, es decir, \(y_{i,j} = y_{j,i}\) para todo par \((i,j)\). Por tanto:

\[d_i^{out} = \sum_{j: j \neq i} y_{i,j} = \sum_{j: j \neq i} y_{j,i} = d_i^{in}\]

\(\blacksquare\)

1.2 1.b Demostración: la media global coincide con la media de los triángulos superior e inferior

Demostración:

La media global se define como:

\[\bar{y} = \frac{1}{n(n-1)} \sum_{i,j: i \neq j} y_{i,j}\]

La suma total sobre pares \(i \neq j\) puede descomponerse en la parte estrictamente superior y la estrictamente inferior de \(\mathbf{Y}\):

\[\sum_{i,j: i \neq j} y_{i,j} = \sum_{i < j} y_{i,j} + \sum_{i > j} y_{i,j}\]

Como la red es no dirigida, \(y_{i,j} = y_{j,i}\), entonces \(\sum_{i<j} y_{i,j} = \sum_{i>j} y_{i,j}\). El número de pares con \(i < j\) es \(\binom{n}{2} = n(n-1)/2\).

La media de la parte triangular superior es:

\[\bar{y}^{sup} = \frac{\sum_{i < j} y_{i,j}}{n(n-1)/2}\]

Así:

\[\bar{y} = \frac{\sum_{i<j} y_{i,j} + \sum_{i>j} y_{i,j}}{n(n-1)} = \frac{2\sum_{i<j} y_{i,j}}{n(n-1)} = \frac{\sum_{i<j} y_{i,j}}{n(n-1)/2} = \bar{y}^{sup}\]

Por simetría, lo mismo vale para el triángulo inferior. \(\blacksquare\)

1.3 1.c Demostración: la media global es igual a la densidad

Demostración (red no dirigida):

El número de aristas observadas es \(|E| = \sum_{i < j} y_{i,j}\). El potencial de aristas es \(\binom{n}{2} = n(n-1)/2\). La densidad se define como:

\[\text{den}(G) = \frac{|E|}{n(n-1)/2} = \frac{\sum_{i<j} y_{i,j}}{n(n-1)/2} = \frac{2\sum_{i<j} y_{i,j}}{n(n-1)} = \bar{y}\]

Para redes dirigidas: el potencial es \(n(n-1)\) y \(|E| = \sum_{i \neq j} y_{i,j}\), por lo que:

\[\text{den}(G) = \frac{\sum_{i \neq j} y_{i,j}}{n(n-1)} = \bar{y} \qquad \blacksquare\]

1.4 1.d Demostración: \((n-1)\bar{y} = \bar{d}^{out} = \bar{d}^{in}\)

Demostración:

El grado promedio de salida es:

\[\bar{d}^{out} = \frac{1}{n} \sum_{i=1}^n d_i^{out} = \frac{1}{n} \sum_{i=1}^n \sum_{j: j \neq i} y_{i,j} = \frac{1}{n} \sum_{i,j: i\neq j} y_{i,j} = \frac{n(n-1)}{n} \cdot \bar{y} = (n-1)\bar{y}\]

Análogamente \(\bar{d}^{in} = (n-1)\bar{y}\). Por el resultado del numeral (a), en redes no dirigidas \(d_i^{out} = d_i^{in}\), así que \(\bar{d}^{out} = \bar{d}^{in} = (n-1)\bar{y}\). \(\blacksquare\)

1.5 1.e Grado promedio del grafo círculo de orden \(n\)

Demostración:

En un grafo círculo de orden \(n\), cada vértice tiene exactamente 2 vecinos (el anterior y el siguiente en el ciclo). Por tanto, \(d_i = 2\) para todo \(i\). El grado promedio es:

\[\bar{d} = \frac{1}{n} \sum_{i=1}^n d_i = \frac{1}{n} \cdot 2n = 2 \qquad \blacksquare\]

1.6 1.f Grado promedio del grafo estrella de orden \(n\)

Demostración:

En un grafo estrella de orden \(n\) hay un nodo central con grado \(n-1\) y \(n-1\) nodos hoja con grado \(1\). El grado promedio es:

\[\bar{d} = \frac{(n-1) + (n-1) \cdot 1}{n} = \frac{2(n-1)}{n} = 2\frac{n-1}{n}\]

Cuando \(n \to \infty\): \(\displaystyle\lim_{n\to\infty} 2\frac{n-1}{n} = 2\). \(\blacksquare\)

# Verificación numérica con n = 9
n <- 9

# Grafo estrella
g_star <- make_star(n, mode = "undirected")

# Grafo círculo
g_circle <- make_ring(n)

# Grados promedio
cat("Grado promedio grafo estrella (n=9):", mean(degree(g_star)), "\n")
## Grado promedio grafo estrella (n=9): 1.777778
cat("Valor teórico 2(n-1)/n:", 2*(n-1)/n, "\n\n")
## Valor teórico 2(n-1)/n: 1.777778
cat("Grado promedio grafo círculo (n=9):", mean(degree(g_circle)), "\n")
## Grado promedio grafo círculo (n=9): 2
# Visualización
par(mfrow = c(1, 2), mar = c(2, 2, 3, 2))

set.seed(42)
plot(g_star,
     layout      = layout_as_star,
     vertex.size = 18,
     vertex.color = c("tomato", rep("steelblue", n-1)),
     vertex.label.color = "white",
     vertex.frame.color = "gray30",
     edge.color  = "gray50",
     main        = paste0("Grafo estrella (n=", n, ")"))

plot(g_circle,
     layout      = layout_in_circle,
     vertex.size = 18,
     vertex.color = "steelblue",
     vertex.label.color = "white",
     vertex.frame.color = "gray30",
     edge.color  = "gray50",
     main        = paste0("Grafo círculo (n=", n, ")"))


2 Ejercicio 2 — Caminatas, senderos, circuitos y ciclos

El grafo tiene vértices \(\{1, 2, 3, 4, 5, 6\}\) y aristas leídas de la imagen: \(\{1-2,\, 1-4,\, 1-5,\, 1-6,\, 3-6,\, 3-4\}\).

# Construcción del grafo según la imagen
g2 <- graph_from_literal(
  `1` - `2`,
  `1` - `4`,
  `1` - `5`,
  `1` - `6`,
  `3` - `6`,
  `3` - `4`
)

set.seed(7)
coords <- layout_with_kk(g2)
plot(g2,
     layout             = coords,
     vertex.size        = 22,
     vertex.color       = "lightyellow",
     vertex.frame.color = "gray30",
     vertex.label.color = "black",
     vertex.label.cex   = 1.2,
     edge.color         = "gray40",
     edge.width         = 2,
     main               = "Grafo Ejercicio 2")

2.1 Análisis de las secuencias

Definiciones clave (según las notas de clase):

  • Caminata: sucesión de vértices consecutivamente adyacentes (pueden repetirse vértices y aristas).
  • Sendero (recorrido/trail): caminata sin aristas repetidas (los vértices sí pueden repetirse).
  • Circuito: caminata cerrada sin aristas repetidas (el primer y último vértice coinciden).
  • Ciclo: caminata cerrada sin vértices repetidos (excepto el inicio = fin).

Aristas del grafo: \(\{1-2,\, 1-4,\, 1-5,\, 1-6,\, 3-6,\, 3-4\}\)


Secuencia a: \(2 - 1 - 6 - 3 - 4\)

  • Verificación de adyacencias: \(2\sim1\) ✓, \(1\sim6\) ✓, \(6\sim3\) ✓, \(3\sim4\) ✓.
  • No se repiten vértices ni aristas; es una caminata abierta.
  • Resultado: Es caminata, sendero y camino (no hay repetición de nada).

Secuencia b: \(2 - 1 - 6 - 3 - 4 - 1 - 5\)

  • Adyacencias: \(2\sim1\) ✓, \(1\sim6\) ✓, \(6\sim3\) ✓, \(3\sim4\) ✓, \(4\sim1\) ✓, \(1\sim5\) ✓.
  • El vértice \(1\) aparece dos veces; ninguna arista se repite.
  • Resultado: Es caminata y sendero, pero NO camino (el vértice 1 se repite). No es circuito ni ciclo (no es cerrada).

Secuencia c: \(2 - 1 - 2 - 5 - 1 - 4\)

  • Adyacencias: \(2\sim1\) ✓, \(1\sim2\) ✓, \(2\sim5\) — la arista \(\{2,5\}\) NO existe en el grafo.
  • Resultado: No es caminata (no todas las adyacencias son válidas), por tanto tampoco es sendero, circuito ni ciclo.
Tabla 1. Clasificación de las secuencias en el grafo
Secuencia Caminata Sendero Camino Circuito Ciclo Razón
2−1−6−3−4 Sin repeticiones
2−1−6−3−4−1−5 Vértice 1 repetido
2−1−2−5−1−4 Arista {2,5} inexistente

3 Ejercicio 3 — Red de comercio internacional (comtrade)

# Carga del conjunto de datos
load("comtrade.RData")

# Dimensiones
cat("Dimensiones del arreglo comtrade:\n")
## Dimensiones del arreglo comtrade:
print(dim(comtrade))
## [1] 30 30  6 10
# Construcción de la matriz de adyacencia Y
# Se promedian las dimensiones 5 y 6 (bienes manufacturados) a lo largo de los años
Y <- apply(X = comtrade[, , c(5, 6), ], MARGIN = c(1, 2), FUN = mean)

n   <- nrow(Y)
paises <- rownames(Y)
cat("\nDimensión de Y:", dim(Y), "\n")
## 
## Dimensión de Y: 30 30

3.1 3.a Media global \(\bar{y}\)

La media global es el promedio de todos los elementos fuera de la diagonal de \(\mathbf{Y}\). Según las notas, coincide con la densidad de la red y mide la plausibilidad promedio de observar una relación entre dos nodos cualesquiera.

# Media global: promedio de todas las entradas i≠j
y_bar <- mean(Y[row(Y) != col(Y)])
cat("Media global (bar_y):", round(y_bar, 4), "\n")
## Media global (bar_y): 0.0378

Interpretación: El crecimiento medio del comercio en bienes manufacturados entre cualquier par de países, a lo largo de los 10 años analizados, es 0.0378 (en escala logarítmica respecto al año 2000). Un valor positivo indica crecimiento promedio neto en el comercio internacional de estos bienes.

3.2 3.b Promedios fila \(\bar{y}_{i\bullet}\) — Sociabilidad

Los promedios fila miden cuánto exporta (o envía) en promedio el país \(i\) hacia los demás. Caracterizan la sociabilidad del nodo.

# Promedio fila: excluir diagonal
diag_save <- diag(Y)  # guardar diagonal
diag(Y)   <- NA
y_fila    <- rowMeans(Y, na.rm = TRUE)
diag(Y)   <- diag_save  # restaurar

# Histograma
hist(y_fila,
     main   = expression("Distribución de promedios fila " * bar(y)[i*"•"]),
     xlab   = "Promedio fila",
     ylab   = "Frecuencia",
     col    = "steelblue",
     border = "white",
     breaks = 10)
abline(v = mean(y_fila), col = "tomato", lwd = 2, lty = 2)
legend("topright", legend = paste("Media =", round(mean(y_fila), 3)),
       col = "tomato", lty = 2, lwd = 2)

# Top 5 exportadores
top5_soc <- sort(y_fila, decreasing = TRUE)[1:5]
knitr::kable(
  data.frame(País = names(top5_soc), `Promedio fila` = round(top5_soc, 3),
             check.names = FALSE),
  caption  = "Tabla 2. Top 5 países con mayor sociabilidad (promedio fila)",
  align    = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 2. Top 5 países con mayor sociabilidad (promedio fila)
País Promedio fila
China 0.148
Turkey 0.101
Czech Rep.  0.094
Thailand 0.055
Malaysia 0.050

Interpretación: Los promedios fila \(\bar{y}_{i\bullet}\) cuantifican la sociabilidad de cada nodo, es decir, la intensidad promedio con la que el país \(i\) inicia relaciones comerciales en bienes manufacturados hacia los demás. Países con valores altos son exportadores activos en este período.

3.3 3.c Promedios columna \(\bar{y}_{\bullet j}\) — Popularidad

Los promedios columna miden cuánto recibe en promedio el país \(j\) desde los demás. Caracterizan la popularidad del nodo.

# Promedio columna: excluir diagonal
diag(Y) <- NA
y_col   <- colMeans(Y, na.rm = TRUE)
diag(Y) <- diag_save

# Histograma
hist(y_col,
     main   = expression("Distribución de promedios columna " * bar(y)["•j"]),
     xlab   = "Promedio columna",
     ylab   = "Frecuencia",
     col    = "darkorange",
     border = "white",
     breaks = 10)
abline(v = mean(y_col), col = "navy", lwd = 2, lty = 2)
legend("topright", legend = paste("Media =", round(mean(y_col), 3)),
       col = "navy", lty = 2, lwd = 2)

# Top 5 importadores
top5_pop <- sort(y_col, decreasing = TRUE)[1:5]
knitr::kable(
  data.frame(País = names(top5_pop), `Promedio columna` = round(top5_pop, 3),
             check.names = FALSE),
  caption  = "Tabla 3. Top 5 países con mayor popularidad (promedio columna)",
  align    = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 3. Top 5 países con mayor popularidad (promedio columna)
País Promedio columna
China 0.146
Mexico 0.142
Turkey 0.111
Czech Rep.  0.101
Spain 0.074

Interpretación: Los promedios columna \(\bar{y}_{\bullet j}\) miden la popularidad de cada nodo, es decir, la intensidad promedio con la que el país \(j\) recibe relaciones comerciales desde los demás. Países con valores altos son importadores destacados en bienes manufacturados.

3.4 3.d Tendencia local: medias de \(\bar{y}_{i\bullet}\) y \(\bar{y}_{\bullet j}\)

media_fila <- mean(y_fila)
media_col  <- mean(y_col)

tend <- data.frame(
  Estadístico     = c("Media de promedios fila (sociabilidad)",
                      "Media de promedios columna (popularidad)",
                      "Media global"),
  Valor           = round(c(media_fila, media_col, y_bar), 3)
)
knitr::kable(tend, caption = "Tabla 4. Tendencia local — medias comparadas",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 4. Tendencia local — medias comparadas
Estadístico Valor
Media de promedios fila (sociabilidad) 0.038
Media de promedios columna (popularidad) 0.038
Media global 0.038

Conclusión: Las medias de los promedios fila y columna son iguales entre sí y coinciden con la media global \(\bar{y}\). Esto confirma el resultado teórico del Ejercicio 1d: \((n-1)\bar{y} = \bar{d}^{out} = \bar{d}^{in}\). No existe una asimetría sistemática en la tendencia central del comercio.

3.5 3.e Heterogeneidad local: desviaciones estándar

de_fila <- sd(y_fila)
de_col  <- sd(y_col)

heter <- data.frame(
  Dimensión   = c("Sociabilidad (promedios fila)",
                  "Popularidad (promedios columna)"),
  Media       = round(c(media_fila, media_col), 3),
  `Desv. Est.` = round(c(de_fila, de_col), 3),
  CV          = round(c(de_fila/abs(media_fila), de_col/abs(media_col)), 3),
  check.names = FALSE
)
knitr::kable(heter, caption = "Tabla 5. Heterogeneidad local — desviaciones estándar",
             align = c("l","r","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 5. Heterogeneidad local — desviaciones estándar
Dimensión Media Desv. Est. CV
Sociabilidad (promedios fila) 0.038 0.030 0.799
Popularidad (promedios columna) 0.038 0.041 1.086

Conclusión: La diferencia entre ambas desviaciones estándar indica heterogeneidad asimétrica: si la DE de los promedios fila difiere de la de las columnas, hay mayor variabilidad en la actividad emisora o receptora de los países. Países con valores extremos (positivos o negativos) dominan una dimensión del comercio.

3.6 3.f Correlación y dispersograma entre sociabilidad y popularidad

cor_fp <- cor(y_fila, y_col)
cat("Coeficiente de correlación entre promedios fila y columna:", round(cor_fp, 4), "\n")
## Coeficiente de correlación entre promedios fila y columna: 0.7003
# Dispersograma
rango  <- range(c(y_fila, y_col))
df_fc  <- data.frame(fila = y_fila, columna = y_col, pais = paises)

plot(y_fila, y_col,
     pch  = 16,
     col  = adjustcolor("steelblue", 0.7),
     xlab = expression(bar(y)[i*"•"] ~ "(Sociabilidad)"),
     ylab = expression(bar(y)["•j"] ~ "(Popularidad)"),
     main = "Sociabilidad vs. Popularidad",
     xlim = rango, ylim = rango)
abline(0, 1, col = "tomato", lwd = 2, lty = 2)  # recta y = x
legend("topleft",
       legend = c("Países", "Recta y = x"),
       pch    = c(16, NA),
       lty    = c(NA, 2),
       col    = c("steelblue", "tomato"),
       lwd    = c(NA, 2))

# Identificar países extremos
texto_idx <- which(abs(y_fila - y_col) > 0.3 |
                   y_fila > quantile(y_fila, 0.9) |
                   y_col  > quantile(y_col,  0.9))
text(y_fila[texto_idx], y_col[texto_idx],
     labels = paises[texto_idx], cex = 0.65, pos = 3)

Conclusión: Una correlación alta y positiva indica que los países que exportan más también tienden a importar más. Los puntos cercanos a la recta \(y = x\) representan países con comportamiento balanceado; los que se alejan son más activos en una dirección (mayor sociabilidad que popularidad, o viceversa).


4 Ejercicio 4 — Red de conflictos internacionales (visualización y grado)

# Carga de datos
load("conflict.RData")

# Estructura del objeto
cat("Componentes del objeto conflict:\n")
## Componentes del objeto conflict:
print(names(dat))
## [1] "X" "Y" "D"
# Matriz de conflictos Y
Y_conf <- dat$Y
n_conf <- nrow(Y_conf)
paises_conf <- rownames(Y_conf)
cat("\nNúmero de países:", n_conf, "\n")
## 
## Número de países: 130
cat("Dimensión de Y:", dim(Y_conf), "\n")
## Dimensión de Y: 130 130
# Construcción del dígrafo
g_conf <- graph_from_adjacency_matrix(Y_conf, mode = "directed", weighted = TRUE, diag = FALSE)
cat("\nOrden:", vcount(g_conf), " | Tamaño:", ecount(g_conf), "\n")
## 
## Orden: 130  | Tamaño: 203
cat("¿Dirigida?", is_directed(g_conf), "\n")
## ¿Dirigida? TRUE

4.1 4.a Visualización decorada de la red de conflictos

# --- Decoración profesional (siguiendo principios de las notas de clase) ---
d_out <- degree(g_conf, mode = "out")
d_in  <- degree(g_conf, mode = "in")

# Paleta: gradiente de rojo para out-degree (emisores de conflicto)
pal_conf <- colorRampPalette(c("#D6EAF8", "#2874A6", "#1A5276"))(20)
col_idx  <- cut(d_out, breaks = 20, labels = FALSE)
col_idx[is.na(col_idx)] <- 1
v_col_conf <- pal_conf[col_idx]

# Tamaño proporcional a sqrt(out-degree); nodos sin aristas → tamaño mínimo
v_size_conf <- 2 + 2.5 * sqrt(d_out)

# Etiquetas solo para los top-15 por actividad total
act_conf <- d_out + d_in
umbral_label <- sort(act_conf, decreasing = TRUE)[15]
v_label_conf <- ifelse(act_conf >= umbral_label, paises_conf, NA)

# Aristas: grosor y color proporcionales al peso
E(g_conf)$width <- 0.3 + 0.3 * E(g_conf)$weight
e_col_conf      <- adjustcolor("gray30", 0.35)

# Layouts múltiples (FR, KK, DH) — recomendación de las notas
set.seed(123)
l_fr_c <- layout_with_fr(g_conf)
set.seed(123)
l_kk_c <- layout_with_kk(g_conf)

par(mfrow = c(1, 2), mar = c(1, 1, 3, 1))

# --- FR: muestra estructura de grupos ---
plot(g_conf,
     layout             = l_fr_c,
     vertex.size        = v_size_conf,
     vertex.color       = v_col_conf,
     vertex.frame.color = adjustcolor("gray20", 0.6),
     vertex.label       = v_label_conf,
     vertex.label.cex   = 0.65,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.arrow.size    = 0.18,
     edge.color         = e_col_conf,
     edge.width         = E(g_conf)$width,
     main               = "Red de conflictos — Fruchterman-Reingold")
legend("bottomleft",
       legend = c("Bajo", "Medio", "Alto"),
       fill   = pal_conf[c(2, 10, 19)],
       title  = "Out-degree", bty = "n", cex = 0.75,
       border = NA)

# --- KK: distancias euclidianas ≈ distancias geodésicas ---
plot(g_conf,
     layout             = l_kk_c,
     vertex.size        = 2 + 2.5 * sqrt(d_in),
     vertex.color       = v_col_conf,
     vertex.frame.color = adjustcolor("gray20", 0.6),
     vertex.label       = v_label_conf,
     vertex.label.cex   = 0.65,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.arrow.size    = 0.18,
     edge.color         = e_col_conf,
     edge.width         = E(g_conf)$width,
     main               = "Red de conflictos — Kamada-Kawai\n(tamaño ∝ in-degree)")
legend("bottomleft",
       legend = c("Bajo", "Medio", "Alto"),
       fill   = pal_conf[c(2, 10, 19)],
       title  = "Out-degree", bty = "n", cex = 0.75,
       border = NA)

4.1.1 Visualización alternativa: Heatmap

# Heatmap de la matriz de adyacencia (binarizada)
Y_plot <- Y_conf
Y_plot[Y_plot > 0] <- 1

n_c      <- nrow(Y_plot)
paises_c <- rownames(Y_plot)

par(mar = c(6, 6, 3, 1))
image(1:n_c, 1:n_c, Y_plot,
      col  = c("white", "steelblue"),
      axes = FALSE,
      xlab = "", ylab = "",
      main = "Heatmap — Red de conflictos (binarizada)")
axis(1, at = 1:n_c, labels = paises_c, las = 2, cex.axis = 0.4, tick = FALSE)
axis(2, at = 1:n_c, labels = paises_c, las = 1, cex.axis = 0.4, tick = FALSE)
box()

4.2 4.b Media global

y_bar_conf <- mean(Y_conf[row(Y_conf) != col(Y_conf)])
den_conf   <- edge_density(g_conf)

mg <- data.frame(
  Métrica = c("Media global", "Densidad de la red"),
  Valor   = round(c(y_bar_conf, den_conf), 4),
  check.names = FALSE
)
knitr::kable(mg, caption = "Tabla 6. Media global y densidad — red de conflictos",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 6. Media global y densidad — red de conflictos
Métrica Valor
Media global 0.0182
Densidad de la red 0.0121

Interpretación: La media global es muy pequeña, lo que indica que la gran mayoría de los pares de países no registran conflictos en el período analizado. La red es dispersa: solo una fracción pequeña de los posibles vínculos dirigidos se materializan como conflictos iniciados.

4.3 4.c Distribución del out-degree e in-degree

# Tabla resumen de grados
grado_tbl <- data.frame(
  Tipo    = c("Out-degree", "In-degree"),
  Media   = round(c(mean(d_out), mean(d_in)), 2),
  `Desv. Est.` = round(c(sd(d_out), sd(d_in)), 2),
  Mínimo  = c(min(d_out), min(d_in)),
  Máximo  = c(max(d_out), max(d_in)),
  check.names = FALSE
)
knitr::kable(grado_tbl,
             caption = "Tabla 7. Resumen estadístico del grado — red de conflictos",
             align = c("l","r","r","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 7. Resumen estadístico del grado — red de conflictos
Tipo Media Desv. Est. Mínimo Máximo
Out-degree 1.56 3.59 0 27
In-degree 1.56 1.98 0 15
# Gráficos
par(mfrow = c(1, 2), mar = c(4, 4, 3, 1))

hist(d_out,
     breaks = 20,
     col    = "steelblue",
     border = "white",
     main   = "Distribución del Out-degree",
     xlab   = "Out-degree",
     ylab   = "Frecuencia")
abline(v = mean(d_out), col = "tomato", lwd = 2, lty = 2)
legend("topright", legend = paste("Media =", round(mean(d_out), 1)),
       col = "tomato", lty = 2, lwd = 2, cex = 0.8)

hist(d_in,
     breaks = 20,
     col    = "darkorange",
     border = "white",
     main   = "Distribución del In-degree",
     xlab   = "In-degree",
     ylab   = "Frecuencia")
abline(v = mean(d_in), col = "navy", lwd = 2, lty = 2)
legend("topright", legend = paste("Media =", round(mean(d_in), 1)),
       col = "navy", lty = 2, lwd = 2, cex = 0.8)

Interpretación: Ambas distribuciones están fuertemente sesgadas a la derecha, con la mayoría de países registrando pocos conflictos. Unos pocos países concentran la mayor actividad conflictiva, tanto como iniciadores como receptores. La media y desviación estándar elevada confirman esta heterogeneidad.

4.4 4.d Correlación out-degree vs. in-degree

cor_deg <- cor(d_out, d_in)
cat("Correlación out-degree vs in-degree:", round(cor_deg, 4), "\n")
## Correlación out-degree vs in-degree: 0.604
rng <- range(c(d_out, d_in))
plot(d_out, d_in,
     pch  = 16,
     col  = adjustcolor("steelblue", 0.7),
     xlab = "Out-degree",
     ylab = "In-degree",
     main = "Out-degree vs. In-degree — Conflictos",
     xlim = rng, ylim = rng)
abline(0, 1, col = "tomato", lwd = 2, lty = 2)

# Etiquetar extremos
idx_ext <- which(d_out > quantile(d_out, 0.9) | d_in > quantile(d_in, 0.9))
text(d_out[idx_ext], d_in[idx_ext],
     labels = paises_conf[idx_ext], cex = 0.7, pos = 4)

Conclusión: La correlación entre el número de conflictos iniciados y recibidos informa si los países más agresivos también son más atacados. Una correlación baja sugiere que el rol de agresor y víctima tiende a ser asimétrico; una correlación alta indicaría que los conflictos son recíprocos en intensidad.

4.5 4.e Países más activos

actividad <- d_out + d_in

# Construir tabla unificada top 10
top_idx <- order(actividad, decreasing = TRUE)[1:10]
top_tbl <- data.frame(
  País          = paises_conf[top_idx],
  `Out-degree`  = d_out[top_idx],
  `In-degree`   = d_in[top_idx],
  `Total`       = actividad[top_idx],
  check.names   = FALSE
)
knitr::kable(top_tbl,
             caption = "Tabla 8. Top 10 países más activos en conflictos internacionales",
             align = c("l","r","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(1, bold = TRUE)
Tabla 8. Top 10 países más activos en conflictos internacionales
País Out-degree In-degree Total
IRQ 27 15 42
JOR 26 1 27
USA 11 8 19
TUR 5 6 11
CHN 6 4 10
PRK 6 4 10
UGA 7 3 10
DRC 6 3 9
IRN 5 4 9
JPN 3 5 8

5 Ejercicio 5 — Centralidad en grafos pequeños

Se construyen los cuatro grafos de la imagen del enunciado y se calculan todas las medidas de centralidad.

# Grafo 1: X (dos segmentos que se cruzan, 4 vértices)
# Vértices: 1,2,3,4 con aristas 1-3, 2-3, 3-4 (estrella de grado 3)
# Interpretación de la imagen: un nodo central conectado a 3 periféricos
g_X <- graph_from_literal(A - C, B - C, C - D)

# Grafo 2: Y (árbol tipo "Y", un nodo central con 3 ramas)
g_Y <- graph_from_literal(A - C, B - C, C - D, D - E, D - F)

# Grafo 3: Camino (5 nodos en línea)
g_L <- graph_from_literal(A - B, B - C, C - D, D - E)

# Grafo 4: Pentágono (ciclo de 5 nodos)
g_P <- graph_from_literal(A - B, B - C, C - D, D - E, E - A)
# Función para calcular, mostrar y resumir centralidad con tablas de paper
tabla_centralidad <- function(g, nombre_grafo, num_tabla_base) {

  dc <- degree(g,           normalized = TRUE)
  cc <- closeness(g,        normalized = TRUE)
  bc <- betweenness(g,      normalized = TRUE)
  ec <- eigen_centrality(g, scale = TRUE)$vector

  # Tabla por vértice
  df <- data.frame(
    Vértice        = V(g)$name,
    Grado          = round(dc, 3),
    Cercanía       = round(cc, 3),
    Intermediación = round(bc, 3),
    Propia         = round(ec, 3),
    check.names    = FALSE
  )

  cat("\n")
  cat(as.character(
    knitr::kable(df,
      caption  = paste0("Tabla ", num_tabla_base, ". Centralidad por vértice — ", nombre_grafo),
      align    = c("l","r","r","r","r"),
      format   = "html",
      booktabs = TRUE, row.names = FALSE) |>
    kable_styling(bootstrap_options = c("striped","hover","condensed"),
                  full_width = FALSE, font_size = 13) |>
    row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
  ))
  cat("\n\n")

  # Tabla resumen (Media / DE)
  resumen <- data.frame(
    Medida         = c("Media", "DE"),
    Grado          = round(c(mean(dc), sd(dc)), 3),
    Cercanía       = round(c(mean(cc), sd(cc)), 3),
    Intermediación = round(c(mean(bc), sd(bc)), 3),
    Propia         = round(c(mean(ec), sd(ec)), 3),
    check.names    = FALSE
  )

  cat(as.character(
    knitr::kable(resumen,
      caption  = paste0("Tabla ", num_tabla_base + 1, ". Resumen estadístico — ", nombre_grafo),
      align    = c("l","r","r","r","r"),
      format   = "html",
      booktabs = TRUE, row.names = FALSE) |>
    kable_styling(bootstrap_options = c("striped","hover","condensed"),
                  full_width = FALSE, font_size = 13) |>
    row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
    row_spec(1, bold = TRUE)
  ))
  cat("\n\n")

  invisible(resumen)
}

r1 <- tabla_centralidad(g_X, "Grafo X (estrella)",      9)
Tabla 9. Centralidad por vértice — Grafo X (estrella)
Vértice Grado Cercanía Intermediación Propia
A 0.333 0.6 0 0.577
C 1.000 1.0 1 1.000
B 0.333 0.6 0 0.577
D 0.333 0.6 0 0.577
Tabla 10. Resumen estadístico — Grafo X (estrella)
Medida Grado Cercanía Intermediación Propia
Media 0.500 0.7 0.25 0.683
DE 0.333 0.2 0.50 0.211
r2 <- tabla_centralidad(g_Y, "Grafo Y (árbol Y)",       11)
Tabla 11. Centralidad por vértice — Grafo Y (árbol Y)
Vértice Grado Cercanía Intermediación Propia
A 0.2 0.455 0.0 0.5
C 0.6 0.714 0.7 1.0
B 0.2 0.455 0.0 0.5
D 0.6 0.714 0.7 1.0
E 0.2 0.455 0.0 0.5
F 0.2 0.455 0.0 0.5
Tabla 12. Resumen estadístico — Grafo Y (árbol Y)
Medida Grado Cercanía Intermediación Propia
Media 0.333 0.541 0.233 0.667
DE 0.207 0.134 0.361 0.258
r3 <- tabla_centralidad(g_L, "Grafo L (camino)",        13)
Tabla 13. Centralidad por vértice — Grafo L (camino)
Vértice Grado Cercanía Intermediación Propia
A 0.25 0.400 0.000 0.500
B 0.50 0.571 0.500 0.866
C 0.50 0.667 0.667 1.000
D 0.50 0.571 0.500 0.866
E 0.25 0.400 0.000 0.500
Tabla 14. Resumen estadístico — Grafo L (camino)
Medida Grado Cercanía Intermediación Propia
Media 0.400 0.522 0.333 0.746
DE 0.137 0.118 0.312 0.231
r4 <- tabla_centralidad(g_P, "Grafo P (pentágono)",     15)
Tabla 15. Centralidad por vértice — Grafo P (pentágono)
Vértice Grado Cercanía Intermediación Propia
A 0.5 0.667 0.167 1
B 0.5 0.667 0.167 1
C 0.5 0.667 0.167 1
D 0.5 0.667 0.167 1
E 0.5 0.667 0.167 1
Tabla 16. Resumen estadístico — Grafo P (pentágono)
Medida Grado Cercanía Intermediación Propia
Media 0.5 0.667 0.167 1
DE 0.0 0.000 0.000 0
# Visualización decorada: color = intermediación, tamaño = grado
# (Principio de las notas: color y tamaño codifican propiedades distintas)
grafos  <- list(g_X, g_Y, g_L, g_P)
nombres <- c("Grafo X (estrella)", "Grafo Y (árbol)",
             "Camino (5 nodos)", "Pentágono")
pal_small <- colorRampPalette(c("#AED6F1", "#1A5276"))(100)

par(mfrow = c(2, 2), mar = c(1, 1, 3, 1))
set.seed(123)
for (i in seq_along(grafos)) {
  g   <- grafos[[i]]
  dc  <- degree(g,      normalized = TRUE)
  bc  <- betweenness(g, normalized = TRUE)
  # color codifica intermediación
  bc_idx <- pmax(1, ceiling(bc * 99) + 1)
  v_col  <- pal_small[bc_idx]
  plot(g,
       vertex.size        = 18 + 22 * dc,
       vertex.color       = v_col,
       vertex.frame.color = "gray20",
       vertex.label       = V(g)$name,
       vertex.label.color = "white",
       vertex.label.cex   = 1.1,
       vertex.label.font  = 2,
       edge.color         = "gray40",
       edge.width         = 2.5,
       main               = nombres[i])
}
# Leyenda única abajo
par(fig = c(0, 1, 0, 0.04), new = TRUE, mar = c(0,0,0,0))
legend("center",
       legend   = c("Bajo", "Medio", "Alto"),
       fill     = pal_small[c(5, 50, 98)],
       title    = "Intermediación (color)  |  Grado (tamaño)",
       horiz    = TRUE, bty = "n", cex = 0.85, border = NA)

Interpretación general:

  • Grado: mide conexiones directas; el nodo central de una estrella domina.
  • Cercanía: mide cuán rápido se accede a todos los demás; nodos centrales tienen valores altos.
  • Intermediación: identifica “puentes”; en caminos lineales, los nodos del medio son cruciales.
  • Propia: pondera la importancia de los vecinos; tiende a correlacionar con el grado en grafos simples.

En el pentágono, todos los nodos son equivalentes por simetría, lo que se refleja en medidas iguales para todos. En el camino lineal, el nodo central maximiza la intermediación. En estructuras tipo estrella, el nodo hub domina todas las medidas.


6 Ejercicio 6 — Caracterización estructural de la red de conflictos (simetrizada)

# Simetrización débil: existe arista si al menos uno de los dos países
# inició un conflicto hacia el otro (binarizar tras el pmax)
Y_sim <- (pmax(Y_conf, t(Y_conf)) > 0) * 1L

# Construcción del grafo simple no dirigido (sin multi-aristas ni lazos)
g_sim <- graph_from_adjacency_matrix(Y_sim, mode = "undirected",
                                     weighted = FALSE, diag = FALSE)
g_sim <- simplify(g_sim)   # garantiza grafo simple

# Remover nodos aislados
aislados <- which(degree(g_sim) == 0)
if (length(aislados) > 0) {
  cat("Nodos aislados removidos:", V(g_sim)$name[aislados], "\n")
  g_sim <- delete_vertices(g_sim, aislados)
}
## Nodos aislados removidos: ALG AUS BFO BHU BOL BRA BUL CEN COM DEN DJI ECU EQG FIN FJI GAB GAM GUA HUN IRE JAM LAO MAG MAS MAW MEX NEP NEW NOR PAN PAR POL POR RUM SOM SWD SWZ TUN URU
cat("Orden (tras limpieza):", vcount(g_sim), "\n")
## Orden (tras limpieza): 91
cat("Tamaño:", ecount(g_sim), "\n")
## Tamaño: 160
cat("¿Grafo simple?", is_simple(g_sim), "\n")
## ¿Grafo simple? TRUE

6.1 6.a Visualización decorada

# --- Decoración: comunidades como color, grado como tamaño ---
# Detectar comunidades con Louvain para colorear
set.seed(123)
kc_pre  <- cluster_louvain(g_sim)
n_com   <- length(kc_pre)
cols_com <- RColorBrewer::brewer.pal(min(n_com, 9), "Set1")
if (n_com > 9) cols_com <- colorRampPalette(cols_com)(n_com)
V(g_sim)$color <- cols_com[kc_pre$membership]

d_sim   <- degree(g_sim)
# Tamaño: proporcional al grado
v_size_sim <- 2 + 3 * sqrt(d_sim / max(d_sim))

# Etiquetas: solo top-12 más conectados
umbral_s    <- sort(d_sim, decreasing = TRUE)[12]
v_lab_sim   <- ifelse(d_sim >= umbral_s, V(g_sim)$name, NA)

# Aristas: muy transparentes para no saturar (red grande)
e_col_sim   <- adjustcolor("gray40", 0.25)

set.seed(123)
l_fr2 <- layout_with_fr(g_sim)
set.seed(123)
l_kk2 <- layout_with_kk(g_sim)

par(mfrow = c(1, 2), mar = c(1, 1, 3, 1))

# FR — estructura de comunidades
plot(g_sim,
     layout             = l_fr2,
     vertex.size        = v_size_sim,
     vertex.color       = V(g_sim)$color,
     vertex.frame.color = adjustcolor("gray20", 0.4),
     vertex.label       = v_lab_sim,
     vertex.label.cex   = 0.7,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.color         = e_col_sim,
     edge.width         = 0.6,
     main               = "Red de conflictos (simetrizada) — FR\nColor: comunidad | Tamaño: grado")
legend("bottomleft",
       legend = paste0("Comunidad ", seq_len(n_com)),
       fill   = cols_com[seq_len(n_com)],
       bty    = "n", cex = 0.65, border = NA)

# KK — distancias reflejan geodésica
plot(g_sim,
     layout             = l_kk2,
     vertex.size        = v_size_sim,
     vertex.color       = V(g_sim)$color,
     vertex.frame.color = adjustcolor("gray20", 0.4),
     vertex.label       = v_lab_sim,
     vertex.label.cex   = 0.7,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.color         = e_col_sim,
     edge.width         = 0.6,
     main               = "Red de conflictos (simetrizada) — KK\nColor: comunidad | Tamaño: grado")

6.1.1 Heatmap de la red simetrizada

Y_sim_sub <- as_adjacency_matrix(g_sim, sparse = FALSE)
n_s       <- nrow(Y_sim_sub)
paises_s  <- rownames(Y_sim_sub)

par(mar = c(6, 6, 3, 1))
image(1:n_s, 1:n_s, Y_sim_sub,
      col  = c("white", "steelblue"),
      axes = FALSE,
      xlab = "", ylab = "",
      main = "Heatmap — Red de conflictos simetrizada")
axis(1, at = 1:n_s, labels = paises_s, las = 2, cex.axis = 0.45, tick = FALSE)
axis(2, at = 1:n_s, labels = paises_s, las = 1, cex.axis = 0.45, tick = FALSE)
box()

6.2 6.b Caracterización estructural completa

6.2.1 Métricas básicas

mb <- data.frame(
  Métrica = c("Orden (nodos)", "Tamaño (aristas)", "Densidad", "¿Conexo?"),
  Valor   = c(vcount(g_sim), ecount(g_sim),
              round(edge_density(g_sim), 4),
              as.character(is_connected(g_sim))),
  check.names = FALSE
)
knitr::kable(mb, caption = "Tabla 17. Métricas básicas — red de conflictos simetrizada",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 17. Métricas básicas — red de conflictos simetrizada
Métrica Valor
Orden (nodos) 91
Tamaño (aristas) 160
Densidad 0.0391
¿Conexo? FALSE

6.2.2 Distancia geodésica

D_sim <- distances(g_sim)
dist_tbl <- data.frame(
  Métrica = c("Diámetro", "Distancia promedio"),
  Valor   = round(c(diameter(g_sim), mean_distance(g_sim)), 3),
  check.names = FALSE
)
knitr::kable(dist_tbl, caption = "Tabla 18. Distancias geodésicas — red simetrizada",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 18. Distancias geodésicas — red simetrizada
Métrica Valor
Diámetro 9.000
Distancia promedio 3.652
# Distribución de distancias
dt_sim <- distance_table(g_sim)
par(mar = c(4, 4, 3, 1))
barplot(prop.table(dt_sim$res),
        names.arg = seq_along(dt_sim$res),
        xlab      = "Distancia geodésica",
        ylab      = "Frecuencia relativa",
        col       = "steelblue",
        border    = "white",
        main      = "Distribución de distancias geodésicas")

6.2.3 Centralidad

dc2 <- degree(g_sim,           normalized = TRUE)
cc2 <- closeness(g_sim,        normalized = TRUE)
bc2 <- betweenness(g_sim,      normalized = TRUE)
ec2 <- eigen_centrality(g_sim, scale = TRUE)$vector

# Tabla resumen Media/DE
cent_resumen <- data.frame(
  Medida         = c("Media", "DE"),
  Grado          = round(c(mean(dc2), sd(dc2)), 3),
  Cercanía       = round(c(mean(cc2), sd(cc2)), 3),
  Intermediación = round(c(mean(bc2), sd(bc2)), 3),
  Propia         = round(c(mean(ec2), sd(ec2)), 3),
  check.names    = FALSE
)
knitr::kable(cent_resumen,
             caption = "Tabla 19. Resumen de centralidades — red simetrizada",
             align = c("l","r","r","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(1, bold = TRUE)
Tabla 19. Resumen de centralidades — red simetrizada
Medida Grado Cercanía Intermediación Propia
Media 0.039 0.350 0.025 0.125
DE 0.048 0.211 0.053 0.176
# Tabla Top 5 por cada medida
get_top5 <- function(x, etiqueta) {
  idx <- order(x, decreasing = TRUE)[1:5]
  data.frame(Rank = 1:5, País = V(g_sim)$name[idx],
             Valor = round(x[idx], 3), Medida = etiqueta,
             check.names = FALSE)
}
top5_all <- rbind(get_top5(dc2,"Grado"), get_top5(cc2,"Cercanía"),
                  get_top5(bc2,"Intermediación"), get_top5(ec2,"Propia"))

knitr::kable(top5_all,
             caption = "Tabla 20. Top 5 países por medida de centralidad",
             align = c("c","l","r","l"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  pack_rows("Grado",          1,  5) |>
  pack_rows("Cercanía",       6, 10) |>
  pack_rows("Intermediación", 11, 15) |>
  pack_rows("Propia",        16, 20)
Tabla 20. Top 5 países por medida de centralidad
Rank País Valor Medida
Grado
1 IRQ 0.322 Grado
2 JOR 0.300 Grado
3 USA 0.156 Grado
4 CHN 0.089 Grado
5 UGA 0.089 Grado
Cercanía
1 BUI 1.000 Cercanía
2 LES 1.000 Cercanía
3 MAL 1.000 Cercanía
4 MZM 1.000 Cercanía
5 SAF 1.000 Cercanía
Intermediación
1 IRQ 0.295 Intermediación
2 USA 0.292 Intermediación
3 JOR 0.236 Intermediación
4 VEN 0.134 Intermediación
5 SIE 0.092 Intermediación
Propia
1 IRQ 1.000 Propia
2 JOR 0.952 Propia
3 USA 0.466 Propia
4 CAN 0.367 Propia
5 SYR 0.357 Propia
# Visualización — gradiente de color codifica la intensidad de cada medida
set.seed(123)
l_cent <- layout_with_fr(g_sim)

# Función auxiliar: convierte un vector [0,1] en colores de una paleta
pal2col <- function(x, pal) {
  idx <- pmax(1, ceiling(x / max(x) * 99) + 1)
  pal[idx]
}

pal_gr  <- colorRampPalette(c("#EBF5FB", "#1A5276"))(100)  # azul: grado
pal_cc  <- colorRampPalette(c("#FDFEFE", "#B7950B"))(100)  # dorado: cercanía
pal_bc  <- colorRampPalette(c("#FDEDEC", "#922B21"))(100)  # rojo: intermediación
pal_ec  <- colorRampPalette(c("#EAFAF1", "#1E8449"))(100)  # verde: propia

par(mfrow = c(2, 2), mar = c(1, 1, 3, 1))

plot(g_sim, layout = l_cent,
     vertex.size        = 3 + 12 * dc2,
     vertex.color       = pal2col(dc2, pal_gr),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = NA,
     edge.color         = adjustcolor("gray50", 0.2),
     edge.width         = 0.5,
     main               = "Centralidad de Grado")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_gr[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = l_cent,
     vertex.size        = 3 + 12 * cc2,
     vertex.color       = pal2col(cc2, pal_cc),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = NA,
     edge.color         = adjustcolor("gray50", 0.2),
     edge.width         = 0.5,
     main               = "Centralidad de Cercanía")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_cc[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = l_cent,
     vertex.size        = 3 + 12 * sqrt(bc2 + 0.001),
     vertex.color       = pal2col(bc2 + 0.001, pal_bc),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = NA,
     edge.color         = adjustcolor("gray50", 0.2),
     edge.width         = 0.5,
     main               = "Centralidad de Intermediación")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_bc[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = l_cent,
     vertex.size        = 3 + 12 * ec2,
     vertex.color       = pal2col(ec2, pal_ec),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = NA,
     edge.color         = adjustcolor("gray50", 0.2),
     edge.width         = 0.5,
     main               = "Centralidad Propia (Eigenvector)")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_ec[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

6.2.4 Cohesión: transitividad y clanes

coh_tbl <- data.frame(
  Métrica = c("Transitividad global", "Transitividad local (media)",
              "Número de clan (clique)", "Clanes maximales"),
  Valor   = c(round(transitivity(g_sim, type = "global"), 3),
              round(mean(transitivity(g_sim, type = "local"), na.rm = TRUE), 3),
              clique_num(g_sim),
              length(max_cliques(g_sim))),
  check.names = FALSE
)
knitr::kable(coh_tbl, caption = "Tabla 21. Métricas de cohesión — red simetrizada",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 21. Métricas de cohesión — red simetrizada
Métrica Valor
Transitividad global 0.163
Transitividad local (media) 0.424
Número de clan (clique) 4.000
Clanes maximales 98.000

6.2.5 Conectividad

comp <- components(g_sim)
ap   <- articulation_points(g_sim)

con_tbl <- data.frame(
  Métrica = c("N° de componentes", "Tamaño componente mayor",
              "Conectividad nodal", "Conectividad por aristas",
              "Puntos de articulación"),
  Valor   = c(comp$no, max(comp$csize),
              vertex_connectivity(g_sim),
              edge_connectivity(g_sim),
              length(ap)),
  check.names = FALSE
)
knitr::kable(con_tbl, caption = "Tabla 22. Métricas de conectividad — red simetrizada",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 22. Métricas de conectividad — red simetrizada
Métrica Valor
N° de componentes 5
Tamaño componente mayor 83
Conectividad nodal 0
Conectividad por aristas 0
Puntos de articulación 22
if (length(ap) > 0)
  cat("Puntos de articulación:", paste(V(g_sim)$name[ap], collapse = ", "), "\n")
## Puntos de articulación: USA, GHA, SIE, NIG, NIR, UGA, NAM, DRC, TUR, GRC, NIC, COL, VEN, CHN, THI, MYA, BNG, IND, SAU, SEN, UKG, HAI

6.2.6 Agrupamiento (detección de comunidades)

set.seed(42)
# Fast greedy
kc_fg  <- cluster_fast_greedy(g_sim)
# Louvain
kc_lv  <- cluster_louvain(g_sim)
# Walktrap
kc_wt  <- cluster_walktrap(g_sim)

cat("=== AGRUPAMIENTO ===\n")
## === AGRUPAMIENTO ===
agrup_tbl <- data.frame(
  Algoritmo    = c("Fast-greedy", "Louvain", "Walktrap"),
  Comunidades  = c(length(kc_fg), length(kc_lv), length(kc_wt)),
  Modularidad  = round(c(modularity(kc_fg), modularity(kc_lv), modularity(kc_wt)), 3),
  check.names  = FALSE
)
knitr::kable(agrup_tbl,
             caption = "Tabla 23. Detección de comunidades — red simetrizada",
             align = c("l","c","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(which.max(c(modularity(kc_fg), modularity(kc_lv), modularity(kc_wt))),
           bold = TRUE, background = "#EBF5FB")
Tabla 23. Detección de comunidades — red simetrizada
Algoritmo Comunidades Modularidad
Fast-greedy 12 0.566
Louvain 12 0.565
Walktrap 21 0.482
par(mfrow = c(1, 2), mar = c(1, 1, 2, 1))
set.seed(42)
plot(kc_fg, g_sim, layout = l_fr2,
     vertex.size = 8, vertex.label = NA,
     edge.color = adjustcolor("gray", 0.5),
     main = paste0("Fast-greedy (K=", length(kc_fg), ")"))
set.seed(42)
plot(kc_lv, g_sim, layout = l_fr2,
     vertex.size = 8, vertex.label = NA,
     edge.color = adjustcolor("gray", 0.5),
     main = paste0("Louvain (K=", length(kc_lv), ")"))

6.2.7 Asortatividad

asor <- round(assortativity_degree(g_sim, directed = FALSE), 3)
asor_tbl <- data.frame(
  Métrica    = "Asortatividad por grado",
  Valor      = asor,
  Tipo       = ifelse(asor > 0, "Asortativa", ifelse(asor < 0, "Disasortativa", "Neutra")),
  check.names = FALSE
)
knitr::kable(asor_tbl, caption = "Tabla 24. Asortatividad — red simetrizada",
             align = c("l","r","l"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 24. Asortatividad — red simetrizada
Métrica Valor Tipo
Asortatividad por grado -0.197 Disasortativa

Síntesis de resultados: La red de conflictos simetrizada presenta una densidad baja, lo que confirma que los conflictos son eventos raros a escala global. La estructura de comunidades revela agrupamientos regionales o geopolíticos. Los puntos de articulación señalan países cuya posición es crítica para la conectividad de la red. El coeficiente de asortatividad indica si países con alta actividad conflictiva tienden a relacionarse entre sí.


7 Ejercicio 7 — Síntesis de Luke (2015): Capítulos 6, 8 y 9

7.1 Capítulo 6: Visualización de redes

El Capítulo 6 de Luke (2015) aborda la visualización especializada de redes más allá de los grafos estándar. Los tipos principales que presenta son:

  1. Sociogramas clásicos con igraph y statnet/sna: posicionan los nodos usando algoritmos de fuerza (FR, KK, DH) y permiten decorar la red con atributos de los nodos y aristas (tamaño, color, forma).

  2. Diagramas de cuerdas (Chord diagrams) con el paquete circlize: ideales para redes ponderadas donde se desea visualizar flujos bidireccionales entre categorías o grupos.

  3. Mapas de calor (Heatmaps) de la sociomatriz: permiten ver patrones de conectividad globales; útiles para detectar bloques de nodos densamente conectados. Se producen con heatmap() o corrplot().

  4. Hive plots: representan los nodos dispuestos en ejes radiales (según atributos), con aristas como curvas. Facilitan la comparación de conectividad entre grupos de nodos.

# --- Replicación Cap. 6 Luke (2015): decorar por comunidades (como fblog) ---
# Color por comunidad Fast-greedy (siguiendo el ejemplo de fblog en las notas)
cols_fg  <- RColorBrewer::brewer.pal(min(length(kc_fg), 9), "Set1")
if (length(kc_fg) > 9) cols_fg <- colorRampPalette(cols_fg)(length(kc_fg))
V(g_sim)$color_fg <- cols_fg[kc_fg$membership]

# Etiquetas: solo hubs (top-10 por grado)
hub_idx  <- sort(degree(g_sim), decreasing = TRUE)[10]
v_lab_c6 <- ifelse(degree(g_sim) >= hub_idx, V(g_sim)$name, NA)

par(mfrow = c(1, 2), mar = c(3, 3, 3, 1))

# Heatmap reordenado por comunidad — Luke Cap. 6
ord      <- order(kc_fg$membership)
Y_mat    <- as_adjacency_matrix(g_sim, sparse = FALSE)[ord, ord]
image(1:nrow(Y_mat), 1:ncol(Y_mat), Y_mat,
      col  = c("white", "#2874A6"),
      axes = FALSE, xlab = "", ylab = "",
      main = "Heatmap sociomatriz\n(reordenado por comunidad — Cap. 6)")
# Líneas divisorias entre comunidades
breaks_c <- cumsum(table(sort(kc_fg$membership))) + 0.5
abline(v = breaks_c, h = breaks_c, col = "gray60", lwd = 0.5)
axis(1, at = 1:nrow(Y_mat), labels = rownames(Y_mat), las = 2,
     cex.axis = 0.4, tick = FALSE)
axis(2, at = 1:ncol(Y_mat), labels = rownames(Y_mat), las = 1,
     cex.axis = 0.4, tick = FALSE)

# Grafo decorado — comunidades como color, grado como tamaño, sin labels masivos
set.seed(123)
plot(g_sim,
     layout             = l_fr2,
     vertex.size        = 2.5 + 3 * sqrt(degree(g_sim) / max(degree(g_sim))),
     vertex.color       = V(g_sim)$color_fg,
     vertex.frame.color = adjustcolor("gray20", 0.4),
     vertex.label       = v_lab_c6,
     vertex.label.cex   = 0.7,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.color         = adjustcolor("gray40", 0.2),
     edge.width         = 0.6,
     main               = "Grafo decorado — Cap. 6 (Luke, 2015)\nColor: comunidad | Tamaño: grado")
legend("bottomleft",
       legend = paste0("C", seq_len(length(kc_fg))),
       fill   = cols_fg, bty = "n", cex = 0.65,
       ncol   = 3, border = NA, title = "Comunidad")

7.2 Capítulo 8: Subgrupos y cohesión

El Capítulo 8 se centra en la cohesión estructural y la identificación de subgrupos cohesivos:

  • Clanes y clanes maximales: subconjuntos donde todos los pares están conectados. Son la noción más estricta de cohesión.
  • N-cliques y N-clans: relajaciones que permiten conectividad indirecta.
  • K-cores: subgrafos donde cada vértice tiene al menos \(k\) vecinos dentro del subgrafo. Sirven para identificar el “núcleo” más denso de la red.
  • Componentes biconectadas: subgrafos que permanecen conectados incluso al remover cualquier vértice individual.
# Clanes maximales y k-cores
mc     <- max_cliques(g_sim)
kc_dec <- coreness(g_sim)
k_max  <- max(kc_dec)
nucleo <- V(g_sim)$name[kc_dec == k_max]
bcc    <- biconnected_components(g_sim)

# Tabla resumen cohesión avanzada
cap8_tbl <- data.frame(
  Métrica = c("Clanes maximales", "Tamaño del clan máximo",
              "k-core máximo", "Países en k-core máximo",
              "Componentes biconectadas"),
  Valor   = c(length(mc), clique_num(g_sim), k_max,
              length(nucleo), bcc$no),
  check.names = FALSE
)
knitr::kable(cap8_tbl, caption = "Tabla 25. Cohesión avanzada — Capítulo 8 (Luke, 2015)",
             align = c("l","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 25. Cohesión avanzada — Capítulo 8 (Luke, 2015)
Métrica Valor
Clanes maximales 98
Tamaño del clan máximo 4
k-core máximo 3
Países en k-core máximo 37
Componentes biconectadas 33
# Distribución k-coreness
kcore_dist <- as.data.frame(table(kc_dec))
colnames(kcore_dist) <- c("k", "N° nodos")
knitr::kable(kcore_dist,
             caption = "Tabla 26. Distribución de k-coreness",
             align = c("c","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(nrow(kcore_dist), bold = TRUE, background = "#EBF5FB")
Tabla 26. Distribución de k-coreness
k N° nodos
1 32
2 22
3 37
cat("Países en el k-core máximo (k =", k_max, "):",
    paste(nucleo, collapse = ", "), "\n")
## Países en el k-core máximo (k = 3 ): ANG, ARG, AUL, BEL, CAN, CDI, CHA, CHN, DRC, EGY, FRN, GRC, GUI, HAI, IRN, IRQ, ISR, JOR, JPN, LBR, NIG, NIR, NTH, PRK, QAT, ROK, RWA, SAU, SIE, SPN, SUD, SYR, TUR, UAE, UGA, UKG, USA
# Paleta con alto contraste entre k-shells (blanco → amarillo → naranja → rojo oscuro)
pal_core <- c("#CCCCCC", "#F4D03F", "#E67E22", "#C0392B")[seq_len(k_max)]
col_core <- pal_core[kc_dec]

par(mfrow = c(1, 2), mar = c(2, 1, 3, 1))

# --- Panel 1: red completa coloreada por k-shell, sin labels ---
set.seed(123)
plot(g_sim,
     layout             = l_fr2,
     vertex.size        = 1.5 + 2.5 * kc_dec,
     vertex.color       = col_core,
     vertex.frame.color = adjustcolor("gray20", 0.5),
     vertex.label       = NA,
     edge.color         = adjustcolor("gray40", 0.18),
     edge.width         = 0.5,
     main               = paste0("K-core descomposición — Cap. 8  (k_max = ", k_max, ")"))
legend("bottomleft",
       legend = paste0("k = ", 1:k_max),
       fill   = pal_core,
       border = "gray50",
       bty    = "n", cex = 0.8, ncol = 1,
       title  = "K-shell")

# --- Panel 2: subgrafo del núcleo — grado como tamaño, sin labels encimados ---
g_nucleo  <- induced_subgraph(g_sim, V(g_sim)[kc_dec == k_max])
d_nucleo  <- degree(g_nucleo)
n_nucleo  <- vcount(g_nucleo)

# Color dentro del núcleo: gradiente por grado interno
pal_nuc <- colorRampPalette(c("#FADBD8", "#C0392B"))(20)
ci_nuc  <- pmax(1, ceiling(d_nucleo / max(d_nucleo) * 19) + 1)

# Etiquetas solo si el núcleo es pequeño (≤ 20), si no: sin labels
v_lab_nuc <- if (n_nucleo <= 20) V(g_nucleo)$name else NA

set.seed(42)
plot(g_nucleo,
     layout             = layout_with_fr(g_nucleo),
     vertex.size        = 5 + 8 * sqrt(d_nucleo / max(d_nucleo)),
     vertex.color       = pal_nuc[ci_nuc],
     vertex.frame.color = "gray20",
     vertex.label       = v_lab_nuc,
     vertex.label.cex   = 0.7,
     vertex.label.color = "black",
     vertex.label.font  = 2,
     edge.color         = adjustcolor("gray30", 0.45),
     edge.width         = 1.2,
     main               = paste0("Núcleo más denso  k = ", k_max,
                                 "  (n = ", n_nucleo, " países)"))
legend("bottomleft",
       legend = c("Menor grado", "Mayor grado"),
       fill   = pal_nuc[c(1, 20)],
       border = NA, bty = "n", cex = 0.8,
       title  = "Grado interno")

7.3 Capítulo 9: Afiliación y redes bipartitas

El Capítulo 9 aborda las redes de afiliación (bipartitas), en las que los nodos pertenecen a dos conjuntos disjuntos (actores y eventos/grupos):

  • Proyección unimodal: a partir de una red bipartita, se construye una red entre actores conectando a quienes comparten al menos una afiliación.
  • Centralidad en redes bipartitas: las medidas de grado, cercanía e intermediación se adaptan directamente.
  • Redundancia y solapamiento: se mide cuántos grupos comparten pares de actores, lo que indica la densidad de afiliaciones comunes.
Y_mat2 <- as_adjacency_matrix(g_sim, sparse = FALSE)
Y_proj  <- Y_mat2 %*% Y_mat2
diag(Y_proj) <- 0

umbral     <- 2
Y_proj_bin <- (Y_proj >= umbral) * 1
g_proj     <- graph_from_adjacency_matrix(Y_proj_bin, mode = "undirected", diag = FALSE)

proj_tbl <- data.frame(
  Métrica = c("Orden (nodos)", "Tamaño (aristas)", "Densidad", "Transitividad global"),
  `Red original`  = c(vcount(g_sim), ecount(g_sim),
                      round(edge_density(g_sim), 3),
                      round(transitivity(g_sim, "global"), 3)),
  `Red proyectada` = c(vcount(g_proj), ecount(g_proj),
                       round(edge_density(g_proj), 3),
                       round(transitivity(g_proj, "global"), 3)),
  check.names = FALSE
)
knitr::kable(proj_tbl,
             caption = paste0("Tabla 27. Proyección unimodal (umbral ≥ ", umbral,
                              " conflictos compartidos) — Cap. 9 (Luke, 2015)"),
             align = c("l","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla 27. Proyección unimodal (umbral ≥ 2 conflictos compartidos) — Cap. 9 (Luke, 2015)
Métrica Red original Red proyectada
Orden (nodos) 91.000 91.000
Tamaño (aristas) 160.000 408.000
Densidad 0.039 0.100
Transitividad global 0.163 0.901

8 Ejercicio 8 — Distribuciones del grado

Las distribuciones del grado sirven para modelar estadísticamente la heterogeneidad de la conectividad en una red, permitiendo comparar redes entre sí, detectar estructura de hubs y realizar inferencia sobre el proceso generativo.

8.1 Distribuciones alternativas a la ley de potencias

1. Ley de potencias (Power law): \(f_d = c \cdot d^{-\alpha}\), con \(\alpha > 1\). - Decaimiento lineal en escala log-log. - Presencia de hubs (nodos muy conectados). - Apropiada para redes de citas, internet, colaboración. - Ventaja: parsimoniosa e interpretable. Desventaja: difícil de ajustar y verificar; sensible al mínimo \(d_{min}\).

2. Log-normal: \(\log d \sim \mathcal{N}(\mu, \sigma^2)\). - Cola derecha larga pero más ligera que la ley de potencias. - Más plausible cuando los grados resultan de productos de factores multiplicativos independientes. - Ventaja: flexible, bien conocida. Desventaja: suele confundirse visualmente con ley de potencias.

3. Exponencial: \(f_d = c \cdot e^{-\lambda d}\). - Decaimiento rápido; prácticamente sin hubs. - Apropiada para redes aleatorias (Erdős–Rényi) o con restricciones de costo. - Ventaja: analíticamente manejable. Desventaja: subestima la presencia de nodos muy conectados.

4. Poisson: \(f_d = e^{-\lambda}\lambda^d/d!\). - Grados concentrados en torno a la media \(\lambda\); varianza igual a la media. - Propia de redes aleatorias de Erdős–Rényi. - Ventaja: base teórica sólida. Desventaja: muy restrictiva; rara en redes reales complejas.

5. Ley de potencias con corte exponencial: \(f_d = c \cdot d^{-\alpha} e^{-d/\kappa}\). - Combina la cola pesada de la ley de potencias con un decaimiento exponencial a partir de \(\kappa\). - Apropiada cuando hay hubs pero con límites naturales (capacidad de mantenimiento de enlaces). - Ventaja: más realista que la ley de potencias pura. Desventaja: mayor número de parámetros.

8.2 Ejemplo de ajuste con la red de conflictos simetrizada

d_sim_vals <- degree(g_sim)

# Distribución de frecuencias del grado
dd  <- degree_distribution(g_sim)
d_v <- 0:(length(dd) - 1)

par(mfrow = c(1, 2), mar = c(4, 4, 3, 1))

# Escala lineal
plot(d_v, dd,
     type = "b",
     pch  = 16,
     col  = "steelblue",
     xlab = "Grado",
     ylab = "Densidad de probabilidad",
     main = "Distribución del grado\n(escala lineal)")

# Escala log-log
dd_pos <- dd[dd > 0]
d_pos  <- d_v[dd > 0]
plot(log(d_pos), log(dd_pos),
     pch  = 16,
     col  = "steelblue",
     xlab = "Log(Grado)",
     ylab = "Log(Densidad)",
     main = "Distribución del grado\n(escala log-log)")

# Ajuste de ley de potencias (regresión lineal en escala log)
if (length(d_pos) > 3) {
  fit_lm <- lm(log(dd_pos) ~ log(d_pos))
  abline(fit_lm, col = "tomato", lwd = 2)
  cat("Exponente estimado (alpha):", round(-coef(fit_lm)[2], 3), "\n")
  cat("R²:", round(summary(fit_lm)$r.squared, 3), "\n")
}

## Exponente estimado (alpha): 1.147 
## R²: 0.88
d_sim_pos <- d_sim_vals[d_sim_vals > 0]

# Ley de potencias
fit_pl     <- fit_power_law(d_sim_pos, implementation = "plfit")
# Log-normal
mu_ln      <- mean(log(d_sim_pos));  sd_ln <- sd(log(d_sim_pos))
# Exponencial
lambda_exp <- 1 / mean(d_sim_vals)
# Poisson
lambda_poi <- mean(d_sim_vals)
# R² ley de potencias (log-log)
dd      <- degree_distribution(g_sim)
d_v     <- 0:(length(dd)-1)
dd_pos  <- dd[dd > 0];  dv_pos <- d_v[dd > 0]
fit_lm  <- lm(log(dd_pos) ~ log(dv_pos))
r2_pl   <- round(summary(fit_lm)$r.squared, 3)

dist_tbl2 <- data.frame(
  Distribución  = c("Ley de potencias", "Log-normal", "Exponencial", "Poisson"),
  Parámetro1    = c(paste0("α = ", round(fit_pl$alpha, 2)),
                    paste0("μ = ", round(mu_ln, 2)),
                    paste0("λ = ", round(lambda_exp, 3)),
                    paste0("λ = ", round(lambda_poi, 2))),
  Parámetro2    = c(paste0("x_min = ", fit_pl$xmin),
                    paste0("σ = ", round(sd_ln, 2)), "—", "—"),
  `R² (log-log)` = c(r2_pl, "—", "—", "—"),
  check.names   = FALSE
)
knitr::kable(dist_tbl2,
             caption = "Tabla 28. Ajuste de distribuciones del grado — red de conflictos",
             align = c("l","r","r","r"), booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(1, bold = TRUE, background = "#EBF5FB")
Tabla 28. Ajuste de distribuciones del grado — red de conflictos
Distribución Parámetro1 Parámetro2 R² (log-log)
Ley de potencias α = 3.07 x_min = 4 0.88
Log-normal μ = 0.9 σ = 0.78
Exponencial λ = 0.284
Poisson λ = 3.52

Interpretación: Se elige la ley de potencias si el gráfico log-log muestra un decaimiento aproximadamente lineal y el \(R^2\) es alto. En redes de conflictos, que tienden a ser dispersas con pocos hubs, la distribución exponencial o la ley de potencias con corte pueden ser más apropiadas. El ajuste debe evaluarse visualmente y con pruebas de bondad de ajuste como la KS.


9 Ejercicio 9 — Medidas de centralidad adicionales

9.1 Descripción conceptual

PageRank: Mide la probabilidad de que un caminante aleatorio que sigue aristas (y ocasionalmente “salta” a un nodo aleatorio con probabilidad de amortiguación \(1-d\)) visite el nodo. Un nodo es importante si es referenciado por nodos que a su vez son importantes. Prioriza autoridad acumulada por vecindad.

Katz centrality: Extiende el grado ponderando el número de caminatas de todas las longitudes que llegan a un nodo, con un factor de descuento \(\beta < 1/\lambda_1\) por cada paso adicional. A diferencia del PageRank, no normaliza por el grado del nodo origen, por lo que favorece nodos con muchos caminos entrantes en grafos densos.

Harmonic centrality: Variante de la centralidad de cercanía que usa la suma de las inversas de las distancias (en lugar de la inversa de la suma). Está bien definida incluso cuando el grafo no es conexo: los pares desconectados contribuyen con \(0\) (en lugar de \(\infty\)). Prioriza nodos que están cerca de muchos otros, sin ser afectados por pares inalcanzables.

VoteRank: Algoritmo iterativo que selecciona nodos influyentes uno a la vez. En cada ronda, el nodo con mayor “votación” acumulada (suma de influencias de sus vecinos) es seleccionado y la influencia de sus vecinos se reduce. Prioriza nodos que son importantes de forma complementaria, evitando la redundancia de los hubs adyacentes.

9.2 Cálculo en la red de conflictos simetrizada

# PageRank
pr  <- page_rank(g_sim, damping = 0.85)$vector

# Katz / Alpha centrality (igraph: alpha_centrality)
# Se usa un valor pequeño de alpha para garantizar convergencia
lam1   <- eigen(as_adjacency_matrix(g_sim, sparse = FALSE))$values[1]
alpha_k <- 0.85 / lam1
katz   <- alpha_centrality(g_sim, alpha = alpha_k, exo = 1)
katz   <- abs(katz) / max(abs(katz))  # normalizar

# Harmonic centrality
harm <- harmonic_centrality(g_sim, normalized = TRUE)

# VoteRank — implementación manual del algoritmo
# (Zhang et al., 2016): en cada ronda, el nodo con mayor votación
# acumulada es elegido y la capacidad de voto de sus vecinos se reduce.
voterank_manual <- function(g) {
  n       <- vcount(g)
  # capacidad de voto de cada nodo: inicialmente 1/grado_promedio
  d_avg   <- mean(degree(g))
  f       <- rep(1.0, n)           # capacidad de voto
  selec   <- integer(0)            # orden de selección

  for (ronda in seq_len(n)) {
    # calcular votación de cada nodo no seleccionado
    votos <- sapply(seq_len(n), function(i) {
      if (i %in% selec) return(-Inf)
      nb <- neighbors(g, i)
      sum(f[nb])
    })
    ganador <- which.max(votos)
    if (votos[ganador] <= 0) break  # no quedan nodos con votos positivos
    selec <- c(selec, ganador)
    # reducir capacidad de voto de los vecinos del ganador
    nb_gan <- as.integer(neighbors(g, ganador))
    f[nb_gan] <- pmax(0, f[nb_gan] - 1 / d_avg)
    f[ganador] <- 0
  }
  selec
}

vr_order <- voterank_manual(g_sim)
vr_score <- rep(0, vcount(g_sim))
if (length(vr_order) > 0) {
  # el primero seleccionado es el más influyente → puntuación máxima
  vr_score[vr_order] <- rev(seq_along(vr_order))
  vr_score <- vr_score / max(vr_score)
}

# Tabla de resultados
n_sim       <- vcount(g_sim)
nombres_sim <- V(g_sim)$name

df_cent <- data.frame(
  País      = nombres_sim,
  Grado     = round(dc2,      3),
  PageRank  = round(pr,       4),
  Katz      = round(katz,     3),
  Harmonic  = round(harm,     3),
  VoteRank  = round(vr_score, 3),
  check.names = FALSE
)

# Top 10 por PageRank
top10_pr <- df_cent[order(df_cent$PageRank, decreasing = TRUE), ][1:10, ]
top10_pr <- cbind(Rank = 1:10, top10_pr)

knitr::kable(top10_pr,
             caption = "Tabla 29. Top 10 países por PageRank — medidas de centralidad adicionales",
             align = c("c","l","r","r","r","r","r"),
             booktabs = TRUE, row.names = FALSE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  row_spec(1, bold = TRUE)
Tabla 29. Top 10 países por PageRank — medidas de centralidad adicionales
Rank País Grado PageRank Katz Harmonic VoteRank
1 IRQ 0.322 0.0675 1.000 0.556 1.000
2 JOR 0.300 0.0633 0.949 0.541 0.975
3 USA 0.156 0.0348 0.528 0.468 0.950
4 UGA 0.089 0.0233 0.156 0.323 0.925
5 CHN 0.089 0.0214 0.218 0.359 0.900
6 NIG 0.067 0.0188 0.150 0.333 0.875
7 NIC 0.044 0.0185 0.091 0.221 0.850
8 DRC 0.067 0.0179 0.144 0.314 0.825
9 HAI 0.078 0.0179 0.278 0.349 0.800
10 RWA 0.067 0.0174 0.135 0.294 0.700

9.3 Correlación entre rankings

cent_mat <- df_cent[, c("Grado","PageRank","Katz","Harmonic","VoteRank")]
cor_cent <- cor(cent_mat, method = "spearman")

# Tabla triangular superior de correlaciones
cor_df <- as.data.frame(round(cor_cent, 3))
knitr::kable(cor_df,
             caption = "Tabla 30. Correlaciones de Spearman entre rankings de centralidad",
             booktabs = TRUE) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE, font_size = 13) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white") |>
  column_spec(1, bold = TRUE)
Tabla 30. Correlaciones de Spearman entre rankings de centralidad
Grado PageRank Katz Harmonic VoteRank
Grado 1.000 0.807 0.823 0.812 0.705
PageRank 0.807 1.000 0.444 0.443 0.845
Katz 0.823 0.444 1.000 0.967 0.367
Harmonic 0.812 0.443 0.967 1.000 0.379
VoteRank 0.705 0.845 0.367 0.379 1.000
corrplot(cor_cent,
         method   = "color",
         type     = "upper",
         col      = colorRampPalette(c("tomato", "white", "steelblue"))(100),
         tl.col   = "black",
         tl.cex   = 0.9,
         addCoef.col = "black",
         number.cex  = 0.8,
         cl.pos   = "b",
         title    = "Correlación entre medidas de centralidad (Spearman)",
         mar      = c(0, 0, 2, 0))

9.4 Visualización comparativa

# Gradiente único por medida (principio de las notas: color + tamaño = 2 variables)
set.seed(123)
lc <- layout_with_fr(g_sim)

# Función: score → color de paleta
sc2col <- function(x, pal) {
  x  <- x / max(x)
  pal[pmax(1, ceiling(x * 99) + 1)]
}

pal_pr  <- colorRampPalette(c("#EBF5FB","#1A5276"))(100)  # azul oscuro
pal_kz  <- colorRampPalette(c("#FEF9E7","#B7770D"))(100)  # ámbar
pal_hm  <- colorRampPalette(c("#EAFAF1","#196F3D"))(100)  # verde
pal_vr  <- colorRampPalette(c("#F5EEF8","#6C3483"))(100)  # violeta

# Etiquetas: top 8 por cada medida
top8 <- function(x) {
  u <- sort(x, decreasing = TRUE)[8]
  ifelse(x >= u, V(g_sim)$name, NA)
}

par(mfrow = c(2, 2), mar = c(1, 1, 3, 1))

plot(g_sim, layout = lc,
     vertex.size        = 2 + 10 * sqrt(pr / max(pr)),
     vertex.color       = sc2col(pr, pal_pr),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = top8(pr),
     vertex.label.cex   = 0.7, vertex.label.font = 2,
     vertex.label.color = "black",
     edge.color         = adjustcolor("gray50", 0.2), edge.width = 0.5,
     main               = "PageRank")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_pr[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = lc,
     vertex.size        = 2 + 10 * sqrt(katz),
     vertex.color       = sc2col(katz, pal_kz),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = top8(katz),
     vertex.label.cex   = 0.7, vertex.label.font = 2,
     vertex.label.color = "black",
     edge.color         = adjustcolor("gray50", 0.2), edge.width = 0.5,
     main               = "Katz Centrality")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_kz[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = lc,
     vertex.size        = 2 + 10 * sqrt(harm / max(harm)),
     vertex.color       = sc2col(harm, pal_hm),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = top8(harm),
     vertex.label.cex   = 0.7, vertex.label.font = 2,
     vertex.label.color = "black",
     edge.color         = adjustcolor("gray50", 0.2), edge.width = 0.5,
     main               = "Harmonic Centrality")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_hm[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

plot(g_sim, layout = lc,
     vertex.size        = 2 + 10 * sqrt(vr_score + 0.01),
     vertex.color       = sc2col(vr_score + 0.01, pal_vr),
     vertex.frame.color = adjustcolor("gray20", 0.3),
     vertex.label       = top8(vr_score),
     vertex.label.cex   = 0.7, vertex.label.font = 2,
     vertex.label.color = "black",
     edge.color         = adjustcolor("gray50", 0.2), edge.width = 0.5,
     main               = "VoteRank")
legend("bottomleft", legend = c("Bajo","Alto"), fill = pal_vr[c(5,98)],
       bty = "n", cex = 0.7, border = NA)

Interpretación de diferencias entre medidas:

  • PageRank vs. Grado: PageRank penaliza ser vecino de nodos muy conectados (normaliza por su grado de salida); un nodo con pocos vecinos muy importantes puede superar en PageRank a uno muy conectado pero con vecinos periféricos.

  • Katz vs. PageRank: Katz cuenta todas las caminatas sin normalizar por el grado del emisor, lo que hace que nodos en posiciones de “receptor” en grafos densos obtengan puntajes más altos.

  • Harmonic vs. Cercanía clásica: En grafos no conexos, la cercanía clásica colapsa para nodos en componentes aisladas. La harmonic soluciona esto asignando \(0\) a pares inalcanzables; sus rankings suelen ser similares en grafos conexos pero divergen cuando hay componentes separadas.

  • VoteRank: Al seleccionar nodos de forma iterativa y reducir la influencia de sus vecinos, identifica nodos que cubren regiones distintas de la red. Los nodos seleccionados primero son los más centrales globalmente, pero los siguientes tienden a ser los más influyentes en subregiones no cubiertas, lo que genera un ranking complementario al del grado o PageRank.


10 Referencias

  • Sosa, J. C. (2024). Notas de clase: Análisis estadístico de redes. Universidad Nacional de Colombia.
  • Luke, D. A. (2015). A user’s guide to network analysis in R. Springer.
  • Lazega, E. (2001). The collegial phenomenon. Oxford University Press.
  • Zachary, W. W. (1977). An information flow model for conflict and fission in small groups. Journal of Anthropological Research, 33(4), 452–473.