Análisis de redes.

AUCS

¿Hasta qué punto la posición, las comunidades y la integración social de una persona dependen del tipo de relación observado, y qué información se pierde al representar todas las relaciones mediante una única red agregada?

# Sin mensajes ni avisos de R en el informe
knitr::opts_chunk$set(message = FALSE, warning = FALSE)

library(multinet)
library(igraph)
library(dplyr)
library(ggplot2)
library(corrplot)

# Resultados como tablas: data frames (df_print: kable), matrices y tablas de frecuencia
options(digits = 3)
tabla_kable <- function(x, ...) knitr::knit_print(knitr::kable(x), ...)
registerS3method("knit_print", "matrix", tabla_kable, envir = asNamespace("knitr"))
registerS3method("knit_print", "table", tabla_kable, envir = asNamespace("knitr"))

net <- ml_aucs()

# Resumen de la red multicapa
data.frame(
  actores = num_actors_ml(net),
  capas = num_layers_ml(net),
  vertices = num_vertices_ml(net),
  aristas = num_edges_ml(net)
)

actores	capas	vertices	aristas
61	5	224	620

3 Actividades

3.1 Construcción

Actores y capas

• Número de actores.

nombres <- actors_ml(net)$actor
data.frame(actores = length(nombres))

actores
61

• Número de capas.

data.frame(capas = num_layers_ml(net))

capas
5

data.frame(capa = layers_ml(net))

capa
lunch
facebook
coauthor
leisure
work

• Grado multicapa de cada actor.

head(data.frame(actor = actors_ml(net)$actor, grado_multicapa = degree_ml(net)))

actor	grado_multicapa
U33	15
U139	12
U102	2
U106	21
U107	17
U118	19

Aristas y dirección

data.frame(aristas = num_edges_ml(net))

aristas
620

is_directed_ml(net)

layer1	layer2	dir
lunch	lunch	0
facebook	facebook	0
coauthor	coauthor	0
leisure	leisure	0
work	work	0

Es una red multicapa no dirigida.

Atributos

La librería multinet tiene los siguientes aspectos para los atributos.

• edge: Propiedades de la relación entre dos actores.

• vertex: Propiedades del actor en una capa específica.

• actor: Propiedades globales.

attributes_ml(net)

name	type
group	string
role	string

attributes_ml(net, target = "actor")

name	type
group	string
role	string

attributes_ml(net, target = "edge")

layer	name	type

attributes_ml(net, target = "vertex")

layer	name	type

Codificación de rol y grupo de investigación

# actors_ml() devuelve una lista; se convierte a data frame
actores_attr <- as.data.frame(actors_ml(net, attributes = TRUE))

table(actores_attr$group, useNA = "ifany")

Var1	Freq
G1	6
G2	12
G2/G3	1
G2/G6	1
G3	8
G4	7
G5	4
G6	7
G7	8
G8	1
NA	6

table(actores_attr$role, useNA = "ifany")

Var1	Freq
Admin	6
Assistant	1
Associate	5
Emeritus	1
NA	1
PhD	30
Phd (visiting)	1
Postdoc	12
Professor	4

# Los faltantes vienen como el texto "NA", no como NA de R
data.frame(t(sapply(actores_attr[, c("group", "role")], function(x) sum(x == "NA"))))

group	role
6	1

# Recodificación: faltantes a NA y "Phd (visiting)" se une a "PhD"
actores_attr <- actores_attr %>%
  mutate(
    group = na_if(group, "NA"),
    role  = na_if(role, "NA"),
    role  = recode(role, "Phd (visiting)" = "PhD"),
    grupo_mixto = grepl("/", group)
  )

table(actores_attr$group, useNA = "ifany")

Var1	Freq
G1	6
G2	12
G2/G3	1
G2/G6	1
G3	8
G4	7
G5	4
G6	7
G7	8
G8	1
NA	6

table(actores_attr$role, useNA = "ifany")

Var1	Freq
Admin	6
Assistant	1
Associate	5
Emeritus	1
PhD	31
Postdoc	12
Professor	4
NA	1

# Actores con codificación atípica
actores_attr %>%
  filter(is.na(group) | is.na(role) | grupo_mixto)

actor	group	role	grupo_mixto
U33	NA	Admin	FALSE
U139	NA	Associate	FALSE
U102	NA	Emeritus	FALSE
U123	G2/G6	Admin	TRUE
U71	NA	NA	FALSE
U86	NA	Professor	FALSE
U4	G2/G3	Admin	TRUE
U63	NA	Admin	FALSE

# Rol por grupo de investigación
table(actores_attr$group, actores_attr$role, useNA = "ifany")

	Admin	Assistant	Associate	Emeritus	PhD	Postdoc	Professor	NA
G1	0	0	1	0	4	1	0	0
G2	0	0	0	0	8	3	1	0
G2/G3	1	0	0	0	0	0	0	0
G2/G6	1	0	0	0	0	0	0	0
G3	0	0	0	0	6	2	0	0
G4	2	0	1	0	2	2	0	0
G5	0	0	0	0	1	2	1	0
G6	0	0	2	0	5	0	0	0
G7	0	0	0	0	5	2	1	0
G8	0	1	0	0	0	0	0	0
NA	2	0	1	1	0	0	1	1

Los atributos presentan problemas de codificación que deben resolverse antes de analizarlos. Los faltantes están registrados como el texto "NA" y no como valores faltantes de R, por lo que se recodifican: 6 actores no tienen grupo de investigación y 1 no tiene rol. En el rol, la categoría Phd (visiting) es una variante de PhD y se unifica con ella. En el grupo, dos actores administrativos pertenecen a grupos combinados (G2/G3 y G2/G6), probablemente porque dan soporte a más de un grupo; se conservan como categorías propias y se marcan con grupo_mixto, ya que asignarlos a uno solo de los grupos sería arbitrario.

La distribución es desbalanceada. Los estudiantes de doctorado y los postdocs son la mayoría de la organización, mientras que roles como Assistant o Emeritus tienen un solo actor, y el grupo G8 también tiene un único miembro. Los actores sin grupo son principalmente personal administrativo y profesores, lo que sugiere que el grupo de investigación no aplica a todos los roles. Estas categorías pequeñas o faltantes limitan las comparaciones por atributo en las secciones de asortatividad y comunidades.

Actores activos por capa

table(vertices_ml(net)$layer)

Var1	Freq
coauthor	25
facebook	32
leisure	47
lunch	60
work	60

Pares conectados

aristas <- edges_ml(net)

df_relaciones <- data.frame(
  Actor_Origen  = aristas$from_actor,
  Actor_Destino = aristas$to_actor,
  Capa_Origen   = aristas$from_layer
)

head(df_relaciones)

Actor_Origen	Actor_Destino	Capa_Origen
U123	U67	lunch
U123	U71	lunch
U123	U79	lunch
U124	U126	lunch
U124	U47	lunch
U124	U99	lunch

df_relaciones_resumen <- df_relaciones %>%
  mutate(
    Actor1 = pmin(Actor_Origen, Actor_Destino),
    Actor2 = pmax(Actor_Origen, Actor_Destino)
  ) %>%
  count(Actor1, Actor2, name = "Numero_capas_compartidas") %>%
  arrange(desc(Numero_capas_compartidas))

df_relaciones_resumen$binario_relaciones <- as.numeric(df_relaciones_resumen$Numero_capas_compartidas > 0)
head(df_relaciones_resumen)

Actor1	Actor2	Numero_capas_compartidas	binario_relaciones
U1	U10	5	1
U110	U91	5	1
U29	U32	5	1
U106	U118	4	1
U107	U32	4	1
U109	U54	4	1

Red agregada binaria y ponderada

g <- graph_from_data_frame(
  d = df_relaciones_resumen,
  directed = FALSE
)

# Peso = número de capas compartidas
E(g)$weight <- E(g)$Numero_capas_compartidas

# Grafo ponderado: color y grosor según el peso
colores_peso <- c("gray80", "lightblue", "blue", "darkblue", "red")
E(g)$color <- colores_peso[E(g)$weight]

plot(
  g,
  vertex.size = 4,
  vertex.label = NA,
  edge.width = E(g)$weight,
  main = "Grafo Ponderado por Color y Grosor"
)

# Grafo binario: grosor constante
plot(
  g,
  vertex.size = 5,
  vertex.label = NA,
  edge.width = 1,
  edge.color = "gray40",
  main = "Grafo Binario (Presencia de relación)"
)

Qué se pierde

La red agregada binaria conserva qué pares de actores están conectados, pero pierde el tipo de relación y el número de capas en que se repite cada vínculo. La red agregada ponderada conserva además la multiplicidad, ya que el peso es el número de capas compartidas, pero no indica cuáles capas comparte cada par. En ambas se pierde la estructura propia de cada relación: caminos, triángulos y comunidades pueden formarse combinando aristas de capas distintas que no coexisten en ningún contexto.

3.2 Descripción y visualización

layers <- c(layers_ml(net))
data.frame(capa = layers)

capa
lunch
facebook
coauthor
leisure
work

En adelante, la red total o agregada corresponde a la unión binaria de las cinco capas: dos actores están conectados si lo están en al menos una capa. Cuando se usa otra regla de agregación se indica explícitamente.

# Unión binaria de las capas indicadas, con los 61 actores
# (as.igraph no incluye a los actores ausentes; se agregan como aislados)
agregar_capas <- function(capas_sel) {
  g <- simplify(as.igraph(net, layers = capas_sel))
  faltantes <- setdiff(nombres, V(g)$name)
  add_vertices(g, length(faltantes), name = faltantes)
}

Orden efectivo

Número de actores activos en cada capa.

lista_orden <- list()

for (layer in layers) {
  lista_orden[[layer]] <- data.frame(capa = layer, orden_efectivo = num_vertices_ml(net, layers = layer))
}

bind_rows(lista_orden)

capa	orden_efectivo
lunch	60
facebook	32
coauthor	25
leisure	47
work	60

Tamaño

Número de aristas de cada capa.

lista_tamano <- list()

for (layer in layers) {
  lista_tamano[[layer]] <- data.frame(capa = layer, aristas = num_edges_ml(net, layers1 = layer))
}

bind_rows(lista_tamano)

capa	aristas
lunch	193
facebook	124
coauthor	21
leisure	88
work	194

Densidad

Proporción de pares de actores conectados respecto a todos los pares posibles en cada capa.

lista_densidad <- list()

for (layer in layers) {
  n <- num_vertices_ml(net, layers = layer)
  m <- num_edges_ml(net, layers1 = layer, layers2 = layer)
  densidad <- (2 * m) / (n * (n - 1))

  lista_densidad[[layer]] <- data.frame(capa = layer, densidad = round(densidad, 4))
}

bind_rows(lista_densidad)

capa	densidad
lunch	0.109
facebook	0.250
coauthor	0.070
leisure	0.081
work	0.110

Grado medio

Promedio del número de vínculos de los actores en cada capa.

lista_grado_medio <- list()

for (layer in layers) {
  n <- num_vertices_ml(net, layers = layer)
  m <- num_edges_ml(net, layers1 = layer, layers2 = layer)
  grado_medio <- (2 * m) / n

  lista_grado_medio[[layer]] <- data.frame(capa = layer, grado_medio = round(grado_medio, 2))
}

bind_rows(lista_grado_medio)

capa	grado_medio
lunch	6.43
facebook	7.75
coauthor	1.68
leisure	3.74
work	6.47

Distribución de grados

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  d <- degree(g_capa)
  n <- vcount(g_capa)

  par(mfrow = c(1, 1))

  plot(table(factor(d, levels = 0:n)) / n,
       type = "h",
       lwd = 5,
       ylim = c(0, 0.5),
       xlab = "Grado",
       ylab = "Frecuencia relativa",
       main = paste("Distribución del grado - Capa:", layer),
       xaxt = "n",
       col = "gray50")

  axis(side = 1)
}

Componentes

lista_componentes <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  comp <- components(g_capa)

  lista_componentes[[layer]] <- data.frame(
    capa = layer,
    componentes = comp$no,
    tamanos = paste(sort(comp$csize, decreasing = TRUE), collapse = ", ")
  )

  # Color por componente
  V(g_capa)$color <- rainbow(comp$no)[comp$membership]

  plot(
    g_capa,
    vertex.size = 8,
    vertex.label = NA,
    edge.color = "gray75",
    main = paste("Componentes Conexas - Capa:", layer, "\n(Total:", comp$no, "componentes)")
  )
}

bind_rows(lista_componentes)

capa	componentes	tamanos
lunch	1	60
facebook	1	32
coauthor	8	6, 6, 3, 2, 2, 2, 2, 2
leisure	2	44, 3
work	1	60

Tamaño relativo de la componente gigante

Sea \(|C_{max}|\) el número de actores de la componente gigante de una capa y \(n\) el orden efectivo de la capa. El tamaño relativo se calcula respecto a la capa y respecto a los 61 actores de la red:

\[ S_{capa} = \frac{|C_{max}|}{n}, \qquad S_{global} = \frac{|C_{max}|}{61}. \]

lista_gigante <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  comp <- components(g_capa)

  tamano_abs_gigante <- max(comp$csize)
  n_efectivo <- vcount(g_capa)

  # Relativo a los nodos de la capa y a los 61 actores globales
  s_relativo_capa <- tamano_abs_gigante / n_efectivo
  s_relativo_global <- tamano_abs_gigante / 61

  lista_gigante[[layer]] <- data.frame(
    capa = layer,
    nodos_gigante = tamano_abs_gigante,
    relativo_capa = round(s_relativo_capa, 4),
    relativo_global = round(s_relativo_global, 4)
  )
}

bind_rows(lista_gigante)

capa	nodos_gigante	relativo_capa	relativo_global
lunch	60	1.000	0.984
facebook	32	1.000	0.525
coauthor	6	0.240	0.098
leisure	44	0.936	0.721
work	60	1.000	0.984

Transitividad

Transitividad global

lista_trans_global <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  trans <- transitivity(g_capa, type = "global")

  lista_trans_global[[layer]] <- data.frame(capa = layer, transitividad_global = round(trans, 3))
}

bind_rows(lista_trans_global)

capa	transitividad_global
lunch	0.569
facebook	0.481
coauthor	0.429
leisure	0.343
work	0.339

Transitividad local

lista_trans_local <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  trans_mean <- mean(transitivity(g_capa, type = "local"), na.rm = TRUE)

  lista_trans_local[[layer]] <- data.frame(capa = layer, transitividad_local_promedio = round(trans_mean, 3))
}

bind_rows(lista_trans_local)

capa	transitividad_local_promedio
lunch	0.697
facebook	0.540
coauthor	0.670
leisure	0.499
work	0.650

Distancia promedio

lista_dist <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  d <- mean_distance(g_capa)

  lista_dist[[layer]] <- data.frame(capa = layer, distancia_promedio = round(d, 3))
}

bind_rows(lista_dist)

capa	distancia_promedio
lunch	3.19
facebook	1.96
coauthor	1.50
leisure	3.12
work	2.39

Diámetro

lista_diametro <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  d <- diameter(g_capa)

  lista_diametro[[layer]] <- data.frame(capa = layer, diametro = d)
}

bind_rows(lista_diametro)

capa	diametro
lunch	7
facebook	4
coauthor	3
leisure	8
work	4

Fragmentación, cierre y centralización

lista_fragmentacion <- list()

for (layer in layers) {
  # Se mantienen los 61 actores para un N global consistente
  g_capa <- agregar_capas(layer)
  N <- vcount(g_capa)

  # Fragmentación: 1 - proporción de pares conectados
  comp <- components(g_capa)
  pares_conectados <- sum(comp$csize * (comp$csize - 1)) / (N * (N - 1))
  fragmentacion <- 1 - pares_conectados

  # Cierre (transitividad global)
  cierre <- transitivity(g_capa, type = "global")

  # Centralización del grado
  centralizacion <- centr_degree(g_capa)$centralization

  lista_fragmentacion[[layer]] <- data.frame(
    capa = layer,
    fragmentacion = round(fragmentacion, 4),
    cierre = round(cierre, 4),
    centralizacion_grado = round(centralizacion, 4)
  )
}

bind_rows(lista_fragmentacion)

capa	fragmentacion	cierre	centralizacion_grado
lunch	0.033	0.569	0.144
facebook	0.729	0.481	0.182
coauthor	0.979	0.429	0.072
leisure	0.481	0.343	0.185
work	0.033	0.339	0.344

Estabilidad del grado (Spearman)

actores_totales <- unique(vertices_ml(net)$actor)

# Matriz actor x capa con el grado (0 si el actor no está en la capa)
matriz_grados <- matrix(
  0,
  nrow = length(actores_totales),
  ncol = length(layers),
  dimnames = list(actores_totales, layers)
)

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  d <- degree(g_capa)
  matriz_grados[names(d), layer] <- d
}

cor_spearman <- cor(matriz_grados, method = "spearman")

# Matriz de correlación de Spearman (estabilidad del grado)
round(cor_spearman, 3)

	lunch	facebook	coauthor	leisure	work
lunch	1.000	0.281	0.081	0.353	0.328
facebook	0.281	1.000	0.105	0.235	0.266
coauthor	0.081	0.105	1.000	0.067	0.155
leisure	0.353	0.235	0.067	1.000	0.169
work	0.328	0.266	0.155	0.169	1.000

corrplot(
  cor_spearman,
  method = "color",
  type = "upper",
  addCoef.col = "black",
  tl.col = "black",
  tl.srt = 45,
  title = "Correlación de Spearman entre capas (Grado de Actores)",
  mar = c(0, 0, 2, 0)
)

Visualización alineada de las capas y red agregada

# Red agregada ponderada: peso = número de aristas multiplex entre el par
g_multigrafo <- as.igraph(net)
E(g_multigrafo)$weight <- 1
g_agg <- simplify(g_multigrafo, edge.attr.comb = list(weight = "sum", "ignore"))

# Layout global fijo para los 61 actores
set.seed(123)
layout_global <- layout_with_fr(g_agg)
rownames(layout_global) <- V(g_agg)$name

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

# Cinco capas con el layout alineado
for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  nodos_activos <- V(g_capa)$name
  layout_capa <- layout_global[nodos_activos, , drop = FALSE]

  plot(
    g_capa,
    layout = layout_capa,
    vertex.size = 7,
    vertex.label = NA,
    vertex.color = "steelblue",
    edge.color = adjustcolor("gray50", alpha.f = 0.6),
    main = paste("Capa:", layer)
  )
}

# Sexto panel: red agregada ponderada
plot(
  g_agg,
  layout = layout_global,
  vertex.size = 8,
  vertex.label = NA,
  vertex.color = "firebrick",
  edge.width = E(g_agg)$weight * 1.2,
  edge.color = adjustcolor("black", alpha.f = 0.3),
  main = "Red Agregada (Ponderada)"
)

par(mfrow = c(1, 1))

Las capas difieren en tamaño y estructura. Lunch y work incluyen a casi toda la organización (60 de 61 actores) y son conexas, mientras que facebook (32 actores) y coauthor (25) cubren solo una parte. Facebook es la capa más densa (0.25) y con mayor grado medio (7.75); coauthor es la más dispersa (densidad 0.07, grado medio 1.68) y está fragmentada en 8 componentes pequeñas, la mayor de solo 6 actores. Leisure tiene una componente gigante de 44 actores y un grupo separado de 3.

Con un universo común de 61 actores, la fragmentación es casi nula en lunch y work (0.03), intermedia en leisure (0.48) y alta en facebook (0.73) y coauthor (0.98). El cierre es mayor en lunch (0.57) y facebook (0.48), y menor en leisure y work (0.34): en el trabajo es frecuente que una persona colabore con dos que no colaboran entre sí. Work es además la capa más centralizada (0.34): unos pocos actores concentran muchas relaciones laborales.

La estabilidad del grado entre capas es baja: las correlaciones de Spearman van de 0.07 a 0.35, de modo que tener muchos contactos en una relación no implica tenerlos en otra. Coauthor es la capa menos relacionada con las demás. En la visualización alineada, la red agregada ponderada parece más cohesionada que cualquier capa individual, porque reúne vínculos que en cada relación están separados; actores como U123, el de mayor grado en work y ausente en leisure, aparecen como centrales en la red agregada sin serlo en todas las relaciones.

3.3 Superposición y redundancia

Matriz de superposición de aristas

# Identificador único de arista no dirigida por capa
df_aristas <- df_relaciones %>%
  mutate(
    Actor1 = pmin(Actor_Origen, Actor_Destino),
    Actor2 = pmax(Actor_Origen, Actor_Destino),
    edge_id = paste(Actor1, Actor2, sep = "--")
  ) %>%
  distinct(Capa_Origen, edge_id)

head(df_aristas)

Capa_Origen	edge_id
lunch	U123–U67
lunch	U123–U71
lunch	U123–U79
lunch	U124–U126
lunch	U124–U47
lunch	U124–U99

capas <- unique(df_aristas$Capa_Origen)
J <- matrix(
  0,
  nrow = length(capas),
  ncol = length(capas),
  dimnames = list(capas, capas)
)

for (i in capas) {
  for (j in capas) {
    set_i <- unique(df_aristas[df_aristas$Capa_Origen == i, "edge_id"])
    set_j <- unique(df_aristas[df_aristas$Capa_Origen == j, "edge_id"])

    num_interseccion <- length(intersect(set_i, set_j))
    num_union        <- length(union(set_i, set_j))

    J[i, j] <- ifelse(num_union == 0, 0, num_interseccion / num_union)
  }
}

# Matriz de superposición de aristas (Jaccard)
round(J, 3)

	lunch	facebook	coauthor	leisure	work
lunch	1.000	0.178	0.065	0.277	0.339
facebook	0.178	1.000	0.058	0.158	0.187
coauthor	0.065	0.058	1.000	0.101	0.091
leisure	0.277	0.158	0.101	1.000	0.205
work	0.339	0.187	0.091	0.205	1.000

