Helen Granados Rodríguez — Universidad Nacional de Colombia
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
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\)
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\)
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\]
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\)
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\]
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
## Valor teórico 2(n-1)/n: 1.777778
## 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, ")"))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")Definiciones clave (según las notas de clase):
Aristas del grafo: \(\{1-2,\, 1-4,\, 1-5,\, 1-6,\, 3-6,\, 3-4\}\)
Secuencia a: \(2 - 1 - 6 - 3 - 4\)
Secuencia b: \(2 - 1 - 6 - 3 - 4 - 1 - 5\)
Secuencia c: \(2 - 1 - 2 - 5 - 1 - 4\)
| 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 |
# Carga del conjunto de datos
load("comtrade.RData")
# Dimensiones
cat("Dimensiones del arreglo comtrade:\n")## Dimensiones del arreglo 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
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.
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")| 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.
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")| 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.
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")| 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.
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")| 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.
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).
# Carga de datos
load("conflict.RData")
# Estructura del objeto
cat("Componentes del objeto conflict:\n")## Componentes del objeto conflict:
## [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
## 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
## ¿Dirigida? TRUE
# --- 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)# 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()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")| 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.
# 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")| 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.
## 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.
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)| 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 |
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)| 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 |
| 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 |
| 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 |
| 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 |
| 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 |
| 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 |
| 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 |
| 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:
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.
# 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
## Orden (tras limpieza): 91
## Tamaño: 160
## ¿Grafo simple? TRUE
# --- 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")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()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")| Métrica | Valor |
|---|---|
| Orden (nodos) | 91 |
| Tamaño (aristas) | 160 |
| Densidad | 0.0391 |
| ¿Conexo? | FALSE |
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")| 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")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)| 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)| 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)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")| Métrica | Valor |
|---|---|
| Transitividad global | 0.163 |
| Transitividad local (media) | 0.424 |
| Número de clan (clique) | 4.000 |
| Clanes maximales | 98.000 |
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")| Métrica | Valor |
|---|---|
| N° de componentes | 5 |
| Tamaño componente mayor | 83 |
| Conectividad nodal | 0 |
| Conectividad por aristas | 0 |
| Puntos de articulación | 22 |
## 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
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")| 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), ")"))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")| 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í.
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:
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).
Diagramas de cuerdas (Chord diagrams) con el
paquete circlize: ideales para redes ponderadas donde se
desea visualizar flujos bidireccionales entre categorías o
grupos.
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().
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")El Capítulo 8 se centra en la cohesión estructural y la identificación de subgrupos cohesivos:
# 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")| 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")| k | N° nodos |
|---|---|
| 1 | 32 |
| 2 | 22 |
| 3 | 37 |
## 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")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):
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")| 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 |
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.
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.
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")| 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.
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.
# 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)| 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 |
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)| 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))# 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.