corrplot(
  J,
  method = "color",
  type = "upper",
  addCoef.col = "black",
  tl.col = "black",
  tl.srt = 45,
  is.corr = FALSE,
  col.lim = c(0, 1),
  col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
  title = "Superposición de Aristas J_alpha,beta (Jaccard)",
  mar = c(0, 0, 2, 0)
)

Superposición frente a correlación de grado

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

corrplot(
  J,
  method = "color",
  type = "upper",
  addCoef.col = "black",
  tl.col = "black",
  tl.srt = 45,
  is.corr = FALSE,
  col.lim = c(0, 1),
  col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
  title = "Superposición (Jaccard)",
  mar = c(0, 0, 2, 0)
)

corrplot(
  cor_spearman,
  method = "color",
  type = "upper",
  addCoef.col = "black",
  tl.col = "black",
  tl.srt = 45,
  title = "Correlación de Spearman",
  mar = c(0, 0, 2, 0)
)

par(mfrow = c(1, 1))

Aristas comunes observadas frente a réplicas (modelo nulo)

pares <- combn(capas, 2, simplify = FALSE)

# Pares de capas a comparar
data.frame(do.call(rbind, pares))

X1	X2
lunch	facebook
lunch	coauthor
lunch	leisure
lunch	work
facebook	coauthor
facebook	leisure
facebook	work
coauthor	leisure
coauthor	work
leisure	work

# Identificadores únicos de aristas no dirigidas
get_edge_ids <- function(g) {
  el <- as_edgelist(g, names = TRUE)
  if (nrow(el) == 0) return(character(0))
  apply(el, 1, function(x) paste(sort(x), collapse = "--"))
}

resultados <- list()

for (par in pares) {
  capa1 <- par[1]
  capa2 <- par[2]

  g_capa1 <- as.igraph(net, layers = capa1)
  g_capa2 <- as.igraph(net, layers = capa2)

  total_deg_capa1 <- degree(g_capa1, mode = "all")
  total_deg_capa2 <- degree(g_capa2, mode = "all")

  # Intersección observada
  e1_obs <- get_edge_ids(g_capa1)
  e2_obs <- get_edge_ids(g_capa2)

  obs_comunes <- length(intersect(e1_obs, e2_obs))
  obs_union   <- length(union(e1_obs, e2_obs))
  jaccard_obs <- ifelse(obs_union == 0, 0, obs_comunes / obs_union)

  # Monte Carlo con rewireado que preserva la secuencia de grados
  B <- 1000
  set.seed(123)

  null_counts   <- numeric(B)
  null_jaccards <- numeric(B)

  for (b in seq_len(B)) {
    g_null_1 <- sample_degseq(total_deg_capa1, method = "edge.switching.simple")
    g_null_2 <- sample_degseq(total_deg_capa2, method = "edge.switching.simple")

    V(g_null_1)$name <- V(g_capa1)$name
    V(g_null_2)$name <- V(g_capa2)$name

    e1_null <- get_edge_ids(g_null_1)
    e2_null <- get_edge_ids(g_null_2)

    inter_null <- length(intersect(e1_null, e2_null))
    union_null <- length(union(e1_null, e2_null))

    null_counts[b]   <- inter_null
    null_jaccards[b] <- ifelse(union_null == 0, 0, inter_null / union_null)
  }

  mu_null <- mean(null_counts)
  sd_null <- sd(null_counts)
  z_score <- if (!is.na(sd_null) && sd_null > 0) (obs_comunes - mu_null) / sd_null else NA_real_

  p_upper <- (1 + sum(null_counts >= obs_comunes)) / (B + 1)
  p_lower <- (1 + sum(null_counts <= obs_comunes)) / (B + 1)
  p_mc    <- min(1, 2 * min(p_upper, p_lower))

  resultados[[paste(capa1, "vs", capa2)]] <- data.frame(
    Par_Capas    = paste(capa1, "vs", capa2),
    Obs_Comunes  = obs_comunes,
    Mean_Null    = round(mu_null, 3),
    SD_Null      = round(sd_null, 3),
    Jaccard_Obs  = round(jaccard_obs, 3),
    Jaccard_Null = round(mean(null_jaccards), 3),
    Z_Score      = round(z_score, 3),
    p_mc         = round(p_mc, 3),
    row.names    = NULL
  )
}

df_resultados_nulos <- do.call(rbind, resultados)
df_resultados_nulos

	Par_Capas	Obs_Comunes	Mean_Null	SD_Null	Jaccard_Obs	Jaccard_Null	Z_Score	p_mc
lunch vs facebook	lunch vs facebook	48	17.74	3.33	0.178	0.059	9.09	0.002
lunch vs coauthor	lunch vs coauthor	13	2.27	1.38	0.065	0.011	7.78	0.002
lunch vs leisure	lunch vs leisure	61	12.49	3.01	0.277	0.047	16.09	0.002
lunch vs work	lunch vs work	98	25.24	4.03	0.339	0.070	18.05	0.002
facebook vs coauthor	facebook vs coauthor	8	2.82	1.31	0.058	0.020	3.95	0.002
facebook vs leisure	facebook vs leisure	29	10.38	2.41	0.158	0.052	7.73	0.002
facebook vs work	facebook vs work	50	25.37	3.34	0.187	0.087	7.38	0.002
coauthor vs leisure	coauthor vs leisure	10	1.40	1.07	0.101	0.013	8.01	0.002
coauthor vs work	coauthor vs work	18	3.11	1.45	0.091	0.015	10.26	0.002
leisure vs work	leisure vs work	48	8.79	2.45	0.205	0.032	15.99	0.002

En los diez pares de capas, el número de aristas comunes es muy superior al esperado bajo el modelo nulo que preserva los grados (\(z\) entre 3.9 y 18.6; \(p = 0.002\) en todos los casos, el mínimo posible con 1000 réplicas). La superposición no se explica por los grados de los actores: las relaciones tienden a repetirse entre los mismos pares. Las capas más redundantes son lunch y work (Jaccard 0.34, 98 aristas comunes) y lunch y leisure (0.28); las más complementarias son las que involucran a coauthor (Jaccard menor que 0.11) y a facebook. En términos generales, la matriz de Jaccard y la de Spearman coinciden: los pares de capas que comparten más aristas también tienen grados más correlacionados, y coauthor es la capa más distinta en ambas.

Relevancia y redundancia

relevance_ml devuelve el porcentaje de vecinos presentes en una capa específica. xrelevance_ml devuelve el porcentaje de vecinos presentes en una capa específica y no en otras.

# Relevancia y relevancia exclusiva por capa
lista_relevancias <- list()

for (i in capas) {
  rele_ml  <- relevance_ml(net, actors = actores_totales, layers = i, mode = "all")
  xrele_ml <- xrelevance_ml(net, actors = actores_totales, layers = i, mode = "all")

  lista_relevancias[[i]] <- data.frame(
    Actor = actores_totales,
    Capa = i,
    Relevance_ML = as.vector(rele_ml),
    XRelevance_ML = as.vector(xrele_ml)
  )
}

df_relevancias_todas <- bind_rows(lista_relevancias)

df_work <- lista_relevancias[["work"]]
head(df_work)

Actor	Capa	Relevance_ML	XRelevance_ML
U33	work	0.900	0.400
U139	work	0.917	0.917
U102	work	NA	NA
U106	work	0.286	0.000
U107	work	0.667	0.222
U118	work	0.750	0.500

Acá, por ejemplo, la relevancia de U37 es de 12.5%, es decir que el 12.5% de todos sus vecinos están en la capa work, y el 0% es exclusivo de esta capa (todas sus conexiones laborales se repiten en al menos otra capa). A diferencia de U138, que tiene en la capa work al 66.7% de sus vecinos totales, y un 16.7% está conectado con él únicamente en esta capa.

Redundancia conectiva

cred_todos <- connective_redundancy_ml(net, actors = actores_totales)

df_redundancia_global <- data.frame(
  Actor = actores_totales,
  Redundancia_Global = round(as.vector(cred_todos), 3)
)

df_redundancia_global <- df_redundancia_global[order(-df_redundancia_global$Redundancia_Global), ]
head(df_redundancia_global, 10)

	Actor	Redundancia_Global
42	U23	0.625
45	U73	0.600
20	U17	0.556
8	U1	0.548
14	U41	0.545
40	U14	0.545
49	U53	0.545
46	U110	0.537
33	U76	0.531
17	U59	0.526

ggplot(df_redundancia_global, aes(x = Redundancia_Global)) +
  geom_density(fill = "#4682B4", alpha = 0.4, color = "#1E3F66", linewidth = 1) +
  geom_rug(alpha = 0.6) +
  labs(
    title = "Distribución de la Redundancia Conectiva Global",
    subtitle = "Estimación de densidad de kernel (KDE)",
    x = "Redundancia Conectiva (CR)",
    y = "Densidad"
  ) +
  theme_minimal()

df_descriptivos <- as.data.frame(as.list(summary(df_redundancia_global$Redundancia_Global)))
df_descriptivos$SD <- sd(df_redundancia_global$Redundancia_Global)
df_descriptivos <- round(df_descriptivos, 3)

df_descriptivos

Min.	X1st.Qu.	Median	Mean	X3rd.Qu.	Max.	SD
0	0.333	0.455	0.392	0.5	0.625	0.155

Actores que dependen del contexto y actores con vínculos reiterados

Los actores que dependen del contexto son aquellos que presentan un xrelevance alto (\(\ge 0.50\)), lo que indica que al menos el \(50\%\) de sus conexiones totales existen exclusivamente en esa capa y no se replican en ningún otro entorno.

Los actores con vínculos reiterados son aquellos que muestran un xrelevance bajo (\(< 0.20\)) combinado con un relevance alto (\(\ge 0.50\)), reflejando que participan activamente en la capa pero replicando contactos que ya poseen en otros contextos.

df_clasificado <- df_relevancias_todas %>%
  mutate(
    Categoria = case_when(
      XRelevance_ML >= 0.50 ~ "Dependiente del Contexto",
      Relevance_ML >= 0.50 & XRelevance_ML < 0.20 ~ "Vínculos Reiterados",
      TRUE ~ "General / No Especializado"
    )
  )

table(df_clasificado$Capa, df_clasificado$Categoria)

	Dependiente del Contexto	General / No Especializado	Vínculos Reiterados
coauthor	0	60	1
facebook	1	52	8
leisure	0	52	9
lunch	6	38	17
work	6	42	13

actores_contextuales <- df_clasificado %>%
  filter(Categoria == "Dependiente del Contexto")

head(actores_contextuales)

Actor	Capa	Relevance_ML	XRelevance_ML	Categoria
U102	lunch	1.000	1.000	Dependiente del Contexto
U134	lunch	0.923	0.692	Dependiente del Contexto
U37	lunch	0.750	0.625	Dependiente del Contexto
U48	lunch	0.750	0.625	Dependiente del Contexto
U92	lunch	0.833	0.667	Dependiente del Contexto
U141	lunch	1.000	0.500	Dependiente del Contexto

actores_multiplex <- df_clasificado %>%
  filter(Categoria == "Vínculos Reiterados")

head(actores_multiplex)

Actor	Capa	Relevance_ML	XRelevance_ML	Categoria
U33	lunch	0.600	0.100	Vínculos Reiterados
U1	lunch	0.500	0.000	Vínculos Reiterados
U29	lunch	0.556	0.111	Vínculos Reiterados
U17	lunch	0.750	0.000	Vínculos Reiterados
U18	lunch	0.667	0.083	Vínculos Reiterados
U3	lunch	0.636	0.182	Vínculos Reiterados

Lunch y work concentran los actores dependientes del contexto (6 en cada una) y la mayoría de los actores con vínculos reiterados (17 y 13), mientras que en coauthor casi ningún actor cumple alguno de los dos criterios. La redundancia conectiva tiene una mediana de 0.45: cerca de la mitad de las conexiones de un actor se repiten con el mismo vecino en más de una capa.

3.4 Participación entre capas

Grado por capa y coeficiente de participación

df_grados_capas <- data.frame(Actor = actors_ml(net))

for (capa in layers_ml(net)) {
  nombre_col <- paste0("capa_", capa)
  df_grados_capas[[nombre_col]] <- as.vector(degree_ml(net, layers = capa, mode = "all"))
}
df_grados_capas$Grado_Multicapa <- degree_ml(net, mode = "all")
df_grados_capas[is.na(df_grados_capas)] <- 0
head(df_grados_capas)

actor	capa_lunch	capa_facebook	capa_coauthor	capa_leisure	capa_work	Grado_Multicapa
U33	6	0	0	0	9	15
U139	1	0	0	0	11	12
U102	2	0	0	0	0	2
U106	7	7	1	2	4	21
U107	3	5	0	3	6	17
U118	6	0	2	2	9	19

df_grados_capas$participacion <- with(df_grados_capas, 1 - (
  (capa_leisure  / Grado_Multicapa)^2 +
  (capa_work     / Grado_Multicapa)^2 +
  (capa_facebook / Grado_Multicapa)^2 +
  (capa_lunch    / Grado_Multicapa)^2 +
  (capa_coauthor / Grado_Multicapa)^2
))
df_grados_capas$participacion[is.nan(df_grados_capas$participacion)] <- 0
df_grados_capas <- df_grados_capas %>%
  arrange(desc(participacion))
head(df_grados_capas)

actor	capa_lunch	capa_facebook	capa_coauthor	capa_leisure	capa_work	Grado_Multicapa	participacion
U110	7	9	4	7	14	41	0.767
U91	7	14	3	14	8	46	0.757
U76	9	10	2	7	4	32	0.756
U29	5	5	1	2	4	17	0.754
U10	3	5	1	6	7	22	0.752
U18	8	8	2	4	3	25	0.749

Desviación del grado

degree_deviation_ml devuelve la desviación estándar del grado de un actor en las capas. Un actor con el mismo grado en todas las capas tendrá una desviación de 0, mientras que un actor con muchos vecinos en una capa y pocos en otra tendrá un valor alto de desviación, mostrando un uso desbalanceado de las capas.

dev_grado <- degree_deviation_ml(net, mode = "all")

df_dev_capas <- data.frame(
  Actor = actors_ml(net),
  Desviacion_grado = dev_grado
)
head(df_dev_capas)

actor	Desviacion_grado
U33	3.79
U139	4.32
U102	0.80
U106	2.48
U107	2.06
U118	3.25

df_participacion_dev <- df_grados_capas %>%
  left_join(df_dev_capas, by = c("actor")) %>%
  select(actor, Grado_Multicapa, participacion, Desviacion_grado)

head(df_participacion_dev)

actor	Grado_Multicapa	participacion	Desviacion_grado
U110	41	0.767	3.31
U91	46	0.757	4.26
U76	32	0.756	3.01
U29	17	0.754	1.62
U10	22	0.752	2.15
U18	25	0.749	2.53

ggplot(df_participacion_dev, aes(x = participacion, y = Desviacion_grado)) +
  geom_point(color = "steelblue", size = 3) +
  geom_text(aes(label = actor), vjust = -0.7, size = 3) +
  theme_minimal() +
  labs(
    x = "Participación (P_i)",
    y = "Desviación del Grado"
  )

Identificación de actores

Vamos a revisar esto a través de unas reglas definidas por nosotros. Aquellos con una alta participación serán aquellos donde los valores de \(P_i\) son altos, digamos, mayores o iguales a \(0.40\), con baja dispersión (desviación del grado menor a la mediana).

actores_centrales_multicapa <- df_participacion_dev %>%
  filter(
    Grado_Multicapa >= quantile(Grado_Multicapa, 0.5),
    participacion >= 0.40,
    Desviacion_grado < median(Desviacion_grado)
  )

actores_centrales_multicapa

actor	Grado_Multicapa	participacion	Desviacion_grado
U10	22	0.752	2.15
U18	25	0.749	2.53
U113	19	0.742	2.04
U65	18	0.735	2.06
U42	19	0.731	2.23
U106	21	0.730	2.48
U59	19	0.726	2.31
U99	18	0.698	2.58

Por lo tanto, los actores U10, U18, U113, U65, U42, U106, U59 y U99 serán los actores centrales, por su alto grado multicapa y alta participación.

actores_perifericos <- df_participacion_dev %>%
  filter(
    Grado_Multicapa < quantile(Grado_Multicapa, 0.5),
    participacion < 0.40
  )

head(actores_perifericos)

actor	Grado_Multicapa	participacion	Desviacion_grado
U139	12	0.153	4.32
U102	2	0.000	0.80
U140	2	0.000	0.80

Y los actores U140, U102, U139 son los actores cuya importancia agregada es baja, es decir, no aportan tanto a toda la red multicapa, junto con una cantidad de grados multicapa menor al percentil 50.

3.5 Distancias, conectividad y robustez

Análisis de componentes

lista_componentes_35 <- list()

for (layer in layers) {
  g_capa <- as.igraph(net, layers = layer)
  comp <- components(g_capa)

  tamano_gigante <- max(comp$csize)
  prop_gigante <- round((tamano_gigante / vcount(g_capa)) * 100, 2)

  lista_componentes_35[[layer]] <- data.frame(
    capa = layer,
    componentes = comp$no,
    tamanos = paste(sort(comp$csize, decreasing = TRUE), collapse = ", "),
    componente_gigante = tamano_gigante,
    cobertura_pct = prop_gigante
  )

  V(g_capa)$color <- rainbow(comp$no)[comp$membership]

  plot(
    g_capa,
    vertex.size = 8,
    vertex.label = NA,
    edge.color = "gray75",
    main = paste("Capa:", layer, "\nComp. Gigante:", tamano_gigante, "nodos (", prop_gigante, "%)")
  )
}

bind_rows(lista_componentes_35)

capa	componentes	tamanos	componente_gigante	cobertura_pct
lunch	1	60	60	100.0
facebook	1	32	32	100.0
coauthor	8	6, 6, 3, 2, 2, 2, 2, 2	6	24.0
leisure	2	44, 3	44	93.6
work	1	60	60	100.0

En la red multicapa, aquellas capas donde la componente gigante no es toda la capa, es decir, que tienen mínimo dos componentes conexas, son coauthor y leisure.

Distancias geodésicas, distancia promedio y diámetro

La distancia geodésica entre dos actores es el número de aristas del camino más corto que los une. Para cada capa se calcula la matriz de distancias entre todos los pares de actores y se conserva cada pareja una sola vez; los pares que no pueden alcanzarse quedan sin distancia (NA).

lista_parejas <- list()

for (capa in layers_ml(net)) {
  g_capa <- as.igraph(net, layers = capa)
  D <- distances(graph = g_capa, mode = "all")
  # Pares no alcanzables: sin distancia definida
  D[is.infinite(D)] <- NA

  # Parejas únicas (triángulo superior)
  idx <- which(upper.tri(D), arr.ind = TRUE)

  lista_parejas[[capa]] <- data.frame(
    capa = capa,
    Actor1 = rownames(D)[idx[, 1]],
    Actor2 = colnames(D)[idx[, 2]],
    distancia = D[idx]
  )
}

df_distancias_todas <- bind_rows(lista_parejas)
head(df_distancias_todas)

capa	Actor1	Actor2	distancia
lunch	U33	U139	2
lunch	U33	U102	1
lunch	U139	U102	1
lunch	U33	U106	3
lunch	U139	U106	5
lunch	U102	U106	4

La distancia promedio es el promedio de las distancias geodésicas entre los pares de actores que pueden alcanzarse en cada capa.

list_mean_distance <- list()

for (capa in layers_ml(net)) {
  g_capa <- as.igraph(net, layers = capa)
  list_mean_distance[[capa]] <- data.frame(
    capa = capa,
    mean_distancia = mean_distance(g_capa)
  )
}

df_mean_distancias <- bind_rows(list_mean_distance)
head(df_mean_distancias)

capa	mean_distancia
lunch	3.19
facebook	1.96
coauthor	1.50
leisure	3.12
work	2.39

El diámetro es la mayor distancia geodésica entre dos actores de la capa, es decir, el camino más corto más largo.

list_diametre <- list()

for (capa in layers_ml(net)) {
  g_capa <- as.igraph(net, layers = capa)
  list_diametre[[capa]] <- data.frame(
    capa = capa,
    Diameter = diameter(g_capa)
  )
}

df_diameter <- bind_rows(list_diametre)
head(df_diameter)

capa	Diameter
lunch	7
facebook	4
coauthor	3
leisure	8
work	4

Puentes, puntos de articulación y conectividad

list_conectividad <- list()

for (capa in layers_ml(net)) {
  g_capa <- as.igraph(net, layers = capa)

  puntos_art <- articulation_points(g_capa)
  puentes_edges <- bridges(g_capa)
  con_nodal <- vertex_connectivity(g_capa)
  con_aristas <- edge_connectivity(g_capa)

  list_conectividad[[capa]] <- data.frame(
    capa = capa,
    num_puntos_articulacion = length(puntos_art),
    nombres_puntos_articulacion = ifelse(
      length(puntos_art) > 0,
      paste(names(puntos_art), collapse = ", "),
      "Ninguno"
    ),
    num_puentes = length(puentes_edges),
    conectividad_nodal = con_nodal,
    conectividad_aristas = con_aristas,
    stringsAsFactors = FALSE
  )
}

df_conectividad <- bind_rows(list_conectividad)
head(df_conectividad)

capa	num_puntos_articulacion	nombres_puntos_articulacion	num_puentes	conectividad_nodal	conectividad_aristas
lunch	4	U102, U32, U130, U33	4	1	1
facebook	0	Ninguno	0	2	2
coauthor	3	U118, U110, U130	10	0	0
leisure	11	U126, U42, U1, U76, U90, U10, U68, U142, U67, U110, U91	12	0	0
work	1	U67	1	1	1

Facebook es la única capa sin puntos de articulación ni puentes, con conectividad de vértices y de aristas igual a 2. Lunch y work tienen conectividad 1: un solo actor (U67 en work; U102, U33, U32 o U130 en lunch) puede separar a parte de la organización. Leisure es la capa más vulnerable, con 11 puntos de articulación y 12 puentes, y coauthor ya está fragmentada.

Robustez: eliminación de una capa

capas <- layers_ml(net)

g_total <- agregar_capas(capas)
tamano_gigante <- max(components(g_total)$csize)

list_robustez_1 <- list()

for (capa in capas) {
  capas_restantes <- setdiff(capas, capa)
  g_agregada <- agregar_capas(capas_restantes)

  comp <- components(g_agregada)
  tamano_relativo <- max(comp$csize) / tamano_gigante

  list_robustez_1[[capa]] <- data.frame(
    capa_eliminada = capa,
    tamano_relativo = round(tamano_relativo, 4),
    mean_distancia = round(mean_distance(g_agregada, unconnected = TRUE), 4),
    con_nodal = vertex_connectivity(g_agregada),
    con_aristas = edge_connectivity(g_agregada),
    stringsAsFactors = FALSE
  )
}

df_robustez <- bind_rows(list_robustez_1)
df_robustez

capa_eliminada	tamano_relativo	mean_distancia	con_nodal	con_aristas
lunch	0.984	2.12	0	0
facebook	1.000	2.16	2	2
coauthor	1.000	2.06	2	2
leisure	1.000	2.10	2	2
work	0.984	2.30	0	0

Robustez: eliminación de pares de capas

pares_capas <- combn(capas, 2, simplify = FALSE)

# Pérdida de la componente gigante al eliminar cada capa sola
perdida_individual <- setNames(1 - df_robustez$tamano_relativo, df_robustez$capa_eliminada)

list_robustez_2 <- list()

for (par_capas in pares_capas) {
  capas_restantes <- setdiff(capas, par_capas)
  g_agregada <- agregar_capas(capas_restantes)

  comp <- components(g_agregada)
  tamano_relativo <- max(comp$csize) / tamano_gigante

  # Efecto conjunto que excede la suma de los efectos individuales
  perdida_par <- 1 - tamano_relativo
  efecto_extra <- perdida_par - sum(perdida_individual[par_capas])

  list_robustez_2[[paste(par_capas, collapse = "-")]] <- data.frame(
    capas_eliminadas = paste(par_capas, collapse = " + "),
    tamano_relativo = round(tamano_relativo, 4),
    mean_distancia = round(mean_distance(g_agregada, unconnected = TRUE), 4),
    con_nodal = vertex_connectivity(g_agregada),
    con_aristas = edge_connectivity(g_agregada),
    efecto_extra = round(efecto_extra, 4),
    stringsAsFactors = FALSE
  )
}

df_robustez_2 <- bind_rows(list_robustez_2) %>%
  arrange(tamano_relativo)
df_robustez_2

capas_eliminadas	tamano_relativo	mean_distancia	con_nodal	con_aristas	efecto_extra
lunch + work	0.885	2.51	0	0	0.082
lunch + facebook	0.984	2.26	0	0	0.000
lunch + coauthor	0.984	2.12	0	0	0.000
lunch + leisure	0.984	2.18	0	0	0.000
facebook + work	0.984	2.60	0	0	0.000
coauthor + work	0.984	2.30	0	0	0.000
leisure + work	0.984	2.35	0	0	0.000
facebook + coauthor	1.000	2.16	2	2	0.000
facebook + leisure	1.000	2.25	2	2	0.000
coauthor + leisure	1.000	2.10	2	2	0.000

Robustez: Capas indispensables o complementarias.

Lunch y work son las capas indispensables para la conectividad: al eliminar cualquiera de ellas un actor queda aislado, y al eliminarlas juntas la componente gigante pierde cerca del 12% de los actores y la distancia promedio sube de 2.06 a 2.51. Son además complementarias: su efecto conjunto es mayor que la suma de sus efectos individuales (efecto extra de 0.082). Facebook, coauthor y leisure pueden eliminarse, incluso de a dos, sin desconectar a ningún actor.

3.6 Cohesión y k-cores.

Diadas y triadas.

# Redes a comparar: las 5 capas y la red total (unión binaria)
redes <- c(capas, "total")

obtener_red <- function(red) {
  if (red == "total") agregar_capas(capas) else as.igraph(net, layers = red)
}

lista_diadas <- list()

for (capa in redes) {
  g_capa <- obtener_red(capa)

  # La red es no dirigida: igraph cuenta cada arista como díada mutua
  dyads <- suppressWarnings(dyad_census(g_capa))

  lista_diadas[[capa]] <- data.frame(
    capa = capa,
    n_actores = vcount(g_capa),
    mutuas = dyads$mut,
    asimetricas = dyads$asym,
    nulas = dyads$null,
    total_diadas = dyads$mut + dyads$asym + dyads$null,
    prop_conectadas = round(dyads$mut / (dyads$mut + dyads$asym + dyads$null), 4)
  )
}

df_diadas <- bind_rows(lista_diadas)
rownames(df_diadas) <- NULL
df_diadas

capa	n_actores	mutuas	asimetricas	nulas	total_diadas	prop_conectadas
lunch	60	193	0	1577	1770	0.109
facebook	32	124	0	372	496	0.250
coauthor	25	21	0	279	300	0.070
leisure	47	88	0	993	1081	0.081
work	60	194	0	1576	1770	0.110
total	61	353	0	1477	1830	0.193

# Etiquetas de las 16 tríadas dirigidas
triad_labels <- c(
  "003", "012", "102", "021D", "021U", "021C",
  "111D", "111U", "030T", "030C", "201",
  "120D", "120U", "120C", "210", "300"
)

lista_triadas <- list()

for (capa in redes) {
  g_capa <- obtener_red(capa)

  # Red no dirigida: cada arista se trata como mutua
  obs_counts <- suppressWarnings(triad_census(g_capa))
  names(obs_counts) <- triad_labels

  lista_triadas[[capa]] <- data.frame(capa = capa, t(obs_counts), check.names = FALSE)
}

df_triadas <- bind_rows(lista_triadas)
rownames(df_triadas) <- NULL

# En red no dirigida solo pueden aparecer 4 de los 16 tipos
df_triadas %>%
  select(capa, `003`, `102`, `201`, `300`)

capa	003	102	201	300
lunch	24090	9315	566	249
facebook	2126	2117	548	169
coauthor	1841	439	16	4
leisure	12619	3279	270	47
work	24649	8104	1253	214
total	19202	13511	2515	762

Transitividad global y local

lista_transitividad <- list()

for (capa in redes) {
  g_capa <- obtener_red(capa)

  transitividad_global <- transitivity(g_capa, type = "global")

  # Un valor por actor; NaN para actores con grado < 2
  transitividad_local <- transitivity(g_capa, type = "local")

  lista_transitividad[[capa]] <- data.frame(
    capa = capa,
    global = round(transitividad_global, 3),
    local_promedio = round(mean(transitividad_local, na.rm = TRUE), 3),
    actores_sin_local = sum(is.na(transitividad_local))
  )
}

df_transitividad <- bind_rows(lista_transitividad)
rownames(df_transitividad) <- NULL
df_transitividad

capa	global	local_promedio	actores_sin_local
lunch	0.569	0.697	2
facebook	0.481	0.540	0
coauthor	0.429	0.670	15
leisure	0.343	0.499	10
work	0.339	0.650	1
total	0.476	0.592	0

Cliques

lista_cliques <- list()

for (capa in redes) {
  g_capa <- obtener_red(capa)

  clique_sizes <- vapply(
    cliques(g_capa, min = 1),
    FUN = length,
    FUN.VALUE = integer(1)
  )

  tabla <- table(clique_sizes)

  lista_cliques[[capa]] <- data.frame(
    capa = capa,
    tamano = as.integer(names(tabla)),
    n_cliques = as.vector(tabla)
  )
}

df_cliques <- bind_rows(lista_cliques)
rownames(df_cliques) <- NULL
df_cliques

capa	tamano	n_cliques
lunch	1	60
lunch	2	193
lunch	3	249
lunch	4	193
lunch	5	102
lunch	6	38
lunch	7	9
lunch	8	1
facebook	1	32
facebook	2	124
facebook	3	169
facebook	4	126
facebook	5	61
facebook	6	19
facebook	7	3
coauthor	1	25
coauthor	2	21
coauthor	3	4
leisure	1	47
leisure	2	88
leisure	3	47
leisure	4	11
work	1	60
work	2	194
work	3	214
work	4	108
work	5	26
work	6	2
total	1	61
total	2	353
total	3	762
total	4	931
total	5	761
total	6	433
total	7	165
total	8	38
total	9	4

Coreness

lista_coreness <- list()
lista_core_dist <- list()

for (capa in redes) {
  g_capa <- obtener_red(capa)
  core <- coreness(g_capa)

  # Coreness de cada actor
  lista_coreness[[capa]] <- data.frame(capa = capa, actor = names(core), coreness = core)

  # Distribución: número de actores por valor de k
  tabla <- table(core)

  lista_core_dist[[capa]] <- data.frame(
    capa = capa,
    k = as.integer(names(tabla)),
    n_actores = as.vector(tabla)
  )
}

df_core_dist <- bind_rows(lista_core_dist) %>%
  mutate(capa = factor(capa, levels = redes))
xtabs(n_actores ~ capa + k, data = df_core_dist)

	1	2	3	4	5	6	7	10
lunch	3	2	4	16	26	1	8	0
facebook	0	3	2	5	5	17	0	0
coauthor	16	9	0	0	0	0	0	0
leisure	12	12	10	13	0	0	0	0
work	1	11	15	11	22	0	0	0
total	0	2	1	1	7	5	30	15

# Coreness por actor: una columna por red (0 si el actor no está en la capa)
df_coreness <- bind_rows(lista_coreness)
df_coreness_actor <- reshape(df_coreness, idvar = "actor", timevar = "capa", direction = "wide")
names(df_coreness_actor) <- sub("coreness.", "", names(df_coreness_actor), fixed = TRUE)
df_coreness_actor[is.na(df_coreness_actor)] <- 0
df_coreness_actor <- df_coreness_actor[, c("actor", redes)]
df_coreness_actor <- df_coreness_actor[order(-df_coreness_actor$total), ]
rownames(df_coreness_actor) <- NULL
head(df_coreness_actor, 15)

actor	lunch	facebook	coauthor	leisure	work	total
U123	5	6	0	0	5	10
U124	4	6	0	3	4	10
U109	7	6	0	4	3	10
U130	4	6	2	0	5	10
U134	6	2	1	0	3	10
U18	7	6	2	3	3	10
U3	7	6	0	2	2	10
U47	4	6	2	1	4	10
U54	7	6	0	4	5	10
U62	7	0	0	2	4	10
U76	7	6	2	4	4	10
U79	7	6	0	4	5	10
U90	7	0	0	4	4	10
U99	5	0	2	3	4	10
U4	5	6	0	1	5	10

Lunch es la capa más cohesiva: tiene la mayor transitividad global (0.57), el mayor número de triángulos (249) y los cliques más grandes (8 actores). Leisure y work tienen la transitividad más baja (0.34); en work abundan las tríadas abiertas (1253 frente a 214 triángulos). Coauthor casi no tiene estructura triádica (4 triángulos), y su transitividad local promedio (0.67) se calcula con solo 10 de sus 25 actores.

La red agregada tiene estructuras más cohesivas que cualquier capa: 762 triángulos, cliques de 9 actores y un núcleo con k = 10, cuando el máximo de las capas es k = 7 (lunch). Varios actores pertenecen a núcleos profundos en varias relaciones; por ejemplo, U54, U76 y U79 tienen el coreness máximo en cuatro capas. En cambio, U134 forma parte del núcleo de la red agregada (k = 10) sin alcanzar el núcleo máximo en ninguna capa: su posición central aparece solo después de agregar.

Triángulos de la red agregada

Un triángulo de la red agregada está contenido en una capa si sus tres aristas pertenecen a esa misma capa; en caso contrario, se forma combinando aristas de relaciones distintas.

# Identificador de cada triángulo: los tres actores ordenados
triangulos_id <- function(g) {
  t <- triangles(g)
  if (length(t) == 0) return(character(0))
  m <- matrix(V(g)$name[t], ncol = 3, byrow = TRUE)
  apply(m, 1, function(x) paste(sort(x), collapse = "--"))
}

# Triángulos de cada capa y de la red agregada
tri_capa <- lapply(capas, function(capa) triangulos_id(obtener_red(capa)))
tri_total <- triangulos_id(obtener_red("total"))

# Triángulos de la red agregada que no están contenidos en ninguna capa
tri_mixtos <- setdiff(tri_total, Reduce(union, tri_capa))

data.frame(
  triangulos_agregada = length(tri_total),
  contenidos_en_una_capa = length(tri_total) - length(tri_mixtos),
  solo_combinando_capas = length(tri_mixtos)
)

triangulos_agregada	contenidos_en_una_capa	solo_combinando_capas
762	546	216

De los 762 triángulos de la red agregada, 216 (28%) no están contenidos en ninguna capa: se forman combinando aristas de relaciones distintas. La existencia de un triángulo en la red agregada no implica que los tres actores formen un grupo en algún contexto relacional, ya que sus aristas pueden provenir de capas distintas.

3.7 Caracterización de vértices

Medidas de centralidad por red

lista_centralidad <- list()

for (red in redes) {
  g_red <- obtener_red(red)

  lista_centralidad[[red]] <- data.frame(
    red = red,
    actor = V(g_red)$name,
    grado = degree(g_red),
    grado_norm = degree(g_red, normalized = TRUE),
    cercania = closeness(g_red, normalized = FALSE, weights = NA),
    cercania_norm = closeness(g_red, normalized = TRUE, weights = NA),
    armonica = harmonic_centrality(g_red, normalized = TRUE, weights = NA),
    intermediacion = betweenness(g_red, directed = FALSE, normalized = FALSE, weights = NA),
    intermediacion_norm = betweenness(g_red, directed = FALSE, normalized = TRUE, weights = NA),
    propia = eigen_centrality(g_red, weights = NA)$vector,
    coreness = coreness(g_red)
  )
}

df_centralidad <- bind_rows(lista_centralidad)
rownames(df_centralidad) <- NULL
head(df_centralidad)

red	actor	grado	grado_norm	cercania	cercania_norm	armonica	intermediacion	intermediacion_norm	propia	coreness
lunch	U33	6	0.102	0.006	0.358	0.430	114.0	0.067	0.176	5
lunch	U139	1	0.017	0.004	0.211	0.235	0.0	0.000	0.002	1
lunch	U102	2	0.034	0.005	0.267	0.307	58.0	0.034	0.021	1
lunch	U106	7	0.119	0.005	0.316	0.398	194.8	0.114	0.049	5
lunch	U107	3	0.051	0.004	0.254	0.302	0.0	0.000	0.007	3
lunch	U118	6	0.102	0.004	0.255	0.331	0.2	0.000	0.022	5

Tablas por medida

Cada tabla tiene una fila por actor y una columna por red, ordenada de mayor a menor según la red total (NA si el actor no está en la capa).

medidas <- c("grado", "grado_norm", "cercania", "cercania_norm", "armonica",
             "intermediacion", "intermediacion_norm", "propia", "coreness")

tablas_centralidad <- list()

for (medida in medidas) {
  # Matriz actor x red (NA si el actor no está en la capa)
  tabla <- matrix(
    NA,
    nrow = length(nombres),
    ncol = length(redes),
    dimnames = list(nombres, redes)
  )

  for (red in redes) {
    datos <- df_centralidad[df_centralidad$red == red, ]
    tabla[datos$actor, red] <- datos[[medida]]
  }

  tabla <- data.frame(actor = nombres, tabla)

  # De mayor a menor según la red total
  tabla <- tabla[order(-tabla$total), ]
  rownames(tabla) <- NULL
  tablas_centralidad[[medida]] <- tabla
}

# Ejemplo: ver una medida
head(tablas_centralidad[["intermediacion_norm"]], 10)

actor	lunch	facebook	coauthor	leisure	work	total
U4	0.282	0.043	NA	0.000	0.226	0.133
U123	0.015	0.089	NA	NA	0.277	0.111
U91	0.010	0.118	0.005	0.272	0.007	0.071
U67	0.090	0.092	NA	0.041	0.227	0.064
U79	0.135	0.135	NA	0.196	0.018	0.060
U71	0.013	0.017	NA	NA	0.103	0.050
U110	0.074	0.019	0.025	0.087	0.105	0.044
U130	0.328	0.070	0.029	NA	0.082	0.043
U26	0.000	NA	0.000	0.000	0.061	0.040
U32	0.264	0.040	0.000	0.003	0.061	0.037

Medidas de centralidad en la red total

df_centralidad_total <- df_centralidad %>%
  filter(red == "total") %>%
  select(-red) %>%
  arrange(desc(grado))

head(df_centralidad_total, 10)

actor	grado	grado_norm	cercania	cercania_norm	armonica	intermediacion	intermediacion_norm	propia	coreness
U123	29	0.483	0.011	0.659	0.742	196.9	0.111	1.000	10
U4	26	0.433	0.011	0.632	0.714	235.3	0.133	0.860	10
U79	24	0.400	0.010	0.612	0.694	106.2	0.060	0.887	10
U67	23	0.383	0.010	0.612	0.689	113.0	0.064	0.681	7
U91	22	0.367	0.010	0.594	0.675	125.9	0.071	0.694	7
U130	21	0.350	0.010	0.600	0.672	75.6	0.043	0.814	10
U54	19	0.317	0.010	0.577	0.650	51.8	0.029	0.738	10
U110	19	0.317	0.010	0.588	0.656	78.1	0.044	0.653	7
U124	18	0.300	0.010	0.571	0.642	55.0	0.031	0.695	10
U71	18	0.300	0.010	0.588	0.650	88.6	0.050	0.557	7

Distribución ordenada de la centralidad

medidas_norm <- c("grado_norm", "cercania_norm", "armonica",
                  "intermediacion_norm", "propia", "coreness")

lista_codo <- list()

for (red in redes) {
  datos <- df_centralidad[df_centralidad$red == red, ]

  # Coreness dividido por el máximo de la red
  datos$coreness <- datos$coreness / max(datos$coreness)

  for (medida in medidas_norm) {
    # Valores ordenados de mayor a menor
    valores <- sort(datos[[medida]], decreasing = TRUE)

    lista_codo[[paste(red, medida)]] <- data.frame(
      red = red,
      medida = medida,
      posicion = 1:length(valores),
      valor = valores
    )
  }
}

df_codo <- bind_rows(lista_codo)

ggplot(df_codo, aes(x = posicion, y = valor, color = red)) +
  geom_line() +
  geom_point(size = 0.8) +
  facet_wrap(~ medida, scales = "free_y") +
  scale_x_continuous(breaks = seq(0, 60, by = 10)) +
  labs(
    title = "Distribución ordenada de la centralidad",
    x = "Posición del actor (de mayor a menor)",
    y = "Valor normalizado",
    color = "Red"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom")

Visualización de los actores más centrales

graficar_centralidad <- function(red) {
  g_red <- obtener_red(red)

  centralidad <- list(
    "Grado" = degree(g_red, normalized = TRUE),
    "Cercanía" = closeness(g_red, normalized = TRUE, weights = NA),
    "Armónica" = harmonic_centrality(g_red, normalized = TRUE, weights = NA),
    "Intermediación" = betweenness(g_red, directed = FALSE, normalized = TRUE, weights = NA),
    "Propia" = eigen_centrality(g_red, weights = NA)$vector,
    "Coreness" = coreness(g_red) / max(coreness(g_red))
  )

  paletas <- c("Blues 3", "Teal", "Greens 3", "OrRd", "Purples 3", "YlOrBr")

  set.seed(123)
  l <- layout_with_dh(g_red)

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

  for (j in seq_along(centralidad)) {
    x <- centralidad[[j]]
    x[is.na(x)] <- 0

    size <- 3 + 10 * sqrt(x / max(x))
    top <- order(x, decreasing = TRUE)[1:5]

    col_v <- rep(adjustcolor("gray85", alpha.f = 0.50), vcount(g_red))
    pal <- hcl.colors(5, palette = paletas[j])
    # El más central con el color más oscuro
    col_v[top] <- pal

    frame_v <- rep(adjustcolor("gray65", alpha.f = 0.30), vcount(g_red))
    frame_v[top] <- adjustcolor(pal[1], alpha.f = 0.90)

    # Etiquetas con el nombre del actor solo para el top 5
    labs <- rep(NA, vcount(g_red))
    labs[top] <- V(g_red)$name[top]

    plot(
      g_red,
      layout = l,
      vertex.size = size,
      vertex.label = labs,
      vertex.label.cex = 0.9,
      vertex.label.color = "gray10",
      vertex.label.dist = 1.3,
      vertex.label.font = 2,
      vertex.color = col_v,
      vertex.frame.color = frame_v,
      edge.color = adjustcolor("gray45", alpha.f = 0.20),
      edge.width = 0.7,
      main = names(centralidad)[j],
      margin = 0.08
    )
  }

  mtext(paste("Centralidad - Red:", red), outer = TRUE, cex = 1.2, font = 2)
  par(mfrow = c(1, 1))
}

graficar_centralidad("total")

Correlación de Spearman entre redes

Para cada medida se calcula la correlación de Spearman entre los rankings de cada par de redes. Los actores ausentes en una capa toman valor 0.

medidas_spearman <- c("grado", "cercania", "armonica", "intermediacion", "propia", "coreness")
pares_redes <- combn(redes, 2, simplify = FALSE)

lista_spearman <- list()

for (medida in medidas_spearman) {
  # Actor x red; 0 si el actor no está en la capa
  tabla <- tablas_centralidad[[medida]]
  tabla[is.na(tabla)] <- 0

  for (par_redes in pares_redes) {
    rho <- cor(tabla[[par_redes[1]]], tabla[[par_redes[2]]], method = "spearman")

    lista_spearman[[paste(medida, par_redes[1], par_redes[2])]] <- data.frame(
      medida = medida,
      par = paste(par_redes, collapse = " - "),
      rho = round(rho, 3)
    )
  }
}

df_spearman <- bind_rows(lista_spearman) %>%
  arrange(medida, desc(rho))
rownames(df_spearman) <- NULL
df_spearman

medida	par	rho
armonica	work - total	0.782
armonica	facebook - total	0.696
armonica	lunch - total	0.556
armonica	lunch - facebook	0.384
armonica	facebook - work	0.366
armonica	lunch - work	0.315
armonica	facebook - leisure	0.262
armonica	leisure - total	0.224
armonica	coauthor - total	0.157
armonica	coauthor - work	0.130
armonica	lunch - leisure	0.114
armonica	facebook - coauthor	0.099
armonica	lunch - coauthor	0.059
armonica	leisure - work	0.004
armonica	coauthor - leisure	-0.017
cercania	work - total	0.803
cercania	facebook - total	0.682
cercania	lunch - total	0.503
cercania	facebook - work	0.386
cercania	lunch - facebook	0.369
cercania	lunch - work	0.333
cercania	facebook - leisure	0.186
cercania	leisure - total	0.154
cercania	coauthor - total	0.094
cercania	coauthor - leisure	0.067
cercania	coauthor - work	0.064
cercania	facebook - coauthor	0.046
cercania	leisure - work	-0.080
cercania	lunch - leisure	-0.099
cercania	lunch - coauthor	-0.142
coreness	facebook - total	0.585
coreness	lunch - total	0.578
coreness	work - total	0.400
coreness	leisure - total	0.373
coreness	lunch - leisure	0.295
coreness	lunch - facebook	0.261
coreness	facebook - leisure	0.214
coreness	facebook - work	0.184
coreness	leisure - work	0.175
coreness	facebook - coauthor	0.115
coreness	coauthor - leisure	0.094
coreness	lunch - work	0.072
coreness	coauthor - total	0.067
coreness	coauthor - work	0.047
coreness	lunch - coauthor	0.031
grado	facebook - total	0.699
grado	work - total	0.644
grado	lunch - total	0.613
grado	lunch - leisure	0.353
grado	lunch - work	0.328
grado	leisure - total	0.296
grado	lunch - facebook	0.281
grado	facebook - work	0.266
grado	facebook - leisure	0.235
grado	coauthor - total	0.200
grado	leisure - work	0.169
grado	coauthor - work	0.155
grado	facebook - coauthor	0.105
grado	lunch - coauthor	0.081
grado	coauthor - leisure	0.067
intermediacion	work - total	0.769
intermediacion	facebook - total	0.640
intermediacion	lunch - total	0.535
intermediacion	lunch - work	0.373
intermediacion	facebook - leisure	0.343
intermediacion	leisure - total	0.341
intermediacion	facebook - work	0.330
intermediacion	lunch - facebook	0.318
intermediacion	coauthor - work	0.215
intermediacion	leisure - work	0.198
intermediacion	coauthor - total	0.197
intermediacion	lunch - leisure	0.183
intermediacion	facebook - coauthor	0.161
intermediacion	lunch - coauthor	0.113
intermediacion	coauthor - leisure	0.025
propia	facebook - total	0.728
propia	work - total	0.675
propia	lunch - total	0.638
propia	lunch - facebook	0.409
propia	facebook - work	0.323
propia	lunch - coauthor	0.311
propia	lunch - leisure	0.302
propia	facebook - leisure	0.301
propia	leisure - total	0.300
propia	coauthor - total	0.254
propia	coauthor - leisure	0.159
propia	coauthor - work	0.116
propia	lunch - work	0.099
propia	facebook - coauthor	0.099
propia	leisure - work	-0.016

# Una gráfica por medida, con los pares ordenados de mayor a menor correlación
par(mfrow = c(2, 3), mar = c(8, 4, 3, 1))

for (medida in medidas_spearman) {
  datos <- df_spearman[df_spearman$medida == medida, ]
  datos <- datos[order(-datos$rho), ]

  # Rojo: pares capa - total; azul: pares capa - capa
  colores <- ifelse(grepl("total", datos$par), "firebrick", "steelblue")

  barplot(
    datos$rho,
    names.arg = datos$par,
    las = 2,
    cex.names = 0.7,
    col = colores,
    main = medida,
    ylab = "Correlación de Spearman"
  )
  abline(h = 0)
}

par(mfrow = c(1, 1))

Superposición de los primeros k actores

Para cada medida y cada par de redes se identifican los k actores más centrales de cada red y se cuenta cuántos aparecen en ambas listas. Se usa k = 10, que corresponde al codo visual de la distribución ordenada del grado, la intermediación y la centralidad propia: en esas medidas los valores caen rápidamente en los primeros diez actores y a partir de ahí las diferencias entre actores consecutivos son pequeñas.

# Número de actores principales a comparar (elegido con el codo)
k <- 10

lista_topk <- list()

for (medida in medidas_spearman) {
  # Actor x red; 0 si el actor no está en la capa
  tabla <- tablas_centralidad[[medida]]
  tabla[is.na(tabla)] <- 0

  for (par_redes in pares_redes) {
    red1 <- par_redes[1]
    red2 <- par_redes[2]

    # Top k de cada red
    top1 <- tabla$actor[order(-tabla[[red1]])][1:k]
    top2 <- tabla$actor[order(-tabla[[red2]])][1:k]

    comunes <- intersect(top1, top2)

    lista_topk[[paste(medida, red1, red2)]] <- data.frame(
      medida = medida,
      par = paste(red1, "-", red2),
      comunes = length(comunes),
      proporcion = length(comunes) / k,
      actores_comunes = paste(comunes, collapse = ", ")
    )
  }
}

df_topk <- bind_rows(lista_topk) %>%
  arrange(medida, desc(comunes))
rownames(df_topk) <- NULL
df_topk

medida	par	comunes	proporcion	actores_comunes
armonica	facebook - total	7	0.7	U79, U91, U124, U67, U4, U130, U123
armonica	work - total	6	0.6	U123, U4, U67, U71, U130, U110
armonica	lunch - total	5	0.5	U4, U79, U67, U130, U54
armonica	lunch - facebook	4	0.4	U4, U79, U67, U130
armonica	lunch - leisure	4	0.4	U126, U79, U90, U54
armonica	lunch - work	4	0.4	U4, U67, U97, U130
armonica	facebook - work	4	0.4	U67, U4, U130, U123
armonica	leisure - total	4	0.4	U91, U54, U79, U110
armonica	facebook - coauthor	3	0.3	U91, U130, U47
armonica	coauthor - leisure	3	0.3	U110, U91, U76
armonica	coauthor - total	3	0.3	U130, U110, U91
armonica	lunch - coauthor	2	0.2	U134, U130
armonica	facebook - leisure	2	0.2	U79, U91
armonica	coauthor - work	2	0.2	U130, U110
armonica	leisure - work	1	0.1	U110
cercania	facebook - total	7	0.7	U79, U91, U4, U130, U67, U123, U32
cercania	lunch - work	6	0.6	U4, U130, U97, U67, U123, U71
cercania	lunch - total	6	0.6	U4, U130, U79, U67, U123, U71
cercania	work - total	6	0.6	U123, U67, U4, U71, U130, U110
cercania	lunch - facebook	5	0.5	U4, U130, U79, U67, U123
cercania	facebook - work	4	0.4	U4, U130, U67, U123
cercania	leisure - total	3	0.3	U54, U91, U79
cercania	lunch - leisure	2	0.2	U79, U126
cercania	facebook - coauthor	2	0.2	U32, U142
cercania	facebook - leisure	2	0.2	U79, U91
cercania	coauthor - leisure	1	0.1	U10
cercania	coauthor - work	1	0.1	U26
cercania	coauthor - total	1	0.1	U32
cercania	lunch - coauthor	0	0.0
cercania	leisure - work	0	0.0
coreness	facebook - total	8	0.8	U123, U124, U109, U130, U18, U3, U47, U54
coreness	lunch - facebook	7	0.7	U109, U18, U3, U54, U76, U79, U123
coreness	lunch - total	7	0.7	U109, U18, U3, U54, U62, U134, U123
coreness	lunch - leisure	5	0.5	U109, U54, U76, U79, U90
coreness	facebook - coauthor	4	0.4	U130, U18, U47, U76
coreness	facebook - leisure	4	0.4	U109, U54, U76, U79
coreness	facebook - work	4	0.4	U123, U130, U54, U79
coreness	coauthor - total	4	0.4	U130, U18, U47, U134
coreness	lunch - coauthor	3	0.3	U18, U76, U134
coreness	lunch - work	3	0.3	U54, U79, U123
coreness	coauthor - leisure	3	0.3	U76, U91, U110
coreness	work - total	3	0.3	U123, U130, U54
coreness	leisure - work	2	0.2	U54, U79
coreness	leisure - total	2	0.2	U109, U54
coreness	coauthor - work	1	0.1	U130
grado	facebook - total	7	0.7	U79, U91, U67, U124, U4, U130, U123
grado	work - total	6	0.6	U123, U4, U67, U130, U71, U110
grado	lunch - leisure	5	0.5	U126, U79, U90, U54, U76
grado	facebook - work	5	0.5	U67, U4, U130, U123, U32
grado	lunch - total	4	0.4	U4, U79, U67, U54
grado	leisure - total	4	0.4	U91, U54, U79, U110
grado	lunch - facebook	3	0.3	U4, U79, U67
grado	facebook - coauthor	3	0.3	U91, U130, U47
grado	coauthor - leisure	3	0.3	U110, U91, U76
grado	coauthor - total	3	0.3	U130, U110, U91
grado	lunch - coauthor	2	0.2	U72, U76
grado	lunch - work	2	0.2	U4, U67
grado	facebook - leisure	2	0.2	U79, U91
grado	coauthor - work	2	0.2	U130, U110
grado	leisure - work	1	0.1	U110
intermediacion	coauthor - total	8	0.8	U130, U110, U91, U4, U123, U67, U79, U71
intermediacion	work - total	8	0.8	U123, U67, U4, U110, U71, U130, U32, U26
intermediacion	facebook - total	7	0.7	U79, U91, U67, U123, U130, U4, U32
intermediacion	lunch - total	6	0.6	U130, U4, U32, U79, U67, U110
intermediacion	facebook - coauthor	6	0.6	U79, U91, U67, U123, U130, U4
intermediacion	coauthor - work	6	0.6	U130, U110, U4, U123, U67, U71
intermediacion	lunch - facebook	5	0.5	U130, U4, U32, U79, U67
intermediacion	lunch - coauthor	5	0.5	U130, U4, U79, U67, U110
intermediacion	lunch - work	5	0.5	U130, U4, U32, U67, U110
intermediacion	facebook - work	5	0.5	U67, U123, U130, U4, U32
intermediacion	facebook - leisure	4	0.4	U79, U91, U76, U142
intermediacion	lunch - leisure	2	0.2	U126, U79
intermediacion	coauthor - leisure	2	0.2	U91, U79
intermediacion	leisure - total	2	0.2	U91, U79
intermediacion	leisure - work	0	0.0
propia	facebook - total	8	0.8	U79, U130, U4, U91, U124, U67, U54, U76
propia	lunch - leisure	5	0.5	U79, U90, U54, U76, U126
propia	leisure - total	5	0.5	U91, U54, U110, U79, U76
propia	work - total	5	0.5	U123, U4, U67, U130, U110
propia	facebook - coauthor	4	0.4	U130, U47, U91, U76
propia	facebook - leisure	4	0.4	U79, U91, U54, U76
propia	coauthor - total	4	0.4	U91, U110, U130, U76
propia	lunch - facebook	3	0.3	U79, U54, U76
propia	lunch - total	3	0.3	U79, U54, U76
propia	facebook - work	3	0.3	U130, U4, U67
propia	coauthor - leisure	3	0.3	U91, U110, U76
propia	coauthor - work	3	0.3	U110, U97, U130
propia	lunch - coauthor	1	0.1	U76
propia	leisure - work	1	0.1	U110
propia	lunch - work	0	0.0

Actores contrastantes entre capas

Para cada par de capas se calcula, por actor, la diferencia de grado y la diferencia de posición en el ranking de grado. Un actor es contrastante en un par de capas si ambas diferencias superan el percentil 75 de ese par.

# Grado de cada actor por capa; 0 si el actor no está en la capa
tabla_grado <- tablas_centralidad[["grado"]]
tabla_grado[is.na(tabla_grado)] <- 0

# Posición de cada actor en cada capa (1 = el de mayor grado)
posiciones <- matrix(
  NA,
  nrow = nrow(tabla_grado),
  ncol = length(capas),
  dimnames = list(tabla_grado$actor, capas)
)

for (capa in capas) {
  posiciones[, capa] <- rank(-tabla_grado[[capa]], ties.method = "min")
}

pares_capas <- combn(capas, 2, simplify = FALSE)

lista_cambios <- list()

for (par_capas in pares_capas) {
  capa1 <- par_capas[1]
  capa2 <- par_capas[2]

  lista_cambios[[paste(capa1, capa2)]] <- data.frame(
    par = paste(capa1, "-", capa2),
    actor = tabla_grado$actor,
    grado_capa1 = tabla_grado[[capa1]],
    grado_capa2 = tabla_grado[[capa2]],
    dif_grado = abs(tabla_grado[[capa1]] - tabla_grado[[capa2]]),
    posicion_capa1 = posiciones[, capa1],
    posicion_capa2 = posiciones[, capa2],
    dif_posicion = abs(posiciones[, capa1] - posiciones[, capa2])
  )
}

df_cambios <- bind_rows(lista_cambios)
rownames(df_cambios) <- NULL

# Diferencia de posición por par de capas
par(mfrow = c(5, 2), mar = c(3, 4, 2, 1))

for (par_capas in pares_capas) {
  nombre_par <- paste(par_capas[1], "-", par_capas[2])
  datos <- df_cambios[df_cambios$par == nombre_par, ]
  datos <- datos[order(-datos$dif_posicion), ]

  plot(
    datos$dif_posicion,
    type = "b",
    pch = 19,
    cex = 0.5,
    col = "steelblue",
    xaxt = "n",
    xlab = "",
    ylab = "Diferencia de posición",
    main = nombre_par
  )
  axis(1, at = 1:nrow(datos), labels = datos$actor, las = 2, cex.axis = 0.5)
}

par(mfrow = c(1, 1))

# Diferencia de grado por par de capas
par(mfrow = c(5, 2), mar = c(3, 4, 2, 1))

for (par_capas in pares_capas) {
  nombre_par <- paste(par_capas[1], "-", par_capas[2])
  datos <- df_cambios[df_cambios$par == nombre_par, ]
  datos <- datos[order(-datos$dif_grado), ]

  plot(
    datos$dif_grado,
    type = "b",
    pch = 19,
    cex = 0.5,
    col = "firebrick",
    xaxt = "n",
    xlab = "",
    ylab = "Diferencia de grado",
    main = nombre_par
  )
  axis(1, at = 1:nrow(datos), labels = datos$actor, las = 2, cex.axis = 0.5)
}

par(mfrow = c(1, 1))

# Contrastantes: diferencia de grado y de posición por encima del percentil 75 del par
df_contrastantes <- df_cambios %>%
  group_by(par) %>%
  filter(
    dif_grado > quantile(dif_grado, 0.75),
    dif_posicion > quantile(dif_posicion, 0.75)
  ) %>%
  ungroup() %>%
  arrange(par, desc(dif_posicion))

df_contrastantes

par	actor	grado_capa1	grado_capa2	dif_grado	posicion_capa1	posicion_capa2	dif_posicion
coauthor - leisure	U130	5	0	5	1	48	47
coauthor - leisure	U126	0	9	9	26	2	24
coauthor - leisure	U54	0	8	8	26	3	23
coauthor - leisure	U90	0	8	8	26	3	23
facebook - coauthor	U79	15	0	15	1	26	25
facebook - coauthor	U67	13	0	13	3	26	23
facebook - coauthor	U124	13	0	13	3	26	23
facebook - leisure	U130	12	0	12	5	48	43
facebook - leisure	U123	11	0	11	7	48	41
facebook - leisure	U71	8	0	8	14	48	34
facebook - leisure	U4	12	1	11	5	38	33
facebook - leisure	U126	0	9	9	33	2	31
facebook - leisure	U47	11	1	10	7	38	31
facebook - leisure	U90	0	8	8	33	3	30
facebook - leisure	U73	0	7	7	33	5	28
facebook - leisure	U67	13	2	11	3	27	24
facebook - leisure	U32	11	2	9	7	27	20
facebook - work	U142	11	3	8	7	40	33
facebook - work	U26	0	16	16	33	4	29
facebook - work	U124	13	4	9	3	29	26
facebook - work	U139	0	11	11	33	9	24
leisure - work	U123	0	27	27	48	1	47
leisure - work	U130	0	16	16	48	4	44
leisure - work	U71	0	16	16	48	4	44
leisure - work	U139	0	11	11	48	9	39
leisure - work	U126	9	3	6	2	40	38
leisure - work	U33	0	9	9	48	11	37
leisure - work	U4	1	21	20	38	2	36
leisure - work	U26	1	16	15	38	4	34
leisure - work	U97	0	8	8	48	15	33
lunch - facebook	U142	2	11	9	57	7	50
lunch - facebook	U124	4	13	9	50	3	47
lunch - facebook	U126	15	0	15	1	33	32
lunch - facebook	U90	10	0	10	7	33	26
lunch - facebook	U134	12	2	10	4	30	26
lunch - facebook	U72	10	0	10	7	33	26
lunch - leisure	U134	12	0	12	4	48	44
lunch - leisure	U4	15	1	14	1	38	37
lunch - leisure	U97	8	0	8	11	48	37
lunch - work	U139	1	11	10	59	9	50
lunch - work	U126	15	3	12	1	40	39
lunch - work	U109	12	3	9	4	40	36
lunch - work	U134	12	3	9	4	40	36

Brokers multicapa

Criterio: un actor es broker en una red si su intermediación normalizada supera el percentil 75 de esa red y es mayor que 0. El percentil se calcula dentro de cada red porque la distribución de la intermediación depende del tamaño y la estructura de cada capa. Un actor es broker multicapa si es broker en al menos 2 de las 5 capas.

# Percentil 75 de la intermediación normalizada dentro de cada red
df_brokers <- df_centralidad %>%
  select(red, actor, intermediacion_norm) %>%
  group_by(red) %>%
  mutate(
    p75 = quantile(intermediacion_norm, 0.75),
    broker = intermediacion_norm > p75 & intermediacion_norm > 0
  ) %>%
  ungroup()

df_brokers %>%
  group_by(red) %>%
  summarise(p75 = round(first(p75), 4), n_brokers = sum(broker))

red	p75	n_brokers
coauthor	0.000	5
facebook	0.041	8
leisure	0.067	12
lunch	0.034	15
total	0.026	15
work	0.014	15

ggplot(df_brokers, aes(x = intermediacion_norm)) +
  geom_density(fill = "#4682B4", alpha = 0.4, color = "#1E3F66") +
  geom_rug(alpha = 0.5) +
  geom_vline(aes(xintercept = p75), color = "firebrick", linetype = "dashed") +
  facet_wrap(~ red, scales = "free") +
  labs(
    title = "Distribución de la intermediación por red",
    subtitle = "Línea punteada: percentil 75",
    x = "Intermediación normalizada",
    y = "Densidad"
  ) +
  theme_minimal()

# Número de capas en que cada actor es broker (sin contar la red total)
df_brokers_multicapa <- df_brokers %>%
  filter(red != "total") %>%
  group_by(actor) %>%
  summarise(
    capas_broker = sum(broker),
    capas = paste(red[broker], collapse = ", ")
  ) %>%
  filter(capas_broker >= 2) %>%
  arrange(desc(capas_broker))

df_brokers_multicapa

actor	capas_broker	capas
U110	4	lunch, coauthor, leisure, work
U130	4	lunch, facebook, coauthor, work
U79	4	lunch, facebook, leisure, work
U4	3	lunch, facebook, work
U67	3	lunch, facebook, work
U91	3	facebook, coauthor, leisure
U118	2	coauthor, work
U123	2	facebook, work
U126	2	lunch, leisure
U17	2	leisure, work
U32	2	lunch, work
U33	2	lunch, work
U42	2	lunch, leisure
U54	2	leisure, work
U76	2	facebook, leisure

# Perfil de intermediación de los brokers multicapa
perfil_brokers <- tablas_centralidad[["intermediacion_norm"]]
perfil_brokers <- perfil_brokers[perfil_brokers$actor %in% df_brokers_multicapa$actor, ]
perfil_brokers[, redes] <- round(perfil_brokers[, redes], 3)
perfil_brokers

	actor	lunch	facebook	coauthor	leisure	work	total
1	U4	0.282	0.043	NA	0.000	0.226	0.133
2	U123	0.015	0.089	NA	NA	0.277	0.111
3	U91	0.010	0.118	0.005	0.272	0.007	0.071
4	U67	0.090	0.092	NA	0.041	0.227	0.064
5	U79	0.135	0.135	NA	0.196	0.018	0.060
7	U110	0.074	0.019	0.025	0.087	0.105	0.044
8	U130	0.328	0.070	0.029	NA	0.082	0.043
10	U32	0.264	0.040	0.000	0.003	0.061	0.037
13	U126	0.138	NA	NA	0.134	0.001	0.030
15	U54	0.014	0.018	NA	0.196	0.026	0.029
19	U33	0.067	NA	NA	NA	0.017	0.022
22	U118	0.000	NA	0.004	0.000	0.029	0.014
25	U42	0.055	0.011	NA	0.107	0.000	0.011
26	U76	0.002	0.045	0.000	0.090	0.001	0.009
29	U17	0.009	NA	NA	0.082	0.022	0.008

Brokers multicapa frente a la intermediación en la red agregada

Se compara la lista de brokers multicapa con los brokers de la red total (unión binaria), definidos con el mismo criterio del percentil 75.

brokers_multicapa <- df_brokers_multicapa$actor
brokers_total <- df_brokers %>% filter(red == "total", broker) %>% pull(actor)

df_comparacion_brokers <- data.frame(actor = union(brokers_multicapa, brokers_total)) %>%
  mutate(
    categoria = case_when(
      actor %in% brokers_multicapa & actor %in% brokers_total ~ "Multicapa y agregada",
      actor %in% brokers_multicapa ~ "Solo multicapa",
      TRUE ~ "Solo agregada"
    )
  ) %>%
  arrange(categoria, actor)

table(df_comparacion_brokers$categoria)

Var1	Freq
Multicapa y agregada	10
Solo agregada	5
Solo multicapa	5

df_comparacion_brokers

actor	categoria
U110	Multicapa y agregada
U123	Multicapa y agregada
U126	Multicapa y agregada
U130	Multicapa y agregada
U32	Multicapa y agregada
U4	Multicapa y agregada
U54	Multicapa y agregada
U67	Multicapa y agregada
U79	Multicapa y agregada
U91	Multicapa y agregada
U10	Solo agregada
U106	Solo agregada
U124	Solo agregada
U26	Solo agregada
U71	Solo agregada
U118	Solo multicapa
U17	Solo multicapa
U33	Solo multicapa
U42	Solo multicapa
U76	Solo multicapa

Los rankings de centralidad cambian mucho entre relaciones. Las correlaciones de Spearman entre capas son bajas (en promedio entre 0.11 y 0.23 según la medida), y de los diez actores más centrales de cada capa, dos capas comparten en promedio solo entre 2.3 y 4.0, frente a entre 4.6 y 6.2 cuando una capa se compara con la red agregada. Cada capa se correlaciona más con la red agregada (en promedio entre 0.40 y 0.52), en especial work y facebook: la red agregada refleja sobre todo a estas capas. En la cercanía conviene tener cautela con coauthor y leisure, que están fragmentadas: allí la medida se calcula solo sobre los actores alcanzables y la centralidad armónica es más apropiada.

U123, U4, U79, U67 y U91 son los actores más centrales de la red agregada y aparecen repetidamente entre los primeros de varias capas. Otros actores tienen perfiles contrastantes: U123 es el actor de mayor grado en work (27 vínculos) y no participa en leisure; U139 tiene un solo vínculo en lunch y 11 en work; U130 es el primero por grado en coauthor y está ausente en leisure.

Con el criterio del percentil 75, 15 actores son brokers multicapa; U110, U130 y U79 lo son en cuatro capas. Diez de ellos también son brokers en la red agregada, por lo que la intermediación agregada identifica bien a la mayoría de los puentes. Sin embargo, cinco brokers de la red agregada (U10, U106, U124, U26 y U71) no lo son en dos o más relaciones, y cinco brokers multicapa (U118, U17, U33, U42 y U76) pierden ese papel al agregar.

3.8 Agrupamiento

Detección de comunidades por capa

# Louvain y Leiden tienen un componente aleatorio
set.seed(123)

lista_comunidades <- list()
lista_resumen_com <- list()

for (red in redes) {
  g_red <- obtener_red(red)

  com_fast_greedy <- cluster_fast_greedy(g_red)
  com_edge <- cluster_edge_betweenness(g_red)
  com_leading <- cluster_leading_eigen(g_red)
  com_louvain <- cluster_louvain(g_red)
  com_leiden <- cluster_leiden(g_red, objective_function = "modularity")
  com_walktrap <- cluster_walktrap(g_red)

  # Guardar las particiones de cada red
  lista_comunidades[[red]] <- list(
    fast_greedy = com_fast_greedy,
    edge = com_edge,
    leading = com_leading,
    louvain = com_louvain,
    leiden = com_leiden,
    walktrap = com_walktrap
  )

  lista_resumen_com[[red]] <- data.frame(
    red = red,
    n_comunidades_fast = length(com_fast_greedy),
    n_comunidades_edge = length(com_edge),
    n_comunidades_leading = length(com_leading),
    n_comunidades_louvain = length(com_louvain),
    n_comunidades_leiden = length(com_leiden),
    n_comunidades_walktrap = length(com_walktrap),

    modularidad_fast = round(modularity(com_fast_greedy), 3),
    modularidad_edge = round(modularity(com_edge), 3),
    modularidad_leading = round(modularity(com_leading), 3),
    modularidad_louvain = round(modularity(com_louvain), 3),
    modularidad_leiden = round(modularity(g_red, membership(com_leiden)), 3),
    modularidad_walktrap = round(modularity(com_walktrap), 3),

    # Tamaño de cada comunidad, de mayor a menor
    tamanos_fast = paste(sort(sizes(com_fast_greedy), decreasing = TRUE), collapse = ", "),
    tamanos_edge = paste(sort(sizes(com_edge), decreasing = TRUE), collapse = ", "),
    tamanos_leading = paste(sort(sizes(com_leading), decreasing = TRUE), collapse = ", "),
    tamanos_louvain = paste(sort(sizes(com_louvain), decreasing = TRUE), collapse = ", "),
    tamanos_leiden = paste(sort(sizes(com_leiden), decreasing = TRUE), collapse = ", "),
    tamanos_walktrap = paste(sort(sizes(com_walktrap), decreasing = TRUE), collapse = ", ")
  )
}

df_comunidades <- bind_rows(lista_resumen_com)
df_comunidades

red	n_comunidades_fast	n_comunidades_edge	n_comunidades_leading	n_comunidades_louvain	n_comunidades_leiden	n_comunidades_walktrap	modularidad_fast	modularidad_edge	modularidad_leading	modularidad_louvain	modularidad_leiden	modularidad_walktrap	tamanos_fast	tamanos_edge	tamanos_leading	tamanos_louvain	tamanos_leiden	tamanos_walktrap
lunch	6	6	7	5	5	6	0.647	0.652	0.600	0.655	0.655	0.651	15, 11, 11, 10, 7, 6	15, 14, 12, 10, 7, 2	16, 13, 10, 9, 7, 4, 1	15, 14, 14, 10, 7	15, 14, 14, 10, 7	15, 14, 12, 10, 7, 2
facebook	4	10	4	4	4	6	0.343	0.244	0.341	0.343	0.343	0.316	10, 10, 6, 6	11, 6, 6, 2, 2, 1, 1, 1, 1, 1	11, 9, 6, 6	10, 10, 6, 6	10, 10, 6, 6	10, 9, 6, 3, 2, 2
coauthor	8	8	8	8	8	8	0.757	0.757	0.757	0.757	0.757	0.757	6, 6, 3, 2, 2, 2, 2, 2	6, 6, 3, 2, 2, 2, 2, 2	6, 6, 3, 2, 2, 2, 2, 2	6, 6, 3, 2, 2, 2, 2, 2	6, 6, 3, 2, 2, 2, 2, 2	6, 6, 3, 2, 2, 2, 2, 2
leisure	6	7	6	6	6	9	0.571	0.569	0.541	0.569	0.569	0.547	14, 11, 9, 7, 3, 3	14, 9, 9, 7, 3, 3, 2	14, 11, 9, 8, 3, 2	15, 10, 9, 7, 3, 3	12, 10, 9, 7, 6, 3	12, 11, 7, 4, 3, 3, 3, 2, 2
work	4	5	4	4	4	5	0.456	0.445	0.389	0.459	0.459	0.408	22, 16, 13, 9	15, 14, 14, 9, 8	17, 17, 15, 11	22, 14, 12, 12	22, 15, 12, 11	19, 19, 12, 7, 3
total	3	11	5	5	5	5	0.355	0.326	0.404	0.416	0.416	0.380	23, 22, 16	19, 18, 7, 5, 3, 3, 2, 1, 1, 1, 1	17, 14, 13, 9, 8	15, 13, 13, 12, 8	15, 13, 13, 12, 8	19, 16, 13, 8, 5

Louvain y Leiden obtienen la mayor modularidad en todas las redes. Coauthor tiene la modularidad más alta (0.76) porque sus comunidades coinciden con sus componentes conexas, mientras que facebook (0.34) y la red total (entre 0.33 y 0.42) tienen las más bajas: sus grupos están menos separados. Edge betweenness genera comunidades de un solo actor en facebook y en la red total, lo que aumenta su número de comunidades sin aportar estructura.

Relación de las comunidades con el grupo de investigación

estabilidad_comunidades <- function(g, referencia, N_stability = 100) {

  # Referencia como números; los actores con NA no se comparan
  referencia <- as.integer(factor(referencia))
  con_dato <- !is.na(referencia)

  # Almacenar resultados
  stability_results <- vector("list", 3 * N_stability)
  row_id <- 1

  for (b in seq_len(N_stability)) {

    # Louvain
    set.seed(40000 + b)
    fit_louvain <- cluster_louvain(g)

    # Leiden
    set.seed(50000 + b)
    fit_leiden <- cluster_leiden(
      g,
      objective_function = "modularity",
      resolution = 1,
      n_iterations = 2
    )

    # Propagación de etiquetas
    set.seed(60000 + b)
    fit_label <- cluster_label_prop(g)

    fit_list <- list(
      louvain = fit_louvain,
      leiden = fit_leiden,
      label_propagation = fit_label
    )

    # Evaluar cada partición
    for (method_name in names(fit_list)) {

      fit <- fit_list[[method_name]]
      memb <- membership(fit)

      stability_results[[row_id]] <- data.frame(
        repeticion = b,
        metodo = method_name,
        K = length(unique(memb)),
        modularidad = modularity(
          g,
          memb,
          directed = FALSE
        ),
        NMI = compare(
          referencia[con_dato],
          memb[con_dato],
          method = "nmi"
        ),
        ARI = compare(
          referencia[con_dato],
          memb[con_dato],
          method = "adjusted.rand"
        )
      )

      row_id <- row_id + 1
    }
  }

  # Consolidar resultados
  do.call(rbind, stability_results)
}

lista_estabilidad <- list()

for (red in redes) {
  g_red <- obtener_red(red)
  grupo_red <- actores_attr$group[match(V(g_red)$name, actores_attr$actor)]

  resultado <- estabilidad_comunidades(g_red, grupo_red, N_stability = 100)
  resultado$red <- red

  lista_estabilidad[[red]] <- resultado
}

df_estabilidad <- bind_rows(lista_estabilidad)

df_estabilidad %>%
  group_by(red, metodo) %>%
  summarise(
    K_min = min(K),
    K_max = max(K),
    modularidad = round(mean(modularidad), 3),
    NMI = round(mean(NMI), 3),
    ARI = round(mean(ARI), 3),
    .groups = "drop"
  )

red	metodo	K_min	K_max	modularidad	NMI	ARI
coauthor	label_propagation	8	10	0.737	0.841	0.612
coauthor	leiden	8	8	0.757	0.851	0.654
coauthor	louvain	8	8	0.757	0.851	0.654
facebook	label_propagation	1	3	0.126	0.196	0.102
facebook	leiden	4	4	0.342	0.676	0.554
facebook	louvain	3	4	0.342	0.677	0.553
leisure	label_propagation	4	10	0.517	0.652	0.438
leisure	leiden	6	7	0.569	0.709	0.599
leisure	louvain	6	7	0.568	0.709	0.569
lunch	label_propagation	5	9	0.629	0.841	0.717
lunch	leiden	5	5	0.655	0.845	0.711
lunch	louvain	5	6	0.653	0.835	0.699
total	label_propagation	1	5	0.156	0.286	0.168
total	leiden	4	5	0.416	0.836	0.699
total	louvain	5	5	0.416	0.836	0.700
work	label_propagation	1	5	0.228	0.354	0.172
work	leiden	4	4	0.458	0.734	0.514
work	louvain	4	5	0.455	0.730	0.514

stability_summary <- do.call(
  rbind,
  lapply(
    split(df_estabilidad, list(df_estabilidad$red, df_estabilidad$metodo)),
    function(x) {
      data.frame(
        red = unique(x$red),
        metodo = unique(x$metodo),
        K_min = min(x$K),
        K_mediana = median(x$K),
        K_max = max(x$K),
        ARI_media = mean(x$ARI),
        ARI_sd = sd(x$ARI),
        ARI_q10 = unname(quantile(x$ARI, 0.10)),
        ARI_mediana = median(x$ARI),
        ARI_q90 = unname(quantile(x$ARI, 0.90))
      )
    }
  )
)

# Ordenar por red y quitar los nombres de fila
stability_summary <- stability_summary[order(stability_summary$red, stability_summary$metodo), ]
rownames(stability_summary) <- NULL

# Redondear métricas de ARI
stability_summary[, 6:10] <- round(
  stability_summary[, 6:10],
  3
)

# Mostrar resultados
knitr::kable(
  stability_summary,
  caption = "Estabilidad en 100 ejecuciones por red (ARI frente al grupo de investigación)."
)

Estabilidad en 100 ejecuciones por red (ARI frente al grupo de investigación).

red	metodo	K_min	K_mediana	K_max	ARI_media	ARI_sd	ARI_q10	ARI_mediana	ARI_q90
coauthor	label_propagation	8	8	10	0.612	0.061	0.560	0.654	0.654
coauthor	leiden	8	8	8	0.654	0.000	0.654	0.654	0.654
coauthor	louvain	8	8	8	0.654	0.000	0.654	0.654	0.654
facebook	label_propagation	1	1	3	0.102	0.118	0.000	0.000	0.226
facebook	leiden	4	4	4	0.554	0.011	0.556	0.556	0.556
facebook	louvain	3	4	4	0.553	0.017	0.556	0.556	0.556
leisure	label_propagation	4	6	10	0.438	0.105	0.284	0.464	0.544
leisure	leiden	6	6	7	0.599	0.026	0.561	0.610	0.610
leisure	louvain	6	6	7	0.569	0.037	0.490	0.565	0.610
lunch	label_propagation	5	7	9	0.717	0.074	0.616	0.732	0.785
lunch	leiden	5	5	5	0.711	0.009	0.712	0.712	0.712
lunch	louvain	5	5	6	0.699	0.019	0.663	0.712	0.712
total	label_propagation	1	1	5	0.168	0.205	0.000	0.000	0.541
total	leiden	4	5	5	0.699	0.014	0.701	0.701	0.701
total	louvain	5	5	5	0.700	0.005	0.697	0.701	0.701
work	label_propagation	1	2	5	0.172	0.156	0.000	0.117	0.390
work	leiden	4	4	4	0.514	0.014	0.484	0.517	0.528
work	louvain	4	4	5	0.514	0.032	0.480	0.511	0.528

# Orden de los métodos
df_estabilidad$metodo <- factor(
  df_estabilidad$metodo,
  levels = c("louvain", "leiden", "label_propagation"),
  labels = c("Louvain", "Leiden", "Prop. etiquetas")
)

# Configuración gráfica: un panel por red
op <- par(mfrow = c(2, 3), mar = c(4, 4, 3, 1))

for (red in redes) {
  datos <- df_estabilidad[df_estabilidad$red == red, ]

  # Medias de ARI
  ari_mean <- tapply(
    datos$ARI,
    datos$metodo,
    mean
  )

  # Distribución del ARI
  boxplot(
    ARI ~ metodo,
    data = datos,
    notch = TRUE,
    outline = FALSE,
    col = "gray90",
    border = "gray30",
    xlab = "",
    ylab = "ARI",
    ylim = c(0, 1),
    cex.axis = 0.8,
    main = red
  )

  # Ejecuciones individuales
  stripchart(
    ARI ~ metodo,
    data = datos,
    vertical = TRUE,
    method = "jitter",
    pch = 16,
    cex = 0.45,
    col = adjustcolor("gray30", alpha.f = 0.35),
    add = TRUE
  )

  # ARI promedio
  points(
    seq_along(ari_mean),
    ari_mean,
    pch = 18,
    cex = 1.4
  )

  # Referencia
  abline(h = 0, lty = 2, col = "gray50")
}

# Restaurar la configuración gráfica
par(op)

# Orden de las redes en el eje x
df_estabilidad$red <- factor(df_estabilidad$red, levels = redes)

# Configuración gráfica: un panel por algoritmo
op <- par(mfrow = c(1, 3), mar = c(5, 4, 3, 1))

for (metodo in levels(df_estabilidad$metodo)) {
  datos <- df_estabilidad[df_estabilidad$metodo == metodo, ]

  # Medias de ARI
  ari_mean <- tapply(
    datos$ARI,
    datos$red,
    mean
  )

  # Distribución del ARI por red
  boxplot(
    ARI ~ red,
    data = datos,
    outline = FALSE,
    col = "gray90",
    border = "gray30",
    xlab = "",
    ylab = "ARI frente al grupo de investigación",
    ylim = c(0, 1),
    las = 2,
    main = metodo
  )

  # Ejecuciones individuales
  stripchart(
    ARI ~ red,
    data = datos,
    vertical = TRUE,
    method = "jitter",
    pch = 16,
    cex = 0.45,
    col = adjustcolor("gray30", alpha.f = 0.35),
    add = TRUE
  )

  # ARI promedio
  points(
    seq_along(ari_mean),
    ari_mean,
    pch = 18,
    cex = 1.4
  )

  # Referencia
  abline(h = 0, lty = 2, col = "gray50")
}

# Restaurar la configuración gráfica
par(op)

Con Louvain y Leiden, el ARI frente al grupo de investigación está entre 0.51 (work) y 0.71 (lunch): las comunidades reflejan en buena parte los grupos de investigación, pero no los reproducen. La asociación es mayor en lunch y en la red total, y menor en facebook y work. La propagación de etiquetas es muy inestable en facebook, work y la red total, donde con frecuencia agrupa toda la red en una sola comunidad.

Estabilidad frente a la partición de referencia

Para Louvain y Leiden, que son estocásticos, se toma como referencia la partición obtenida en el primer ciclo (set.seed(123)) y se compara con 100 réplicas del mismo algoritmo con semillas distintas. Un ARI o NMI cercano a 1 indica que el algoritmo encuentra siempre las mismas comunidades.

lista_estab_ref <- list()

for (red in redes) {
  g_red <- obtener_red(red)

  # Particiones de referencia: las del primer for (set.seed(123))
  ref_louvain <- membership(lista_comunidades[[red]][["louvain"]])
  ref_leiden <- membership(lista_comunidades[[red]][["leiden"]])

  for (b in 1:100) {
    # Réplica con otra semilla
    set.seed(40000 + b)
    memb_louvain <- membership(cluster_louvain(g_red))

    set.seed(50000 + b)
    memb_leiden <- membership(cluster_leiden(g_red, objective_function = "modularity"))

    lista_estab_ref[[paste(red, b)]] <- data.frame(
      red = red,
      repeticion = b,
      NMI_louvain = compare(ref_louvain, memb_louvain, method = "nmi"),
      ARI_louvain = compare(ref_louvain, memb_louvain, method = "adjusted.rand"),
      NMI_leiden = compare(ref_leiden, memb_leiden, method = "nmi"),
      ARI_leiden = compare(ref_leiden, memb_leiden, method = "adjusted.rand")
    )
  }
}

df_estab_ref <- bind_rows(lista_estab_ref)

df_estab_ref %>%
  group_by(red) %>%
  summarise(
    NMI_louvain_media = round(mean(NMI_louvain), 3),
    ARI_louvain_media = round(mean(ARI_louvain), 3),
    ARI_louvain_min = round(min(ARI_louvain), 3),
    replicas_iguales_louvain = sum(round(ARI_louvain, 6) == 1),
    NMI_leiden_media = round(mean(NMI_leiden), 3),
    ARI_leiden_media = round(mean(ARI_leiden), 3),
    ARI_leiden_min = round(min(ARI_leiden), 3),
    replicas_iguales_leiden = sum(round(ARI_leiden, 6) == 1)
  )

red	NMI_louvain_media	ARI_louvain_media	ARI_louvain_min	replicas_iguales_louvain	NMI_leiden_media	ARI_leiden_media	ARI_leiden_min	replicas_iguales_leiden
coauthor	1.000	1.000	1.000	100	1.000	1.000	1.000	100
facebook	0.988	0.985	0.650	92	0.994	0.992	0.649	97
leisure	0.954	0.908	0.693	43	0.981	0.969	0.663	82
lunch	0.970	0.956	0.795	64	0.998	0.997	0.908	97
total	0.980	0.975	0.805	65	0.989	0.987	0.764	86
work	0.883	0.870	0.607	6	0.961	0.956	0.569	76

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

for (red in redes) {
  datos <- df_estab_ref[df_estab_ref$red == red, ]

  boxplot(
    datos$ARI_louvain,
    datos$ARI_leiden,
    names = c("Louvain", "Leiden"),
    outline = FALSE,
    col = "gray90",
    border = "gray30",
    ylab = "ARI frente a la referencia",
    ylim = c(0, 1),
    main = red
  )

  # Réplicas individuales
  stripchart(
    list(datos$ARI_louvain, datos$ARI_leiden),
    vertical = TRUE,
    method = "jitter",
    pch = 16,
    cex = 0.45,
    col = adjustcolor("gray30", alpha.f = 0.35),
    add = TRUE
  )
}

par(op)

Leiden es más estable que Louvain en casi todas las redes. Coauthor es completamente estable, y lunch y facebook lo son casi siempre. Work es la red menos estable con ambos algoritmos, lo que indica que su estructura comunitaria está poco definida. En la red total las réplicas de Leiden difieren entre sí, pero solo en unos pocos actores (ARI mínimo cercano a 0.92).

Relación de las comunidades con el rol académico

lista_estabilidad_rol <- list()

for (red in redes) {
  g_red <- obtener_red(red)
  rol_red <- actores_attr$role[match(V(g_red)$name, actores_attr$actor)]

  resultado <- estabilidad_comunidades(g_red, rol_red, N_stability = 100)
  resultado$red <- red

  lista_estabilidad_rol[[red]] <- resultado
}

df_estabilidad_rol <- bind_rows(lista_estabilidad_rol)

df_estabilidad_rol %>%
  group_by(red, metodo) %>%
  summarise(
    K_min = min(K),
    K_max = max(K),
    modularidad = round(mean(modularidad), 3),
    NMI = round(mean(NMI), 3),
    ARI = round(mean(ARI), 3),
    .groups = "drop"
  )

red	metodo	K_min	K_max	modularidad	NMI	ARI
coauthor	label_propagation	8	10	0.737	0.322	-0.020
coauthor	leiden	8	8	0.757	0.309	-0.020
coauthor	louvain	8	8	0.757	0.309	-0.020
facebook	label_propagation	1	3	0.126	0.039	-0.018
facebook	leiden	4	4	0.342	0.143	-0.007
facebook	louvain	3	4	0.342	0.142	-0.007
leisure	label_propagation	4	10	0.517	0.206	-0.018
leisure	leiden	6	7	0.569	0.262	0.057
leisure	louvain	6	7	0.568	0.246	0.040
lunch	label_propagation	5	9	0.629	0.227	0.021
lunch	leiden	5	5	0.655	0.157	-0.011
lunch	louvain	5	6	0.653	0.171	-0.002
total	label_propagation	1	5	0.156	0.049	-0.003
total	leiden	4	5	0.416	0.168	-0.008
total	louvain	5	5	0.416	0.167	-0.009
work	label_propagation	1	5	0.228	0.054	0.009
work	leiden	4	4	0.458	0.135	0.029
work	louvain	4	5	0.455	0.142	0.025

# Orden de los métodos
df_estabilidad_rol$metodo <- factor(
  df_estabilidad_rol$metodo,
  levels = c("louvain", "leiden", "label_propagation"),
  labels = c("Louvain", "Leiden", "Prop. etiquetas")
)

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

for (red in redes) {
  datos <- df_estabilidad_rol[df_estabilidad_rol$red == red, ]

  # Medias de ARI
  ari_mean <- tapply(
    datos$ARI,
    datos$metodo,
    mean
  )

  boxplot(
    ARI ~ metodo,
    data = datos,
    outline = FALSE,
    col = "gray90",
    border = "gray30",
    xlab = "",
    ylab = "ARI",
    ylim = c(-0.1, 1),
    cex.axis = 0.8,
    main = red
  )

  stripchart(
    ARI ~ metodo,
    data = datos,
    vertical = TRUE,
    method = "jitter",
    pch = 16,
    cex = 0.45,
    col = adjustcolor("gray30", alpha.f = 0.35),
    add = TRUE
  )

  points(
    seq_along(ari_mean),
    ari_mean,
    pch = 18,
    cex = 1.4
  )

  abline(h = 0, lty = 2, col = "gray50")
}

par(op)

Frente al rol académico, el ARI es prácticamente 0 en todas las redes: las comunidades mezclan estudiantes de doctorado, postdocs, profesores y personal administrativo. La organización se agrupa por grupo de investigación y no por rol.

Concordancia entre algoritmos

Para cada red se comparan, con NMI y ARI, las particiones de todos los pares de algoritmos del primer ciclo.

lista_concordancia <- list()

for (red in redes) {
  modelos <- lista_comunidades[[red]]

  # Todos los pares de modelos
  pares_modelos <- combn(names(modelos), 2, simplify = FALSE)

  for (par_modelos in pares_modelos) {
    modelo1 <- par_modelos[1]
    modelo2 <- par_modelos[2]

    memb1 <- membership(modelos[[modelo1]])
    memb2 <- membership(modelos[[modelo2]])

    lista_concordancia[[paste(red, modelo1, modelo2)]] <- data.frame(
      red = red,
      modelo1 = modelo1,
      modelo2 = modelo2,
      NMI = round(compare(memb1, memb2, method = "nmi"), 3),
      ARI = round(compare(memb1, memb2, method = "adjusted.rand"), 3)
    )
  }
}

df_concordancia <- bind_rows(lista_concordancia)
rownames(df_concordancia) <- NULL
df_concordancia

red	modelo1	modelo2	NMI	ARI
lunch	fast_greedy	edge	0.877	0.812
lunch	fast_greedy	leading	0.816	0.704
lunch	fast_greedy	louvain	0.883	0.802
lunch	fast_greedy	leiden	0.883	0.802
lunch	fast_greedy	walktrap	0.907	0.866
lunch	edge	leading	0.840	0.772
lunch	edge	louvain	0.971	0.956
lunch	edge	leiden	0.971	0.956
lunch	edge	walktrap	0.943	0.910
lunch	leading	louvain	0.835	0.756
lunch	leading	leiden	0.835	0.756
lunch	leading	walktrap	0.811	0.695
lunch	louvain	leiden	1.000	1.000
lunch	louvain	walktrap	0.912	0.869
lunch	leiden	walktrap	0.912	0.869
facebook	fast_greedy	edge	0.709	0.569
facebook	fast_greedy	leading	0.924	0.896
facebook	fast_greedy	louvain	1.000	1.000
facebook	fast_greedy	leiden	1.000	1.000
facebook	fast_greedy	walktrap	0.786	0.657
facebook	edge	leading	0.708	0.565
facebook	edge	louvain	0.709	0.569
facebook	edge	leiden	0.709	0.569
facebook	edge	walktrap	0.717	0.528
facebook	leading	louvain	0.924	0.896
facebook	leading	leiden	0.924	0.896
facebook	leading	walktrap	0.755	0.641
facebook	louvain	leiden	1.000	1.000
facebook	louvain	walktrap	0.786	0.657
facebook	leiden	walktrap	0.786	0.657
coauthor	fast_greedy	edge	1.000	1.000
coauthor	fast_greedy	leading	1.000	1.000
coauthor	fast_greedy	louvain	1.000	1.000
coauthor	fast_greedy	leiden	1.000	1.000
coauthor	fast_greedy	walktrap	1.000	1.000
coauthor	edge	leading	1.000	1.000
coauthor	edge	louvain	1.000	1.000
coauthor	edge	leiden	1.000	1.000
coauthor	edge	walktrap	1.000	1.000
coauthor	leading	louvain	1.000	1.000
coauthor	leading	leiden	1.000	1.000
coauthor	leading	walktrap	1.000	1.000
coauthor	louvain	leiden	1.000	1.000
coauthor	louvain	walktrap	1.000	1.000
coauthor	leiden	walktrap	1.000	1.000
leisure	fast_greedy	edge	0.968	0.945
leisure	fast_greedy	leading	0.859	0.815
leisure	fast_greedy	louvain	0.955	0.929
leisure	fast_greedy	leiden	0.904	0.861
leisure	fast_greedy	walktrap	0.849	0.719
leisure	edge	leading	0.831	0.754
leisure	edge	louvain	0.926	0.884
leisure	edge	leiden	0.878	0.810
leisure	edge	walktrap	0.883	0.769
leisure	leading	louvain	0.814	0.746
leisure	leading	leiden	0.792	0.694
leisure	leading	walktrap	0.746	0.597
leisure	louvain	leiden	0.926	0.862
leisure	louvain	walktrap	0.833	0.670
leisure	leiden	walktrap	0.855	0.742
work	fast_greedy	edge	0.779	0.690
work	fast_greedy	leading	0.703	0.652
work	fast_greedy	louvain	0.887	0.899
work	fast_greedy	leiden	0.914	0.933
work	fast_greedy	walktrap	0.763	0.655
work	edge	leading	0.608	0.528
work	edge	louvain	0.815	0.714
work	edge	leiden	0.718	0.623
work	edge	walktrap	0.689	0.534
work	leading	louvain	0.645	0.594
work	leading	leiden	0.643	0.590
work	leading	walktrap	0.523	0.372
work	louvain	leiden	0.887	0.898
work	louvain	walktrap	0.816	0.714
work	leiden	walktrap	0.809	0.698
total	fast_greedy	edge	0.589	0.464
total	fast_greedy	leading	0.654	0.527
total	fast_greedy	louvain	0.575	0.455
total	fast_greedy	leiden	0.575	0.455
total	fast_greedy	walktrap	0.596	0.503
total	edge	leading	0.694	0.581
total	edge	louvain	0.657	0.540
total	edge	leiden	0.657	0.540
total	edge	walktrap	0.762	0.706
total	leading	louvain	0.835	0.807
total	leading	leiden	0.835	0.807
total	leading	walktrap	0.840	0.791
total	louvain	leiden	1.000	1.000
total	louvain	walktrap	0.778	0.709
total	leiden	walktrap	0.778	0.709

df_concordancia %>%
  group_by(red) %>%
  summarise(
    NMI_medio = round(mean(NMI), 3),
    NMI_min = min(NMI)
  )

red	NMI_medio	NMI_min
coauthor	1.000	1.000
facebook	0.829	0.708
leisure	0.868	0.746
lunch	0.893	0.811
total	0.722	0.575
work	0.747	0.523

Los algoritmos coinciden totalmente en coauthor y en gran medida en lunch y leisure (NMI medio cercano a 0.88), mientras que en work y en la red total la concordancia es menor (NMI medio cercano a 0.73, con mínimos de 0.52): en esas redes las comunidades dependen del método. Louvain y Leiden producen particiones idénticas en todas las redes.

Concordancia entre capas

Para cada par de capas se comparan las comunidades de Leiden, usando solo los actores presentes en ambas capas.

lista_concordancia_capas <- list()

for (par_capas in combn(capas, 2, simplify = FALSE)) {
  capa1 <- par_capas[1]
  capa2 <- par_capas[2]

  memb1 <- membership(lista_comunidades[[capa1]][["leiden"]])
  memb2 <- membership(lista_comunidades[[capa2]][["leiden"]])

  # Solo los actores presentes en las dos capas, en el mismo orden
  actores_comunes <- intersect(names(memb1), names(memb2))

  lista_concordancia_capas[[paste(capa1, capa2)]] <- data.frame(
    par = paste(capa1, "-", capa2),
    actores_comunes = length(actores_comunes),
    NMI = round(compare(memb1[actores_comunes], memb2[actores_comunes], method = "nmi"), 3),
    ARI = round(compare(memb1[actores_comunes], memb2[actores_comunes], method = "adjusted.rand"), 3)
  )
}

df_concordancia_capas <- bind_rows(lista_concordancia_capas) %>%
  arrange(desc(ARI))
rownames(df_concordancia_capas) <- NULL
df_concordancia_capas

par	actores_comunes	NMI	ARI
lunch - coauthor	25	0.899	0.818
lunch - facebook	32	0.743	0.758
coauthor - leisure	21	0.861	0.746
facebook - coauthor	13	0.818	0.720
facebook - leisure	27	0.691	0.582
lunch - work	59	0.667	0.562
facebook - work	32	0.590	0.525
lunch - leisure	47	0.629	0.517
coauthor - work	25	0.743	0.493
leisure - work	47	0.540	0.425

Las comunidades de lunch son las que más se parecen a las de coauthor y facebook (ARI de 0.82 y 0.76), mientras que work y leisure son las capas cuyas comunidades menos coinciden (ARI de 0.43). La estructura comunitaria no es la misma en todas las relaciones: los grupos de trabajo y los de ocio se organizan de forma distinta.

Comunidades multicapa: glouvain y mdlp

La función infomap_ml() no está disponible en la versión de multinet de CRAN (devuelve un conjunto vacío), por lo que como segundo método multicapa se usa mdlp_ml(), propagación de etiquetas multicapa. Igual que glouvain_ml(), asigna cada actor en cada capa a una sola comunidad, lo que permite compararlos con Jaccard, NMI y ARI.

set.seed(123)
mdlp_simple <- mdlp_ml(net)
glouvain_simple <- glouvain_ml(net)

# Cada miembro es un actor en una capa, por ejemplo "U4-lunch"
mdlp_simple$miembro <- paste(mdlp_simple$actor, mdlp_simple$layer, sep = "-")
glouvain_simple$miembro <- paste(glouvain_simple$actor, glouvain_simple$layer, sep = "-")

grupos_glouvain <- sort(unique(glouvain_simple$cid))
grupos_mdlp <- sort(unique(mdlp_simple$cid))

# Matriz de Jaccard: filas = comunidades de glouvain, columnas = comunidades de mdlp
J_ml <- matrix(
  0,
  nrow = length(grupos_glouvain),
  ncol = length(grupos_mdlp),
  dimnames = list(paste0("G", grupos_glouvain), paste0("M", grupos_mdlp))
)

for (i in seq_along(grupos_glouvain)) {
  for (j in seq_along(grupos_mdlp)) {
    miembros_i <- glouvain_simple$miembro[glouvain_simple$cid == grupos_glouvain[i]]
    miembros_j <- mdlp_simple$miembro[mdlp_simple$cid == grupos_mdlp[j]]

    J_ml[i, j] <- length(intersect(miembros_i, miembros_j)) /
                  length(union(miembros_i, miembros_j))
  }
}

round(J_ml, 2)

	M0	M1	M2	M3	M4	M5	M6
G0	0.00	0.77	0.00	0.03	0.08	0.00	0.0
G1	0.00	0.00	0.00	0.47	0.00	0.00	0.0
G2	0.00	0.00	0.75	0.11	0.00	0.00	0.0
G3	0.00	0.00	0.00	0.08	0.71	0.00	0.0
G4	0.14	0.00	0.00	0.09	0.03	0.44	0.2

# Para cada comunidad de mdlp, la comunidad de glouvain más parecida
lista_mejor <- list()

for (j in seq_along(grupos_mdlp)) {
  lista_mejor[[j]] <- data.frame(
    comunidad_mdlp = colnames(J_ml)[j],
    tamano_mdlp = sum(mdlp_simple$cid == grupos_mdlp[j]),
    glouvain_mas_parecida = rownames(J_ml)[which.max(J_ml[, j])],
    jaccard = round(max(J_ml[, j]), 3)
  )
}

df_mejor <- bind_rows(lista_mejor) %>%
  arrange(desc(jaccard))
df_mejor

comunidad_mdlp	tamano_mdlp	glouvain_mas_parecida	jaccard
M1	34	G0	0.773
M2	30	G2	0.750
M4	55	G3	0.714
M3	59	G1	0.475
M5	26	G4	0.441
M6	12	G4	0.203
M0	8	G4	0.136

corrplot(
  J_ml,
  method = "color",
  is.corr = FALSE,
  col.lim = c(0, 1),
  col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
  tl.col = "black",
  tl.cex = 0.9,
  cl.ratio = 0.05,
  title = "Jaccard entre comunidades de glouvain (filas) y mdlp (columnas)",
  mar = c(0, 0, 2, 0)
)

# Emparejar los dos métodos por actor-capa
comparacion_ml <- merge(
  glouvain_simple[, c("miembro", "cid")],
  mdlp_simple[, c("miembro", "cid")],
  by = "miembro",
  suffixes = c("_glouvain", "_mdlp")
)

data.frame(
  NMI = round(compare(comparacion_ml$cid_glouvain, comparacion_ml$cid_mdlp, method = "nmi"), 3),
  ARI = round(compare(comparacion_ml$cid_glouvain, comparacion_ml$cid_mdlp, method = "adjusted.rand"), 3)
)

NMI	ARI
0.639	0.499

Glouvain y mdlp coinciden en la estructura general (NMI cercano a 0.7): la mayoría de las comunidades de glouvain tiene un equivalente claro en mdlp, y la diferencia principal es que mdlp divide en varios subgrupos una de las comunidades grandes de glouvain.

Glouvain frente a Louvain por capa

Para cada capa se compara la partición de Louvain obtenida solo en esa capa (primer ciclo de esta sección) con las comunidades de glouvain restringidas a la misma capa, mediante NMI, ARI y la matriz de Jaccard entre grupos.

lista_glouvain_capas <- list()
lista_jaccard_capas <- list()

for (capa in capas) {
  # Louvain aplicado solo a la capa
  memb_louvain <- membership(lista_comunidades[[capa]][["louvain"]])
  actores_capa <- names(memb_louvain)

  # Glouvain restringido a la misma capa, en el mismo orden de actores
  glouvain_capa <- glouvain_simple[glouvain_simple$layer == capa, ]
  memb_glouvain <- glouvain_capa$cid[match(actores_capa, glouvain_capa$actor)]

  # NMI y ARI
  lista_glouvain_capas[[capa]] <- data.frame(
    capa = capa,
    comunidades_louvain = length(unique(memb_louvain)),
    comunidades_glouvain = length(unique(memb_glouvain)),
    NMI = round(compare(memb_louvain, memb_glouvain, method = "nmi"), 3),
    ARI = round(compare(memb_louvain, memb_glouvain, method = "adjusted.rand"), 3)
  )

  # Matriz de Jaccard: filas = Louvain de la capa, columnas = glouvain en la capa
  grupos_louvain <- sort(unique(memb_louvain))
  grupos_glouvain <- sort(unique(memb_glouvain))

  J <- matrix(
    0,
    nrow = length(grupos_louvain),
    ncol = length(grupos_glouvain),
    dimnames = list(paste0("L", grupos_louvain), paste0("G", grupos_glouvain))
  )

  for (i in seq_along(grupos_louvain)) {
    for (j in seq_along(grupos_glouvain)) {
      miembros_i <- actores_capa[memb_louvain == grupos_louvain[i]]
      miembros_j <- actores_capa[memb_glouvain == grupos_glouvain[j]]

      J[i, j] <- length(intersect(miembros_i, miembros_j)) /
                 length(union(miembros_i, miembros_j))
    }
  }

  lista_jaccard_capas[[capa]] <- J
}

df_glouvain_capas <- bind_rows(lista_glouvain_capas)
df_glouvain_capas

capa	comunidades_louvain	comunidades_glouvain	NMI	ARI
lunch	5	5	0.826	0.770
facebook	4	5	0.773	0.770
coauthor	8	5	0.899	0.818
leisure	6	5	0.628	0.479
work	4	5	0.838	0.741

# Ejemplo: matriz de Jaccard en lunch
round(lista_jaccard_capas[["lunch"]], 2)

	G0	G1	G2	G3	G4
L1	0.08	0.57	0.19	0.00	0
L2	0.00	0.00	0.64	0.00	0
L3	0.77	0.00	0.00	0.00	0
L4	0.00	0.00	0.00	0.00	1
L5	0.04	0.00	0.00	0.93	0

par(mfrow = c(2, 3))

for (capa in capas) {
  corrplot(
    lista_jaccard_capas[[capa]],
    method = "color",
    is.corr = FALSE,
    col.lim = c(0, 1),
    col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
    addCoef.col = "black",
    number.cex = 0.6,
    tl.col = "black",
    cl.pos = "n",
    title = paste("Louvain (filas) vs glouvain (columnas):", capa),
    mar = c(0, 0, 2, 0)
  )
}

par(mfrow = c(1, 1))

Con el acoplamiento por defecto, glouvain conserva buena parte de las comunidades de cada capa (NMI aproximadamente entre 0.65 y 0.9). Leisure es la capa cuyas comunidades más se modifican al integrarla con las demás relaciones.

Glouvain frente a la red agregada

Para cada capa se comparan las comunidades de glouvain en esa capa con las comunidades de Louvain sobre la red total (unión binaria), mediante NMI, ARI y la matriz de Jaccard.

# Louvain sobre la red total (primer ciclo de esta sección)
memb_total <- membership(lista_comunidades[["total"]][["louvain"]])

lista_glouvain_total <- list()
lista_jaccard_total <- list()

for (capa in capas) {
  # Glouvain restringido a la capa
  glouvain_capa <- glouvain_simple[glouvain_simple$layer == capa, ]
  actores_capa <- glouvain_capa$actor
  memb_glouvain <- glouvain_capa$cid

  # Comunidad de esos mismos actores en la red total
  memb_louvain_total <- memb_total[actores_capa]

  # NMI y ARI
  lista_glouvain_total[[capa]] <- data.frame(
    capa = capa,
    comunidades_total = length(unique(memb_louvain_total)),
    comunidades_glouvain = length(unique(memb_glouvain)),
    NMI = round(compare(memb_louvain_total, memb_glouvain, method = "nmi"), 3),
    ARI = round(compare(memb_louvain_total, memb_glouvain, method = "adjusted.rand"), 3)
  )

  # Matriz de Jaccard: filas = Louvain en la red total, columnas = glouvain en la capa
  grupos_total <- sort(unique(memb_louvain_total))
  grupos_glouvain <- sort(unique(memb_glouvain))

  J <- matrix(
    0,
    nrow = length(grupos_total),
    ncol = length(grupos_glouvain),
    dimnames = list(paste0("T", grupos_total), paste0("G", grupos_glouvain))
  )

  for (i in seq_along(grupos_total)) {
    for (j in seq_along(grupos_glouvain)) {
      miembros_i <- actores_capa[memb_louvain_total == grupos_total[i]]
      miembros_j <- actores_capa[memb_glouvain == grupos_glouvain[j]]

      J[i, j] <- length(intersect(miembros_i, miembros_j)) /
                 length(union(miembros_i, miembros_j))
    }
  }

  lista_jaccard_total[[capa]] <- J
}

df_glouvain_total <- bind_rows(lista_glouvain_total)
df_glouvain_total

capa	comunidades_total	comunidades_glouvain	NMI	ARI
lunch	5	5	0.928	0.921
facebook	5	5	0.946	0.945
coauthor	5	5	1.000	1.000
leisure	5	5	1.000	1.000
work	5	5	0.963	0.958

par(mfrow = c(2, 3))

for (capa in capas) {
  corrplot(
    lista_jaccard_total[[capa]],
    method = "color",
    is.corr = FALSE,
    col.lim = c(0, 1),
    col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
    addCoef.col = "black",
    number.cex = 0.6,
    tl.col = "black",
    cl.pos = "n",
    title = paste("Louvain total (filas) vs glouvain (columnas):", capa),
    mar = c(0, 0, 2, 0)
  )
}

par(mfrow = c(1, 1))

Con omega = 1, las comunidades de glouvain en cada capa son prácticamente las de la red agregada (NMI entre 0.86 y 1): con este acoplamiento, glouvain asigna a cada actor la misma comunidad en todas las capas, y el análisis multicapa termina reproduciendo la red agregada.

Sensibilidad de glouvain al acoplamiento entre capas

El parámetro omega es el peso de las aristas que unen las copias de un mismo actor entre capas (Mucha et al., 2010). Con omega bajo cada capa conserva sus propias comunidades; con omega alto cada actor tiende a quedar en la misma comunidad en todas las capas. Se ejecuta glouvain con varios valores de omega y se cuenta cuántos actores quedan en comunidades distintas según la capa.

valores_omega <- c(0.05, 0.1, 0.25, 0.5, 0.75, 1)

lista_glouvain_omega <- list()
lista_resumen_omega <- list()

for (omega in valores_omega) {
  set.seed(123)
  glouvain_omega <- glouvain_ml(net, omega = omega)
  lista_glouvain_omega[[as.character(omega)]] <- glouvain_omega

  # Número de comunidades distintas de cada actor entre sus capas
  comunidades_por_actor <- tapply(glouvain_omega$cid, glouvain_omega$actor, function(x) length(unique(x)))

  lista_resumen_omega[[as.character(omega)]] <- data.frame(
    omega = omega,
    comunidades = length(unique(glouvain_omega$cid)),
    actores_cambian = sum(comunidades_por_actor > 1)
  )
}

df_resumen_omega <- bind_rows(lista_resumen_omega)
df_resumen_omega

omega	comunidades	actores_cambian
0.05	5	25
0.10	5	19
0.25	5	21
0.50	5	20
0.75	5	15
1.00	5	0

# Actores con comunidades distintas según la capa, para omega = 0.5
glouvain_05 <- lista_glouvain_omega[["0.5"]]

comunidades_por_actor <- tapply(glouvain_05$cid, glouvain_05$actor, function(x) length(unique(x)))
actores_cambian <- names(comunidades_por_actor)[comunidades_por_actor > 1]

# Comunidad de cada uno de esos actores en cada capa
tabla_cambian <- glouvain_05[glouvain_05$actor %in% actores_cambian, ]
tabla_cambian <- tabla_cambian[order(tabla_cambian$actor, tabla_cambian$layer), ]
tabla_cambian

	actor	layer	cid
160	U10	coauthor	3
12	U10	facebook	0
13	U10	leisure	0
159	U10	lunch	3
161	U10	work	3
43	U106	coauthor	1
133	U106	facebook	3
44	U106	leisure	1
42	U106	lunch	1
45	U106	work	1
122	U112	facebook	2
27	U112	lunch	0
28	U112	work	0
5	U123	facebook	0
4	U123	lunch	0
50	U123	work	1
2	U139	lunch	0
132	U139	work	3
56	U26	coauthor	1
143	U26	leisure	3
55	U26	lunch	1
57	U26	work	1
197	U3	facebook	4
198	U3	leisure	4
196	U3	lunch	4
9	U3	work	0
1	U33	lunch	0
70	U33	work	2
23	U37	leisure	0
90	U37	lunch	2
91	U37	work	2
25	U4	facebook	0
92	U4	leisure	2
24	U4	lunch	0
26	U4	work	0
6	U42	facebook	0
63	U42	leisure	1
62	U42	lunch	1
64	U42	work	1
7	U49	facebook	0
66	U49	leisure	1
65	U49	lunch	1
67	U49	work	1
205	U54	facebook	4
206	U54	leisure	4
204	U54	lunch	4
10	U54	work	0
129	U6	facebook	2
224	U6	leisure	4
128	U6	lunch	2
130	U6	work	2
36	U63	lunch	0
127	U63	work	2
157	U71	facebook	3
8	U71	lunch	0
81	U71	work	2
216	U79	facebook	4
217	U79	leisure	4
215	U79	lunch	4
69	U79	work	1
178	U86	lunch	4
158	U86	work	3
219	U90	leisure	4
218	U90	lunch	4
11	U90	work	0
80	U97	coauthor	2
79	U97	lunch	2
68	U97	work	1

Con omega menor que 1, alrededor de 15 a 25 actores quedan en comunidades distintas según la capa; con omega = 1, ninguno. Entre omega = 0.1 y 0.75 el número se mantiene cerca de 18 a 20, lo que indica que estos actores tienen pertenencias distintas según la relación y que el resultado no depende de un valor particular de omega.

Actores cuya comunidad cambia según la relación

Para cada actor se identifica su comunidad principal (aquella en la que está en más capas) y se calcula la proporción de capas en las que está fuera de ella: proporción = 1 − (capas en su comunidad principal / total de capas). Un valor de 0 indica que el actor está en la misma comunidad en todas sus capas. Se excluyen los actores presentes en una sola capa.

lista_proporcion <- list()

for (omega in names(lista_glouvain_omega)) {
  glouvain_omega <- lista_glouvain_omega[[omega]]

  for (actor in unique(glouvain_omega$actor)) {
    filas_actor <- glouvain_omega[glouvain_omega$actor == actor, ]

    # Comunidad principal: en la que el actor está en más capas
    conteo <- table(filas_actor$cid)
    comunidad_principal <- names(conteo)[which.max(conteo)]
    capas_en_principal <- max(conteo)

    lista_proporcion[[paste(omega, actor)]] <- data.frame(
      omega = as.numeric(omega),
      actor = actor,
      capas = nrow(filas_actor),
      comunidad_principal = comunidad_principal,
      capas_en_principal = capas_en_principal,
      proporcion_fuera = 1 - capas_en_principal / nrow(filas_actor),
      # Capas en las que está fuera de su comunidad principal
      capas_fuera = paste(filas_actor$layer[filas_actor$cid != comunidad_principal], collapse = ", ")
    )
  }
}

# Los actores con una sola capa no pueden cambiar de comunidad
df_proporcion <- bind_rows(lista_proporcion) %>%
  filter(capas > 1)
rownames(df_proporcion) <- NULL

# Ejemplo: omega = 0.5, de mayor a menor
df_proporcion %>%
  filter(omega == 0.5, proporcion_fuera > 0) %>%
  arrange(desc(proporcion_fuera))

omega	actor	capas	comunidad_principal	capas_en_principal	proporcion_fuera	capas_fuera
0.5	U71	3	0	1	0.667	work, facebook
0.5	U33	2	0	1	0.500	work
0.5	U139	2	0	1	0.500	work
0.5	U63	2	0	1	0.500	work
0.5	U86	2	3	1	0.500	lunch
0.5	U10	5	3	3	0.400	facebook, leisure
0.5	U123	3	0	2	0.333	work
0.5	U90	3	4	2	0.333	work
0.5	U37	3	2	2	0.333	leisure
0.5	U112	3	0	2	0.333	facebook
0.5	U97	3	2	2	0.333	work
0.5	U42	4	1	3	0.250	facebook
0.5	U49	4	1	3	0.250	facebook
0.5	U3	4	4	3	0.250	work
0.5	U54	4	4	3	0.250	work
0.5	U4	4	0	3	0.250	leisure
0.5	U26	4	1	3	0.250	leisure
0.5	U79	4	4	3	0.250	work
0.5	U6	4	2	3	0.250	leisure
0.5	U106	5	1	4	0.200	facebook

# Resumen por omega
df_proporcion %>%
  group_by(omega) %>%
  summarise(
    proporcion_media = round(mean(proporcion_fuera), 3),
    actores_cambian = sum(proporcion_fuera > 0)
  )

omega	proporcion_media	actores_cambian
0.05	0.144	25
0.10	0.117	19
0.25	0.144	21
0.50	0.118	20
0.75	0.090	15
1.00	0.000	0

Con omega = 0.5, alrededor de 19 actores están fuera de su comunidad principal en al menos una capa. Las capas en las que se salen de su comunidad principal son sobre todo lunch, work, facebook y leisure, y rara vez coauthor. Estos actores pertenecen a un grupo en unas relaciones y a otro grupo en otras, por lo que conectan comunidades distintas según el contexto.

3.9 Asortatividad y modelos nulos

El grupo de investigación y el rol académico son características categóricas, por lo que se utiliza la asortatividad nominal (assortativity_nominal()). Se calcula en cada capa y en la red agregada (unión binaria). Los actores sin la característica se excluyen de la red correspondiente, y los grupos mixtos (G2/G3 y G2/G6) se conservan como categorías propias.

• \(r_a > 0\): predomina la mezcla asortativa.
• \(r_a < 0\): predomina la mezcla desasortativa.
• \(r_a \approx 0\): no existe una tendencia global clara hacia ninguno de los dos patrones.

Asortatividad por grupo de investigación y rol

La matriz de mezcla \(E = (e_{ij})\) registra la fracción de conexiones entre las categorías \(i\) y \(j\). A partir de ella se obtienen la proporción observada de conexiones dentro de la misma categoría, \(p_{obs} = \sum_i e_{ii}\), y la esperada bajo mezcla independiente, \(p_{esp} = \sum_i a_i b_i\).

# función para construir la matriz de mezcla
mixing_matrix <- function(graph, types) {
  # si types es factor se respeta el orden de sus niveles
  lev <- if (is.factor(types)) levels(types) else sort(unique(as.character(types)))
  ed  <- ends(graph, E(graph), names = FALSE)

  x <- factor(types[ed[, 1]], levels = lev)
  y <- factor(types[ed[, 2]], levels = lev)

  tab <- table(x, y)

  # cada arista no dirigida aporta las dos orientaciones
  if (!is_directed(graph)) tab <- tab + t(tab)

  tab / sum(tab)
}

atributos <- c("group", "role")

lista_asort <- list()
lista_mezcla <- list()

for (red in redes) {
  g_red <- obtener_red(red)

  for (atributo in atributos) {
    # característica de cada actor, en el orden de los vértices
    tipos <- actores_attr[[atributo]][match(V(g_red)$name, actores_attr$actor)]

    # se excluyen los actores sin la característica
    con_dato <- which(!is.na(tipos))
    g_attr <- induced_subgraph(g_red, con_dato)
    tipos <- tipos[con_dato]

    # asortatividad nominal
    r.obs <- assortativity_nominal(g_attr, types = as.integer(factor(tipos)), directed = FALSE)

    # matriz de mezcla y proporciones observada y esperada
    E.mix <- mixing_matrix(g_attr, tipos)
    avec <- rowSums(E.mix)
    bvec <- colSums(E.mix)

    lista_mezcla[[paste(red, atributo)]] <- E.mix

    lista_asort[[paste(red, atributo)]] <- data.frame(
      red = red,
      atributo = atributo,
      actores = vcount(g_attr),
      p.obs = round(sum(diag(E.mix)), 3),
      p.esp = round(sum(avec * bvec), 3),
      r = round(r.obs, 3)
    )
  }
}

df_asort <- bind_rows(lista_asort)
rownames(df_asort) <- NULL
df_asort

red	atributo	actores	p.obs	p.esp	r
lunch	group	54	0.710	0.159	0.655
lunch	role	59	0.439	0.348	0.139
facebook	group	31	0.448	0.212	0.300
facebook	role	31	0.328	0.303	0.035
coauthor	group	25	0.905	0.231	0.876
coauthor	role	25	0.190	0.307	-0.169
leisure	group	47	0.670	0.196	0.590
leisure	role	47	0.545	0.432	0.200
work	group	55	0.497	0.132	0.420
work	role	59	0.247	0.237	0.013
total	group	55	0.516	0.158	0.425
total	role	60	0.352	0.288	0.091

Por grupo de investigación, todas las redes presentan mezcla asortativa. La más fuerte es coauthor (\(r_a = 0.876\)): el 90.5% de las coautorías ocurre dentro del mismo grupo, frente a un 23.1% esperado. Le siguen lunch (\(r_a = 0.655\)) y leisure (\(r_a = 0.590\)), mientras que work (\(r_a = 0.420\)) y, sobre todo, facebook (\(r_a = 0.300\)) son las menos asortativas.

Por rol académico, la asortatividad es débil en todas las redes. Las más altas son leisure (\(r_a = 0.200\)) y lunch (\(r_a = 0.139\)); en work y facebook es prácticamente nula, y en coauthor es negativa (\(r_a = -0.169\)), lo que es coherente con colaboraciones entre roles distintos, como estudiantes y profesores.

La red agregada atenúa la asortatividad por grupo (\(r_a = 0.425\)): queda por debajo de coauthor, lunch y leisure, y cerca de work. Al unir las capas, las relaciones muy concentradas dentro del grupo se mezclan con relaciones más abiertas, como Facebook y trabajo, y el resultado no representa a ninguna de ellas.

Matrices de mezcla

Como las redes son no dirigidas, cada arista aporta sus dos orientaciones y las matrices son simétricas.

Grupo de investigación

# matriz de mezcla por grupo de investigación en cada red
for (red in redes) {
  print(knitr::kable(round(lista_mezcla[[paste(red, "group")]], 3), caption = paste(red, "- grupo de investigación")))
  cat("\n\n")
}

lunch - grupo de investigación

	G1	G2	G2/G3	G2/G6	G3	G4	G5	G6	G7
G1	0.074	0.000	0.000	0.000	0.000	0.000	0.023	0.000	0.000
G2	0.000	0.222	0.003	0.003	0.023	0.014	0.003	0.003	0.003
G2/G3	0.000	0.003	0.000	0.003	0.023	0.006	0.000	0.000	0.000
G2/G6	0.000	0.003	0.003	0.000	0.000	0.003	0.000	0.000	0.000
G3	0.000	0.023	0.023	0.000	0.068	0.000	0.000	0.000	0.000
G4	0.000	0.014	0.006	0.003	0.000	0.097	0.000	0.003	0.034
G5	0.023	0.003	0.000	0.000	0.000	0.000	0.034	0.000	0.000
G6	0.000	0.003	0.000	0.000	0.000	0.003	0.000	0.114	0.000
G7	0.000	0.003	0.000	0.000	0.000	0.034	0.000	0.000	0.102

facebook - grupo de investigación

	G1	G2	G2/G3	G2/G6	G3	G4	G5	G6	G7
G1	0.009	0.009	0.004	0.000	0.004	0.000	0.009	0.004	0.004
G2	0.009	0.284	0.017	0.009	0.030	0.013	0.009	0.004	0.017
G2/G3	0.004	0.017	0.000	0.004	0.004	0.004	0.004	0.000	0.009
G2/G6	0.000	0.009	0.004	0.000	0.004	0.004	0.004	0.013	0.004
G3	0.004	0.030	0.004	0.004	0.000	0.004	0.000	0.004	0.013
G4	0.000	0.013	0.004	0.004	0.004	0.052	0.004	0.004	0.026
G5	0.009	0.009	0.004	0.004	0.000	0.004	0.026	0.013	0.013
G6	0.004	0.004	0.000	0.013	0.004	0.004	0.013	0.009	0.004
G7	0.004	0.017	0.009	0.004	0.013	0.026	0.013	0.004	0.069

coauthor - grupo de investigación

	G1	G2	G3	G4	G5	G6	G7
G1	0.048	0.000	0.000	0.000	0.000	0.000	0.000
G2	0.000	0.286	0.024	0.000	0.000	0.000	0.000
G3	0.000	0.024	0.095	0.000	0.000	0.000	0.000
G4	0.000	0.000	0.000	0.000	0.000	0.000	0.024
G5	0.000	0.000	0.000	0.000	0.048	0.000	0.000
G6	0.000	0.000	0.000	0.000	0.000	0.143	0.000
G7	0.000	0.000	0.000	0.024	0.000	0.000	0.286

leisure - grupo de investigación

	G1	G2	G2/G3	G3	G4	G5	G6	G7
G1	0.125	0.011	0.000	0.011	0.006	0.017	0.006	0.000
G2	0.011	0.216	0.000	0.000	0.028	0.000	0.006	0.023
G2/G3	0.000	0.000	0.000	0.000	0.006	0.000	0.000	0.000
G3	0.011	0.000	0.000	0.023	0.006	0.000	0.006	0.000
G4	0.006	0.028	0.006	0.006	0.023	0.006	0.000	0.023
G5	0.017	0.000	0.000	0.000	0.006	0.034	0.000	0.011
G6	0.006	0.006	0.000	0.006	0.000	0.000	0.057	0.000
G7	0.000	0.023	0.000	0.000	0.023	0.011	0.000	0.193

work - grupo de investigación

	G1	G2	G2/G3	G2/G6	G3	G4	G5	G6	G7	G8
G1	0.097	0.016	0.000	0.000	0.000	0.000	0.019	0.003	0.000	0.000
G2	0.016	0.123	0.023	0.035	0.010	0.000	0.003	0.013	0.003	0.000
G2/G3	0.000	0.023	0.000	0.003	0.026	0.006	0.000	0.000	0.000	0.000
G2/G6	0.000	0.035	0.003	0.000	0.003	0.006	0.003	0.019	0.003	0.000
G3	0.000	0.010	0.026	0.003	0.032	0.003	0.000	0.000	0.000	0.000
G4	0.000	0.000	0.006	0.006	0.003	0.045	0.003	0.010	0.026	0.000
G5	0.019	0.003	0.000	0.003	0.000	0.003	0.039	0.003	0.003	0.000
G6	0.003	0.013	0.000	0.019	0.000	0.010	0.003	0.071	0.003	0.003
G7	0.000	0.003	0.000	0.003	0.000	0.026	0.003	0.003	0.090	0.000
G8	0.000	0.000	0.000	0.000	0.000	0.000	0.000	0.003	0.000	0.000

total - grupo de investigación

	G1	G2	G2/G3	G2/G6	G3	G4	G5	G6	G7	G8
G1	0.049	0.011	0.002	0.000	0.003	0.002	0.013	0.003	0.002	0.000
G2	0.011	0.188	0.013	0.018	0.024	0.013	0.003	0.008	0.011	0.000
G2/G3	0.002	0.013	0.000	0.002	0.013	0.003	0.002	0.000	0.003	0.000
G2/G6	0.000	0.018	0.002	0.000	0.002	0.003	0.003	0.010	0.003	0.000
G3	0.003	0.024	0.013	0.002	0.049	0.005	0.000	0.002	0.005	0.000
G4	0.002	0.013	0.003	0.003	0.005	0.068	0.005	0.008	0.028	0.000
G5	0.013	0.003	0.002	0.003	0.000	0.005	0.019	0.006	0.008	0.000
G6	0.003	0.008	0.000	0.010	0.002	0.008	0.006	0.065	0.003	0.002
G7	0.002	0.011	0.003	0.003	0.005	0.028	0.008	0.003	0.078	0.000
G8	0.000	0.000	0.000	0.000	0.000	0.000	0.000	0.002	0.000	0.000

# matrices de mezcla por grupo de investigación
par(mfrow = c(2, 3))

for (red in redes) {
  corrplot(
    unclass(lista_mezcla[[paste(red, "group")]]),
    method = "color",
    is.corr = FALSE,
    col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
    tl.col = "black",
    tl.cex = 0.7,
    cl.cex = 0.6,
    title = paste("Grupo de investigación:", red),
    mar = c(0, 0, 2, 0)
  )
}

par(mfrow = c(1, 1))

En coauthor, lunch y leisure las conexiones se concentran en la diagonal, es decir, dentro de cada grupo, con pocas conexiones entre grupos. En work y facebook la matriz está más repartida: en work, el grupo G2 se conecta con los actores de grupos mixtos (G2/G3 y G2/G6) y con G6, y G4 con G7; en facebook, las conexiones se distribuyen entre casi todos los grupos. Estas son las relaciones que integran a la organización más allá de los grupos de investigación.

Rol académico

# matriz de mezcla por rol académico en cada red
for (red in redes) {
  print(knitr::kable(round(lista_mezcla[[paste(red, "role")]], 3), caption = paste(red, "- rol académico")))
  cat("\n\n")
}

lunch - rol académico

	Admin	Associate	Emeritus	PhD	Postdoc	Professor
Admin	0.059	0.005	0.003	0.043	0.013	0.003
Associate	0.005	0.005	0.003	0.043	0.011	0.003
Emeritus	0.003	0.003	0.000	0.000	0.000	0.000
PhD	0.043	0.043	0.000	0.299	0.120	0.021
Postdoc	0.013	0.011	0.000	0.120	0.059	0.013
Professor	0.003	0.003	0.000	0.021	0.013	0.016

facebook - rol académico

	Admin	Associate	PhD	Postdoc	Professor
Admin	0.026	0.004	0.052	0.026	0.034
Associate	0.004	0.000	0.017	0.013	0.004
PhD	0.052	0.017	0.233	0.112	0.047
Postdoc	0.026	0.013	0.112	0.052	0.026
Professor	0.034	0.004	0.047	0.026	0.017

coauthor - rol académico

	Admin	Associate	PhD	Postdoc	Professor
Admin	0.000	0.000	0.000	0.000	0.024
Associate	0.000	0.000	0.071	0.024	0.000
PhD	0.000	0.071	0.190	0.071	0.119
Postdoc	0.000	0.024	0.071	0.000	0.095
Professor	0.024	0.000	0.119	0.095	0.000

leisure - rol académico

	Admin	Associate	PhD	Postdoc	Professor
Admin	0.011	0.000	0.000	0.000	0.006
Associate	0.000	0.011	0.028	0.011	0.000
PhD	0.000	0.028	0.398	0.136	0.017
Postdoc	0.000	0.011	0.136	0.125	0.028
Professor	0.006	0.000	0.017	0.028	0.000

work - rol académico

	Admin	Assistant	Associate	PhD	Postdoc	Professor
Admin	0.073	0.000	0.034	0.084	0.028	0.017
Assistant	0.000	0.000	0.003	0.000	0.000	0.000
Associate	0.034	0.003	0.022	0.045	0.011	0.014
PhD	0.084	0.000	0.045	0.112	0.070	0.042
Postdoc	0.028	0.000	0.011	0.070	0.022	0.028
Professor	0.017	0.000	0.014	0.042	0.028	0.017

total - rol académico

	Admin	Assistant	Associate	Emeritus	PhD	Postdoc	Professor
Admin	0.039	0.000	0.019	0.001	0.054	0.022	0.018
Assistant	0.000	0.000	0.001	0.000	0.000	0.000	0.000
Associate	0.019	0.001	0.012	0.001	0.036	0.010	0.007
Emeritus	0.001	0.000	0.001	0.000	0.000	0.000	0.000
PhD	0.054	0.000	0.036	0.000	0.224	0.106	0.028
Postdoc	0.022	0.000	0.010	0.000	0.106	0.063	0.018
Professor	0.018	0.000	0.007	0.000	0.028	0.018	0.015

# matrices de mezcla por rol académico
par(mfrow = c(2, 3))

for (red in redes) {
  corrplot(
    unclass(lista_mezcla[[paste(red, "role")]]),
    method = "color",
    is.corr = FALSE,
    col = colorRampPalette(c("#f7fbff", "#6baed6", "#08519c"))(200),
    tl.col = "black",
    tl.cex = 0.7,
    cl.cex = 0.6,
    title = paste("Rol académico:", red),
    mar = c(0, 0, 2, 0)
  )
}

par(mfrow = c(1, 1))

Por rol, en la red agregada la celda más grande es PhD–PhD (22.4%), seguida de PhD–Postdoc (10.6%). Como los estudiantes de doctorado son la mitad de la organización, gran parte de esa concentración es esperable por su tamaño, lo que explica que \(p_{obs}\) sea apenas mayor que \(p_{esp}\).

Modelo nulo por permutación de etiquetas

Para evaluar si la mezcla observada difiere de la esperada bajo una asignación aleatoria de las características, se permutan las etiquetas entre los actores \(B = 999\) veces, manteniendo fija cada red y el tamaño de cada categoría. El valor \(p\) bilateral se calcula como

\[ p = \frac{1 + \sum_{b=1}^{B} \mathbb{I}\left( \left| r_a^{(b)} \right| \geq \left| r_a^{\text{obs}} \right| \right)}{B + 1}. \]

# distribución nula por permutación de etiquetas, manteniendo fija cada red
B <- 999

lista_nulo <- list()
lista_r_null <- list()

set.seed(123)
for (red in redes) {
  g_red <- obtener_red(red)

  for (atributo in atributos) {
    tipos <- actores_attr[[atributo]][match(V(g_red)$name, actores_attr$actor)]
    con_dato <- which(!is.na(tipos))
    g_attr <- induced_subgraph(g_red, con_dato)
    g.types <- as.integer(factor(tipos[con_dato]))

    r.obs <- assortativity_nominal(g_attr, types = g.types, directed = FALSE)

    r.null <- numeric(B)
    for (b in 1:B) {
      r.null[b] <- assortativity_nominal(g_attr, types = sample(g.types), directed = FALSE)
    }

    # valor p de permutación bilateral
    p.value <- (1 + sum(abs(r.null) >= abs(r.obs))) / (B + 1)

    lista_r_null[[paste(red, atributo)]] <- r.null

    lista_nulo[[paste(red, atributo)]] <- data.frame(
      red = red,
      atributo = atributo,
      r.obs = round(r.obs, 3),
      media.nula = round(mean(r.null), 3),
      p.value = round(p.value, 3)
    )
  }
}

df_nulo <- bind_rows(lista_nulo)
rownames(df_nulo) <- NULL
df_nulo

red	atributo	r.obs	media.nula	p.value
lunch	group	0.655	-0.021	0.001
lunch	role	0.139	-0.020	0.001
facebook	group	0.300	-0.041	0.001
facebook	role	0.035	-0.043	0.650
coauthor	group	0.876	-0.058	0.001
coauthor	role	-0.169	-0.063	0.226
leisure	group	0.590	-0.031	0.001
leisure	role	0.200	-0.036	0.003
work	group	0.420	-0.030	0.001
work	role	0.013	-0.029	0.807
total	group	0.425	-0.023	0.001
total	role	0.091	-0.021	0.001

# distribuciones nulas y asortatividad observada
for (atributo in atributos) {
  par(mfrow = c(2, 3), mar = c(4, 4, 3, 1))

  for (red in redes) {
    r.null <- lista_r_null[[paste(red, atributo)]]
    r.obs <- df_nulo$r.obs[df_nulo$red == red & df_nulo$atributo == atributo]

    # rango del eje x
    xlim <- range(c(r.null, r.obs))
    xlim <- xlim + c(-0.05, 0.05) * diff(xlim)

    # distribución de referencia
    hist(
      r.null,
      breaks = 25,
      probability = TRUE,
      xlim = xlim,
      col = "gray90",
      border = "gray60",
      xlab = "Coeficiente de asortatividad",
      ylab = "Densidad",
      main = paste(atributo, "-", red)
    )

    # asortatividad observada
    abline(v = r.obs, lwd = 2, lty = 2)
  }
}

par(mfrow = c(1, 1))

Por grupo de investigación, todas las redes tienen \(p = 0.001\), el mínimo posible con \(B = 999\): en todas las relaciones hay fuerte evidencia de mezcla no aleatoria por grupo. La media de las distribuciones nulas es levemente negativa, como se espera bajo permutación.

Por rol, la evidencia depende de la relación. Lunch (\(p = 0.001\)), leisure (\(p = 0.003\)) y la red agregada (\(p = 0.001\)) muestran mezcla asortativa significativa aunque débil, mientras que en facebook (\(p = 0.650\)), work (\(p = 0.810\)) y coauthor (\(p = 0.226\)) no hay evidencia de que la mezcla por rol difiera de la aleatoria. Los actores del mismo rol tienden a almorzar y compartir actividades de ocio entre ellos, pero no a trabajar, publicar o conectarse en Facebook preferentemente con su mismo rol. Esto matiza el resultado de la sección 3.8: aunque las comunidades no se forman por rol (ARI cercano a 0), en almuerzo y ocio sí existe una preferencia débil por conectarse con actores del mismo rol.

Comparación con la red agregada

Para cada capa y característica se compara la asortatividad de la capa con la de la red agregada, y se clasifica el efecto de la agregación con la siguiente regla:

• Modifica: el signo es distinto o la significancia cambia (\(p < 0.05\) en una red y no en la otra).
• Conserva: la diferencia es pequeña, \(|r_{total} - r_{capa}| < 0.1\).
• Atenúa: la red agregada es menos asortativa que la capa.
• Intensifica: la red agregada es más asortativa que la capa.

# asortatividad y valor p de cada capa junto a los de la red agregada
df_total <- df_nulo %>%
  filter(red == "total") %>%
  select(atributo, r.total = r.obs, p.total = p.value)

df_comparacion_agregada <- df_nulo %>%
  filter(red != "total") %>%
  select(red, atributo, r.capa = r.obs, p.capa = p.value) %>%
  left_join(df_total, by = "atributo") %>%
  mutate(
    diferencia = round(r.total - r.capa, 3),
    efecto = case_when(
      sign(r.capa) != sign(r.total) ~ "Modifica",
      (p.capa < 0.05) != (p.total < 0.05) ~ "Modifica",
      abs(diferencia) < 0.1 ~ "Conserva",
      abs(r.total) < abs(r.capa) ~ "Atenúa",
      TRUE ~ "Intensifica"
    )
  ) %>%
  arrange(atributo, desc(abs(diferencia)))

df_comparacion_agregada

red	atributo	r.capa	p.capa	r.total	p.total	diferencia	efecto
coauthor	group	0.876	0.001	0.425	0.001	-0.451	Atenúa
lunch	group	0.655	0.001	0.425	0.001	-0.230	Atenúa
leisure	group	0.590	0.001	0.425	0.001	-0.165	Atenúa
facebook	group	0.300	0.001	0.425	0.001	0.125	Intensifica
work	group	0.420	0.001	0.425	0.001	0.005	Conserva
coauthor	role	-0.169	0.226	0.091	0.001	0.260	Modifica
leisure	role	0.200	0.003	0.091	0.001	-0.109	Atenúa
work	role	0.013	0.807	0.091	0.001	0.078	Modifica
facebook	role	0.035	0.650	0.091	0.001	0.056	Modifica
lunch	role	0.139	0.001	0.091	0.001	-0.048	Conserva

Por grupo de investigación, la agregación atenúa la asortatividad de coauthor, lunch y leisure, con la mayor diferencia en coauthor (\(-0.451\)); conserva la de work, cuyo valor es casi igual al de la red agregada, e intensifica la de facebook. La red agregada se ubica en un punto intermedio que no representa a las relaciones más concentradas.

Por rol, la agregación modifica la asociación en coauthor, work y facebook: en esas capas la mezcla por rol no es significativa, mientras que en la red agregada sí lo es, y en coauthor además cambia el signo. Solo en lunch se conserva, y en leisure se atenúa.

La agregación atenúa la asortatividad por grupo respecto de las relaciones más concentradas y modifica la lectura por rol: en la red agregada la mezcla por rol resulta significativa, pero esa preferencia solo existe en lunch y leisure.

3.10 Consecuencias de la agregación

Multiplicidad de las aristas

La multiplicidad de una arista es el número de capas en las que aparece.

aristas <- as.data.frame(edges_ml(net))

aristas <- aristas %>%
  mutate(
    actor1= pmin(from_actor,to_actor),
    actor2=pmax(from_actor, to_actor)
  )

aristas_por_capa <- aristas %>%
  distinct(from_layer, actor1, actor2)

aristas_por_capa$par <- paste(aristas_por_capa$actor1, aristas_por_capa$actor2, sep = "-")
pares <- as.data.frame.matrix(table(aristas_por_capa$par, aristas_por_capa$from_layer))
pares$n_capas <- rowSums(pares)
head(pares)

	coauthor	facebook	leisure	lunch	work	n_capas
U1-U10	1	1	1	1	1	5
U1-U106	0	1	0	0	0	1
U1-U124	0	0	0	0	1	1
U1-U130	0	0	0	0	1	1
U1-U139	0	0	0	0	1	1
U1-U14	0	0	1	1	1	3

# Número de pares según la cantidad de capas en que aparecen
table(pares$n_capas)

Var1	Freq
1	179
2	101
3	56
4	14
5	3

De los 353 pares conectados en la red agregada, 179 (51%) aparecen en una sola capa, y solo 3 (U1–U10, U110–U91 y U29–U32) aparecen en las cinco.

Posición estructural según la multiplicidad

Para cada par y cada capa en la que está conectado se revisa si sus dos actores pertenecen a la misma comunidad de esa capa (Louvain, sección 3.8). Las columnas com_ valen 1 si están en la misma comunidad, 0 si no, y NA si el par no está conectado en esa capa.

# Actores de cada par, a partir del nombre de la fila ("U1-U10")
actor1 <- sub("-.*", "", rownames(pares))
actor2 <- sub(".*-", "", rownames(pares))

for (capa in capas) {
  # Comunidad de cada actor en la capa (Louvain del primer ciclo de la 3.8)
  memb <- membership(lista_comunidades[[capa]][["louvain"]])

  # 1 si los dos actores están en la misma comunidad de la capa, 0 si no
  misma <- as.integer(memb[actor1] == memb[actor2])

  # NA si el par no está conectado en esa capa
  misma[pares[[capa]] == 0] <- NA

  pares[[paste0("com_", capa)]] <- misma
}

# Proporción de las capas del par en que los dos actores están en la misma comunidad
pares$prop_misma_comunidad <- rowMeans(pares[, paste0("com_", capas)], na.rm = TRUE)

head(pares[order(-pares$n_capas), ])

	coauthor	facebook	leisure	lunch	work	n_capas	com_lunch	com_facebook	com_coauthor	com_leisure	com_work	prop_misma_comunidad
U1-U10	1	1	1	1	1	5	1	0	1	0	1	0.6
U110-U91	1	1	1	1	1	5	1	1	1	1	1	1.0
U29-U32	1	1	1	1	1	5	1	1	1	1	1	1.0
U106-U118	1	0	1	1	1	4	1	NA	1	1	1	1.0
U107-U32	0	1	1	1	1	4	1	1	NA	1	1	1.0
U109-U54	0	1	1	1	1	4	1	1	NA	1	1	1.0

pares %>%
  group_by(n_capas) %>%
  summarise(
    pares = n(),
    prop_misma_comunidad = round(mean(prop_misma_comunidad), 3)
  )

n_capas	pares	prop_misma_comunidad
1	179	0.620
2	101	0.772
3	56	0.881
4	14	0.946
5	3	0.867

Cuanto mayor es la multiplicidad, más probable es que la relación una a actores de la misma comunidad: 64% para los pares de una sola capa y 95% para los de cuatro. Las relaciones presentes en varias capas ocupan una posición interna a las comunidades, mientras que las de una sola capa son las que más conectan comunidades distintas. Aun así, hay excepciones: U1 y U10 están conectados en las cinco capas, pero en facebook y leisure pertenecen a comunidades distintas.

Unión binaria, agregación ponderada y aristas en al menos dos capas

Se comparan tres representaciones agregadas: la unión binaria (todo par conectado en al menos una capa), la agregación ponderada (los mismos pares, con peso igual a la multiplicidad) y la red de aristas presentes en al menos dos capas. En la red ponderada, la fuerza reemplaza al grado, Louvain usa los pesos y la intermediación usa el inverso del peso, de modo que una relación más multiplex corresponde a un camino más corto. La densidad, la componente gigante y la distancia promedio se calculan sin pesos.

# Lista de aristas con su multiplicidad como peso
aristas_pares <- data.frame(
  actor1 = sub("-.*", "", rownames(pares)),
  actor2 = sub(".*-", "", rownames(pares)),
  weight = pares$n_capas
)

# Agregación ponderada: peso = número de capas en que aparece el par
g_ponderada <- graph_from_data_frame(aristas_pares, directed = FALSE, vertices = nombres)

# Aristas presentes en al menos dos capas
g_multiplex <- graph_from_data_frame(
  aristas_pares[aristas_pares$weight >= 2, ],
  directed = FALSE,
  vertices = nombres
)

redes_agregadas <- list(
  union_binaria = obtener_red("total"),
  ponderada = g_ponderada,
  multiplex = g_multiplex
)

lista_comparacion <- list()

set.seed(123)
for (nombre in names(redes_agregadas)) {
  g <- redes_agregadas[[nombre]]

  # Pesos: multiplicidad en la red ponderada, 1 en las demás
  if (nombre == "ponderada") {
    pesos <- E(g)$weight
  } else {
    pesos <- rep(1, ecount(g))
  }

  # Fuerza (suma de pesos) e intermediación; en caminos, más peso = más cerca
  grado <- strength(g, weights = pesos)
  intermediacion <- betweenness(g, weights = 1 / pesos)
  com <- cluster_louvain(g, weights = pesos)

  lista_comparacion[[nombre]] <- data.frame(
    red = nombre,
    aristas = ecount(g),
    densidad = round(edge_density(g), 3),
    componente_gigante = max(components(g)$csize),
    distancia_promedio = round(mean_distance(g, weights = NA), 3),
    comunidades = length(com),
    modularidad = round(modularity(com), 3),
    top5_grado = paste(names(sort(grado, decreasing = TRUE))[1:5], collapse = ", "),
    top5_intermediacion = paste(names(sort(intermediacion, decreasing = TRUE))[1:5], collapse = ", ")
  )
}

df_comparacion_redes <- bind_rows(lista_comparacion)
rownames(df_comparacion_redes) <- NULL
df_comparacion_redes

red	aristas	densidad	componente_gigante	distancia_promedio	comunidades	modularidad	top5_grado	top5_intermediacion
union_binaria	353	0.193	61	2.06	5	0.416	U123, U4, U79, U67, U91	U4, U123, U91, U67, U79
ponderada	353	0.193	61	2.06	5	0.495	U4, U67, U91, U123, U79	U4, U67, U130, U79, U110
multiplex	174	0.095	57	2.63	9	0.581	U4, U67, U79, U123, U91	U4, U67, U123, U79, U1

Conclusiones robustas. Los actores más centrales por grado son prácticamente los mismos en las tres representaciones (U4, U67, U79, U123 y U91), y U4 es el principal intermediario en todas. La organización permanece conectada aun usando solo relaciones multiplex: la componente gigante conserva 57 de los 61 actores.

Conclusiones que dependen de la agregación. Al conservar solo las aristas multiplex, la red pierde la mitad de sus aristas, la distancia promedio aumenta de 2.06 a 2.63 y cuatro actores quedan aislados. La estructura comunitaria se vuelve más marcada: la modularidad sube de 0.416 en la unión binaria a 0.495 en la ponderada y 0.581 en la red multiplex, donde las 9 comunidades corresponden a 5 grupos más los 4 actores aislados. La intermediación también cambia: en la red ponderada aparecen U130 y U110 entre los cinco principales intermediarios, porque los caminos más cortos pasan por las relaciones más multiplex.

4 Discusión

Las cinco relaciones de AUCS no son versiones de una misma red. Lunch y work son las capas más parecidas entre sí: comparten 98 aristas, muchas más de las esperadas por sus grados, y son también las que sostienen la conectividad de la organización, ya que ambas incluyen a casi todos los actores y su eliminación conjunta reduce la componente gigante de la red agregada en un 12%, más que la suma de sus efectos individuales. Facebook y leisure aportan información complementaria, con menor superposición y una cobertura parcial de la organización, y coauthor es la relación más distinta: cubre solo 25 actores, está fragmentada en pequeños grupos y comparte muy pocas aristas y casi ninguna correlación de grado con las demás.

La posición de los actores depende fuertemente del contexto. Las correlaciones de rango de las centralidades entre capas son bajas y los actores más centrales casi no se repiten de una relación a otra: quien es central en el trabajo puede ser periférico en el ocio, como U123, el actor con más vínculos laborales, que no participa en leisure. Los roles genuinamente multicapa son pocos. La participación identifica actores con actividad repartida entre capas, como U10, U18 y U113; la intermediación identifica brokers que conectan partes distintas de la organización en varias relaciones, como U110, U130 y U79; y U4 y U67 combinan una alta centralidad en la red agregada con intermediación en tres capas.

La estructura comunitaria tampoco es estable entre relaciones. Los grupos de almuerzo se parecen a los de coautoría y Facebook, pero los de trabajo y ocio se organizan de forma distinta, y en el análisis multicapa alrededor de veinte actores pertenecen a comunidades diferentes según la relación, mientras el acoplamiento entre capas no los obliga a coincidir. Lo que atraviesa todas las relaciones es el grupo de investigación: la mezcla por grupo es asortativa y significativa en todas las capas, aunque con intensidad muy diferente, desde la coautoría, casi confinada a cada grupo, hasta Facebook, mucho más abierta. El rol académico, en cambio, apenas organiza las relaciones: las comunidades no se corresponden con los roles, y la preferencia por el mismo rol solo aparece, débil, en almuerzo y ocio.

Agregar las capas conserva algunas conclusiones y altera otras. Los actores más centrales y el principal intermediario (U4) son los mismos en la unión binaria, en la agregación ponderada y en la red formada solo por aristas presentes en varias capas, y la organización permanece conectada en las tres representaciones. Pero la agregación atenúa la asortatividad por grupo, que en la red agregada queda muy por debajo de las relaciones más cerradas, y modifica la lectura por rol, que aparece como significativa aunque solo lo es en dos capas. Además, la red agregada produce estructuras que no existen en ninguna relación: 216 de sus 762 triángulos se forman combinando aristas de capas distintas, y presenta cliques de nueve actores y un núcleo con k = 10, cuando ninguna capa supera k = 7. Estas estructuras sugieren una cohesión que no corresponde a ningún contexto real de interacción. Las relaciones presentes en varias capas tampoco se distribuyen al azar: son casi siempre internas a las comunidades, mientras que las relaciones de una sola capa son las que más conectan grupos distintos, de modo que una agregación ponderada refuerza las primeras y resta importancia a las segundas.

La representación adecuada depende de la pregunta. Para estudiar la conectividad global y la robustez de la organización, la unión binaria es suficiente y sus conclusiones son estables. Para identificar grupos cohesionados conviene la agregación ponderada o la red de aristas presentes en varias capas, que destacan los vínculos reforzados en varios contextos y producen comunidades más nítidas. Para entender la posición de un actor, la composición de los grupos o la influencia de los atributos, la red agregada es insuficiente: es necesario analizar cada capa por separado o con métodos multicapa como glouvain, que permiten que un actor pertenezca a grupos distintos según la relación.

En síntesis, la posición, las comunidades y la integración social de una persona en AUCS dependen en buena medida del tipo de relación observado. La red agregada describe bien quiénes están en el centro de la organización y cómo se mantiene conectada, pero pierde el tipo de cada vínculo, atenúa diferencias importantes entre relaciones y genera estructuras de cohesión que no existen en ningún contexto concreto.

Limitaciones

1. Actores ausentes tratados como aislados. En varios análisis, un actor que no aparece en una capa se considera aislado. Sin embargo, no figurar en coauthor puede significar que el rol del actor no incluye publicar, como en el caso del personal administrativo, y no que esté desconectado. Esto afecta la fragmentación, las correlaciones con valor 0 y las comparaciones entre capas.
2. Resultados que dependen de decisiones metodológicas. Varios resultados dependen de umbrales elegidos por el analista, como el percentil 75 para los brokers, k = 10 para los primeros actores o los valores de omega. Además, Louvain, Leiden y glouvain son estocásticos; glouvain_ml() no responde a set.seed(), por lo que sus resultados varían levemente entre ejecuciones, e infomap_ml() no está disponible en la versión de CRAN de multinet.
3. Alcance de los datos. Se trata de un solo departamento universitario, con 61 actores y relaciones observadas en un único momento. Los resultados no pueden generalizarse a otras organizaciones ni describen cómo cambian las relaciones en el tiempo.
4. Atributos incompletos y relaciones binarias. Seis actores no tienen grupo de investigación y uno no tiene rol, existen grupos mixtos y categorías de un solo actor, lo que limita la asortatividad y la comparación con las comunidades. Además, las relaciones son binarias: no se conoce su intensidad, por ejemplo con qué frecuencia almuerzan juntos dos actores.