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

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

Punto1. Grafo

Considere el grafo G=(V,E), con V={1,2,3,4,5}, y E={{1,2};{1,3};{2,3};{2,4};{2,5};{3,5};{4,5}}.

library(igraph)
library(sand)
library(corrplot)
library(Matrix)

Definir el grafo

g <- graph_from_literal(
  1-2, 
  1-3, 
  2-3, 
  2-4, 
  2-5, 
  3-5, 
  4-5
)

Graficar G

plot(g, 
     main = "Grafo G",
     vertex.size = 25,
     vertex.label.color = "black")

Calcular el orden, el tamaño, y el diámetro del grafo.

vcount(g)

## [1] 5

El grafo tiene 5 vértices (o nodos).

ecount(g)

## [1] 7

El grafo tiene 7 aristas (o enlaces).

diameter(g)

## [1] 2

La distancia más larga entre cualquier par de nodos en el grafo es 2 pasos

c)Calcular el grado de cada vértice.

degree(g)

## 1 2 3 4 5 
## 2 4 3 2 3

El grado es cuántas conexiones tiene cada nodo específico: Vértice,Grado (Conexiones) Vértice 1,2 conexiones Vértice 2,4 conexiones (¡Es el más conectado!) Vértice 3,3 conexiones Vértice 4,2 conexiones Vértice 5,3 conexiones

Graficar el subgrafo generado por los nodos 1, 2, 3, y 4.

sub_nodes <- c(1, 2, 3, 4)
dg_sub <- induced_subgraph(g, sub_nodes)

plot(
  dg_sub,
  main = "Subgrafo dirigido inducido por {1, 2, 3, 4}",
  vertex.size = 25,
  vertex.label.color = "black",
  edge.arrow.size = 0.6
)

Punto2. Digrafo

Considere el digrafo G=(V,E), con V={1,2,3,4,5} y E={(1,3);(2,3);(2,4);(2,5);(3,1);(3,5);(4,5);(5,4)}**

Definir el DIGRAFO con aristas dirigidas

dg <- graph_from_literal(
  1 -+ 3,
  2 -+ 3,
  2 -+ 4,
  2 -+ 5,
  3 -+ 1,
  3 -+ 5,
  4 -+ 5,
  5 -+ 4
)

Graficar el digrafo

plot(
  dg,
  main = "Digrafo G",
  vertex.size = 25,
  vertex.label.color = "black",
  edge.arrow.size = 0.6
)

Calcular el orden, el tamaño, y el diámetro del grafo

vcount(dg)

## [1] 5

ecount(dg)

## [1] 8

diameter(dg, directed = TRUE)

## [1] 3

Este es un digrafo (grafo dirigido) de 5 vértices y 8 arcos, donde la ruta más larga entre dos nodos conectados es de 3 pasos, respetando el sentido de las flechas.

c)Calcular el grado de cada vértice

grado de salida (out-degree)

degree(dg, mode = "out")

## 1 3 2 4 5 
## 1 2 3 1 1

#grado de entrada (in-degree)

degree(dg, mode = "in")

## 1 3 2 4 5 
## 1 2 0 2 3

#Grado total

degree(dg, mode = "all")

## 1 3 2 4 5 
## 2 4 3 3 4

d)Graficar el subgrafo generado por los nodos 1, 2, 3, y 4.

sub_nodes <- c(1, 2, 3, 4)
dg_sub <- induced_subgraph(dg, sub_nodes)

plot(
  dg_sub,
  main = "Subgrafo dirigido inducido por {1, 2, 3, 4}",
  vertex.size = 25,
  vertex.label.color = "black",
  edge.arrow.size = 0.6
)

Punto3. Triada

Una triada es un subgrafo generado por una tripla de vértices.

Generar todas las combinaciones de 0,1,2,3 (tipos de relación por par). 0 = sin arista. 1 = i -> j. 2 = j -> i. 3 = arista mutua (i <-> j).

relaciones <- expand.grid(0:3,0:3,0:3)

triads <- list()

for(k in 1:nrow(relaciones)){
  r <- relaciones[k,]
  
  M <- matrix(0,3,3)
  
  # Par (1,2)
  if(r[1]==1) M[1,2] <- 1
  if(r[1]==2) M[2,1] <- 1
  if(r[1]==3) M[1,2] <- M[2,1] <- 1
  
  # Par (1,3)
  if(r[2]==1) M[1,3] <- 1
  if(r[2]==2) M[3,1] <- 1
  if(r[2]==3) M[1,3] <- M[3,1] <- 1
  
  # Par (2,3)
  if(r[3]==1) M[2,3] <- 1
  if(r[3]==2) M[3,2] <- 1
  if(r[3]==3) M[2,3] <- M[3,2] <- 1
  
  g <- graph_from_adjacency_matrix(M, mode="directed")
  triads[[k]] <- g
}

length(triads)

## [1] 64

Graficar las 64 triadas

relaciones <- expand.grid(0:3,0:3,0:3)
triads <- list()

for(k in 1:nrow(relaciones)){
  r <- relaciones[k,]
  M <- matrix(0,3,3)
  
  # Par (1,2)
  if(r[1]==1) M[1,2] <- 1
  if(r[1]==2) M[2,1] <- 1
  if(r[1]==3) M[1,2] <- M[2,1] <- 1
  
  # Par (1,3)
  if(r[2]==1) M[1,3] <- 1
  if(r[2]==2) M[3,1] <- 1
  if(r[2]==3) M[1,3] <- M[3,1] <- 1
  
  # Par (2,3)
  if(r[3]==1) M[2,3] <- 1
  if(r[3]==2) M[3,2] <- 1
  if(r[3]==3) M[2,3] <- M[3,2] <- 1
  
  triads[[k]] <- graph_from_adjacency_matrix(M, mode="directed")
}

AGRUPAR POR ISOMORFISMO

iso_groups <- list()
remaining <- 1:64

while(length(remaining) > 0){
  rep <- remaining[1]
  grupo <- c(rep)
  
  for(j in remaining[-1]){
    if(graph.isomorphic(triads[[rep]], triads[[j]])){
      grupo <- c(grupo, j)
    }
  }
  
  iso_groups[[length(iso_groups)+1]] <- grupo
  remaining <- setdiff(remaining, grupo)
}

Visualización de Clases Isomorfas

# 1. Ajuste para R Markdown: Eliminamos readline() y mejoramos el layout
group_number <- 1

for(grupo in iso_groups){
  
  n <- length(grupo)
  # Calculamos filas dinámicamente para que los gráficos no se amontonen
  filas <- ceiling(n / 3)
  
  # Ajustamos márgenes para que quepan los títulos
  par(mfrow=c(filas, 3), mar=c(2, 2, 4, 2))
  
  for(id in grupo){
    plot(
      triads[[id]],
      vertex.size=30,
      vertex.label.cex=1.5,
      edge.arrow.size=0.6,
      vertex.color="orange",
      main=paste("Tríada ID:", id)
    )
  }
  
  # Título superior para cada grupo de gráficos
  title(main=paste("Clase Isomorfa", group_number), outer=TRUE, line=-1.5, cex.main=2)
  
  group_number <- group_number + 1
  
}

Resumen de Clases Isomorfas de Tríadas

library(knitr)

# 1. Preparar los datos en un Data Frame organizado
resumen_lista <- lapply(seq_along(iso_groups), function(i) {
  data.frame(
    Clase = paste("Clase", i),
    Tamaño = length(iso_groups[[i]]),
    Representante = iso_groups[[i]][1],
    Integrantes = paste(iso_groups[[i]], collapse = ", ")
  )
})

resumen_df <- do.call(rbind, resumen_lista)

# 2. Mostrar la tabla con un formato profesional
kable(resumen_df, 
      col.names = c("Clase Isomorfa", "N° de Tríadas", "ID Representante", "IDs en el grupo"),
      caption = "Análisis de Estructuras Únicas (Isomorfismo)",
      align = "cllc")

Análisis de Estructuras Únicas (Isomorfismo)
Clase Isomorfa	N° de Tríadas	ID Representante	IDs en el grupo
Clase 1	1	1	1
Clase 2	6	2	2, 3, 5, 9, 17, 33
Clase 3	3	4	4, 13, 49
Clase 4	3	6	6, 19, 41
Clase 5	6	7	7, 10, 18, 25, 35, 37
Clase 6	6	8	8, 14, 20, 45, 51, 57
Clase 7	3	11	11, 21, 34
Clase 8	6	12	12, 15, 29, 36, 50, 53
Clase 9	3	16	16, 52, 61
Clase 10	6	22	22, 23, 27, 38, 42, 43
Clase 11	3	24	24, 46, 59
Clase 12	2	26	26, 39
Clase 13	6	28	28, 30, 40, 47, 55, 58
Clase 14	3	31	31, 44, 54
Clase 15	6	32	32, 48, 56, 60, 62, 63
Clase 16	1	64	64

Punto 4: Simulación de Redes Aleatorias

En esta sección se define una función para simular redes basadas en el modelo de enlaces independientes (Erdős-Rényi), permitiendo configurar parámetros de orden, densidad y direccionalidad.

Definición de la Función

library(igraph)

#' Simulación de redes dirigidas y no dirigidas
#' @param n Orden de la red (número de vértices)
#' @param p Probabilidad de interacción (default 0.5)
#' @param directed Booleano, define si la red es dirigida (default FALSE)
#' @param seed Semilla para reproducibilidad (default 42)
sim_red <- function(n, p = 0.5, directed = FALSE, seed = 42) {
  set.seed(seed)
  
  if (!directed) {
    # Para redes NO dirigidas:
    # Generamos solo la parte triangular inferior para asegurar que 
    # cada par {i,j} se evalúe una sola vez con probabilidad p.
    M <- matrix(0, n, n)
    M[lower.tri(M)] <- rbinom(n * (n - 1) / 2, 1, p)
    M <- M + t(M) # Simetrizar la matriz
  } else {
    # Para redes DIRIGIDAS:
    # Cada arco (i -> j) es independiente de (j -> i).
    M <- matrix(rbinom(n * n, 1, p), n, n)
    diag(M) <- 0 # Eliminar auto-lazos
  }
  
  # Crear objeto igraph para análisis y visualización
  g <- graph_from_adjacency_matrix(M, mode = if(directed) "directed" else "undirected")
  
  # Configuración estética de la visualización
  plot(
    g,
    vertex.color = "gold",
    vertex.frame.color = "darkorange",
    vertex.size = 25,
    vertex.label.color = "black",
    edge.color = "gray70",
    edge.arrow.size = 0.5,
    main = paste0("Red ", if(directed) "Dirigida" else "No Dirigida", 
                  "\n(n=", n, ", p=", p, ")")
  )
  
  return(M)
}

Pruebas de la Rutina (4 Casos) A continuación, se generan cuatro escenarios distintos para validar el comportamiento de la función.

# Ajustamos el layout para ver los 4 casos en una cuadrícula de 2x2
par(mfrow=c(2,2))

# Caso 1: Red no dirigida pequeña (Equilibrio)
m1 <- sim_red(n = 5, p = 0.5, directed = FALSE, seed = 101)

# Caso 2: Red no dirigida densa
m2 <- sim_red(n = 7, p = 0.8, directed = FALSE, seed = 102)

# Caso 3: Digrafo ralo (Baja probabilidad)
m3 <- sim_red(n = 6, p = 0.2, directed = TRUE, seed = 103)

# Caso 4: Digrafo de mayor orden y complejidad
m4 <- sim_red(n = 12, p = 0.4, directed = TRUE, seed = 104)

# Restaurar layout original
par(mfrow=c(1,1))

Independencia: En la versión no dirigida, se utilizó lower.tri para garantizar que la probabilidad de enlace entre dos nodos sea exactamente \(p\).Matriz de Adyacencia: La función retorna la matriz \(M\). Por ejemplo, para el Caso 1, la matriz resultante es:

print(m1)

##      [,1] [,2] [,3] [,4] [,5]
## [1,]    0    0    0    1    1
## [2,]    0    0    0    0    1
## [3,]    0    0    0    0    1
## [4,]    1    0    0    0    1
## [5,]    1    1    1    1    0

Punto 5. Reconstrucción de Matriz de Adyacencia

Reconstrucción de Matriz de Adyacencia

En este apartado se desarrolla una función para reconstruir una matriz de adyacencia a partir de su lista de aristas (edgelist) y la identificación de nodos aislados, asegurando la integridad del orden de la red.

Función de Reconstrucción

#' Reconstrucción de matriz de adyacencia
#' @param edge_list Matriz o data.frame con las conexiones (u, v)
#' @param aislados Vector con los índices de nodos sin conexiones
#' @param n_total El número total de vértices (orden de la red)
reconstruir_matriz <- function(edge_list, aislados = NULL, n_total) {
  
  # 1. Crear matriz de adyacencia vacía del tamaño correcto
  A <- matrix(0, nrow = n_total, ncol = n_total)
  
  # 2. Rellenar con las aristas existentes (si las hay)
  if (!is.null(edge_list) && nrow(edge_list) > 0) {
    for (i in 1:nrow(edge_list)) {
      u <- edge_list[i, 1]
      v <- edge_list[i, 2]
      
      A[u, v] <- 1
      A[v, u] <- 1  # Al ser no dirigida, la matriz es simétrica
    }
  }
  
  # Nota: Los nodos aislados ya están representados por filas/columnas de ceros
  return(A)
}

Prueba con Red Aleatoria (n=25, p=0.1) Generamos primero la red de referencia y extraemos sus componentes para probar la función.

# 1. Generar red original
set.seed(42)
n <- 25
p <- 0.1

# Crear matriz aleatoria simétrica (modelo Erdős-Rényi)
M_original <- matrix(rbinom(n*n, 1, p), n, n)
M_original[upper.tri(M_original)] <- 0 # Solo dejamos una mitad
diag(M_original) <- 0                  # Sin lazos
M_original <- M_original + t(M_original)

# 2. Extraer información para la reconstrucción
g_temp <- graph_from_adjacency_matrix(M_original, mode = "undirected")
lista_aristas <- as_edgelist(g_temp)
nodos_aislados <- which(degree(g_temp) == 0)

# 3. Ejecutar reconstrucción
A_rec <- reconstruir_matriz(edge_list = lista_aristas, 
                            aislados = nodos_aislados, 
                            n_total = n)

# 4. Validación: ¿Es idéntica a la original?
identicas <- all(A_rec == M_original)
cat("¿La matriz reconstruida es igual a la original?:", identicas, "\n")

## ¿La matriz reconstruida es igual a la original?: TRUE

Visualización de la Red Reconstruida

# 1. Preparación del grafo
g_rec <- graph_from_adjacency_matrix(A_rec, mode = "undirected")

# 2. Definición del Layout (Fruchterman-Reingold con más repulsión)
# Aumentamos el área para que los nodos no se amontonen
coords <- layout_with_fr(g_rec, niter = 1000) 

# 3. Configuración estética mejorada
V(g_rec)$color <- ifelse(degree(g_rec) == 0, "#FF6347", "#5DADE2") # Tomate y Azul acero
V(g_rec)$frame.color <- "white"      # Borde blanco para los nodos
V(g_rec)$label.color <- "black"      # Texto negro para mejor contraste
V(g_rec)$label.font <- 2             # Negrita
V(g_rec)$label.cex <- 0.85           # Tamaño de letra equilibrado
v_sizes <- 12 + (degree(g_rec) * 1.5) # Nodos base más grandes para que quepa el número

# 4. Dibujo de la red
plot(
  g_rec,
  layout = coords,
  vertex.size = v_sizes,
  vertex.label.dist = 0,             # Centrar número en el nodo
  edge.color = adjustcolor("gray60", alpha.f = 0.4),
  edge.width = 1.5,
  main = "Red Reconstruida (n=25, p=0.1)",
  sub = "Nodos destacados por grado; aislados en rojo"
)

Punto 6: Descomposición de la Matriz de Adyacencia

En este ejercicio se desarrolla una función para realizar el proceso inverso: extraer la lista de aristas (edgelist) y el vector de nodos aislados a partir de una matriz de adyacencia dada.

Función de Extracción

#' Obtener lista de aristas y aislados
#' @param A Matriz de adyacencia
#' @return Una lista con la matriz de aristas, los índices de nodos aislados y el objeto grafo
obtener_aristas_y_aislados <- function(A) {
  
  # 1. Crear el objeto grafo (asumimos no dirigido según el enunciado)
  g <- graph_from_adjacency_matrix(A, mode = "undirected")
  
  # 2. Extraer la lista de aristas
  # Convertimos a matriz numérica para facilitar cálculos posteriores
  edge_list <- as_edgelist(g)
  if(nrow(edge_list) > 0) {
    edge_list <- apply(edge_list, 2, as.numeric)
  }
  
  # 3. Identificar nodos con grado cero
  aislados <- which(degree(g) == 0)
  
  return(list(
    edge_list = edge_list,
    aislados = aislados,
    grafo = g
  ))
}

Prueba con Red de 25 Nodos (p = 0.1) Generamos una red aleatoria para testear la rutina y mostramos los componentes extraídos.

# Configuración de la red
set.seed(42)
n <- 25
p <- 0.1

# Generación de la matriz de adyacencia (Modelo Erdős-Rényi)
M <- matrix(rbinom(n*n, 1, p), n, n)
M[upper.tri(M)] <- 0
diag(M) <- 0
M <- M + t(M)

# Ejecución de la rutina
resultado <- obtener_aristas_y_aislados(M)

# Extraer para facilitar el uso
el       <- resultado$edge_list
aislados <- resultado$aislados
g_prueba <- resultado$grafo

# Mostrar un resumen de los resultados
cat("Número total de aristas encontradas:", nrow(el), "\n")

## Número total de aristas encontradas: 36

cat("Nodos identificados como aislados:", 
    if(length(aislados) > 0) paste(aislados, collapse = ", ") else "Ninguno", "\n")

## Nodos identificados como aislados: Ninguno

Visualización de la Red de Prueba Para esta visualización, utilizaremos un estilo de alto contraste para asegurar que las etiquetas de los 25 nodos sean legibles.

# Definir Layout estable
coords <- layout_with_kk(g_prueba)

# Configuración visual
V(g_prueba)$color <- ifelse(degree(g_prueba) == 0, "#E74C3C", "#2ECC71") # Rojo aislados, Verde otros
v_size <- 10 + (degree(g_prueba) * 1.5)

plot(
  g_prueba,
  layout = coords,
  vertex.size = v_size,
  vertex.frame.color = "white",
  vertex.label.color = "black",
  vertex.label.font = 2,
  vertex.label.cex = 0.7,
  edge.color = adjustcolor("gray40", alpha.f = 0.5),
  edge.width = 1.2,
  main = "Red de Prueba (Extracción de Componentes)",
  sub = "Nodos verdes: Conectados | Nodos rojos: Aislados"
)

Prueba función

La forma más técnica de validar la función es comprobar si, al tomar los resultados de tu función (edge_list y aislados) y meterlos en la función del punto anterior (reconstruir_matriz), regresas exactamente a la matriz original \(M\).

# Intentamos reconstruir M usando la salida de tu función
M_validada <- reconstruir_matriz(edge_list = el, 
                                 aislados = aislados, 
                                 n_total = 25)

# Comprobación lógica
son_identicas <- all(M_validada == M)
cat("¿La validación cruzada es exitosa?:", son_identicas)

## ¿La validación cruzada es exitosa?: TRUE

Validación por Propiedades (Suma de Grados) Existe una regla matemática llamada el Lema del Apretón de Manos. Dice que la suma de todos los grados de los nodos debe ser igual al doble del número de aristas.

sum(degree(g_prueba)) == 2 * nrow(el)

## [1] TRUE

Punto 7: Análisis de la Red Escolar (AddHealth)

Este apartado analiza el conjunto de datos addhealth.RData, que documenta las redes de amistad y actividades extracurriculares en una comunidad escolar estadounidense. El objetivo es caracterizar la red desde una perspectiva estructural y sociodemográfica.

1. Clasificación de Variables

A partir de la inspección de los datos originales (X para nodos y E para enlaces), se identifican las siguientes variables:

Variables Nodales (Atributos):

female: Categórica dicotómica (0 = No, 1 = Sí).

race: Categórica nominal (1 = Blanco, 2 = Negro, 3 = Hispano, 4 = Otro).

grade: Categórica ordinal (representa el nivel escolar).

Variables Relacionales (Arcos):

V1 y V2: Variables de identificación que definen la dirección de la nominación (quién nomina a quién).

activities: Cuantitativa discreta. Representa la intensidad o el peso de la relación basada en actividades compartidas.

2. Carga y Preparación de la Red

Para la construcción del grafo, se asegura la correspondencia unívoca entre la lista de aristas y los atributos nodales, utilizando los índices de los sujetos como identificadores únicos.

library(igraph)
library(RColorBrewer)

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

# Preparación de vértices con ID único para evitar duplicidad
X_df <- data.frame(
  name = as.character(1:nrow(dat$X)), 
  female = dat$X[,1],
  race = dat$X[,2],
  grade = dat$X[,3],
  stringsAsFactors = FALSE
)

# Preparación de aristas
E_df <- data.frame(
  from = as.character(dat$E[,1]),
  to = as.character(dat$E[,2]),
  activities = dat$E[,3],
  stringsAsFactors = FALSE
)

# Creación del objeto de red dirigido
g <- graph_from_data_frame(d = E_df, directed = TRUE, vertices = X_df)

3. Propiedades Estructurales

Se calculan las métricas fundamentales para describir el orden, tamaño y la distancia máxima de la red:

# Cálculo de métricas
orden    <- vcount(g)
tamano   <- ecount(g)
diametro <- diameter(g, directed = TRUE, weights = NA)

# Presentación de resultados
cat("Orden (Número de nodos):", orden, "\n")

## Orden (Número de nodos): 255

cat("Tamaño (Número de aristas):", tamano, "\n")

## Tamaño (Número de aristas): 1264

cat("Diámetro (Distancia geodésica máxima):", diametro, "\n")

## Diámetro (Distancia geodésica máxima): 12

4. Visualización General

En primera instancia, se presenta una visualización de la red sin considerar los atributos nodales, lo que permite observar la densidad de las conexiones y la existencia de componentes o nodos aislados.

set.seed(42)
plot(
  g,
  layout = layout_with_fr(g),
  vertex.size = 3,
  vertex.label = NA,
  vertex.color = "steelblue",
  vertex.frame.color = "white",
  edge.arrow.size = 0.1,
  edge.color = adjustcolor("gray", alpha.f = 0.3),
  main = "Visualización Topológica de la Red Social"
)

5. Análisis de Homofilia e Intensidad Relacional

Para un análisis más profundo, se integran las variables nodales y relacionales. Se utiliza el color para diferenciar los grupos raciales y el grosor de las aristas para representar la cantidad de actividades compartidas. Asimismo, se diferencian los vínculos que ocurren dentro del mismo grupo (intra-grupo) de aquellos que conectan grupos distintos (inter-grupo).

# Configuración estética
cols_raza <- c("#3498DB", "#E74C3C", "#F1C40F", "#9B59B6") # Blanco, Negro, Hispano, Otro
V(g)$color <- cols_raza[V(g)$race]
V(g)$size  <- 3 + sqrt(degree(g, mode = "in")) # Tamaño según nominaciones recibidas

# Clasificación de enlaces (Intra-grupo vs Inter-grupo)
race_from <- V(g)$race[as.numeric(head_of(g, E(g)))]
race_to   <- V(g)$race[as.numeric(tail_of(g, E(g)))]

E(g)$color <- ifelse(race_from == race_to, 
                     adjustcolor("gray70", alpha.f = 0.2), 
                     adjustcolor("#FF8C00", alpha.f = 0.6))

# Grosor según peso (activities)
E(g)$width <- 0.5 + (E(g)$activities / 5)

set.seed(123)
plot(
  g,
  layout = layout_with_kk(g), # Layout Kamada-Kawai para mejor dispersión
  vertex.label = NA,
  vertex.frame.color = "white",
  edge.arrow.size = 0.1,
  edge.curved = 0.2,
  main = "Red Ponderada AddHealth: Homofilia y Actividades",
  sub = "Tamaño de nodo: Popularidad | Grosor: Actividades Compartidas"
)

# Leyendas explicativas
legend("topleft", legend = c("Blanco", "Negro", "Hispano", "Otro"), 
       fill = cols_raza, bty = "n", title = "Raza del Estudiante")
legend("bottomleft", legend = c("Enlace Intra-grupo", "Enlace Inter-grupo"), 
       col = c("gray70", "#FF8C00"), lwd = c(1, 3), bty = "n", title = "Naturaleza del Vínculo")

6. Identificación de Nodos con Mayor Actividad

Finalmente, se identifican los 5 estudiantes con mayor tendencia a emitir nominaciones (sociabilidad) y recibir nominaciones (popularidad).

# Cálculo de grados de entrada y salida
in_deg  <- degree(g, mode = "in")
out_deg <- degree(g, mode = "out")

# Ranking Top 5
top_in  <- sort(in_deg, decreasing = TRUE)[1:5]
top_out <- sort(out_deg, decreasing = TRUE)[1:5]

# Tabla de resultados
tabla_top <- data.frame(
  Ranking = 1:5,
  ID_Popular = names(top_in),
  Nominaciones_Recibidas = as.numeric(top_in),
  ID_Sociable = names(top_out),
  Nominaciones_Emitidas = as.numeric(top_out)
)

knitr::kable(tabla_top, caption = "Top 5 de estudiantes con mayor propensión relacional")

Top 5 de estudiantes con mayor propensión relacional
Ranking	ID_Popular	Nominaciones_Recibidas	ID_Sociable	Nominaciones_Emitidas
1	29	19	8	10
2	44	17	12	10
3	181	17	14	10
4	129	15	19	10
5	150	15	27	10

Punto 8: Análisis de Conflictos Internacionales (Años 90)

Este conjunto de datos permite analizar la red de conflictos bélicos o diplomáticos entre países, integrando variables macroeconómicas, políticas y de proximidad institucional o geográfica.

Carga y Preparación de Datos Cargamos el archivo y exploramos su contenido para mapear las variables.

library(igraph)

# Cargar el archivo
load("conflict.RData") # Carga el objeto 'dat'

# 1. Inspección de dimensiones
cat("Estructura de X (Atributos):", dim(dat$X), "\n")

## Estructura de X (Atributos): 130 3

cat("Estructura de Y (Conflictos):", dim(dat$Y), "\n")

## Estructura de Y (Conflictos): 130 130

cat("Estructura de D (Relaciones 3D):", dim(dat$D), "\n")

## Estructura de D (Relaciones 3D): 130 130 4

# 2. Verificación de nombres
# Es vital que los nombres de los países coincidan en todos los arreglos
paises_X <- rownames(dat$X)
paises_Y <- rownames(dat$Y)

cat("¿Los nombres de países en X e Y coinciden?:", all(paises_X == paises_Y), "\n")

## ¿Los nombres de países en X e Y coinciden?: TRUE

# 3. Exploración de las capas de D (Dimensiones relacionales)
# Según la descripción, la 3ra dimensión tiene 4 capas:
# Capa 1: Comercio, Capa 2: Importaciones, Capa 3: OIG, Capa 4: Distancia
dimnames(dat$D)[[3]]

## [1] "polity_int"  "imports"     "shared_igos" "distance"

Clasificación de VariablesTras la inspección técnica del objeto dat, clasificamos las variables según su función en el análisis de redes:

Variables Nodales (Atributos de los países en dat\(X\)):

-Población (population): Cuantitativa continua. Representa la escala demográfica de cada nación. -PIB (gdp): Cuantitativa continua. Refleja la capacidad y poderío económico. -Política (polity): Cuantitativa discreta/ordinal. Un índice que mide el grado de democracia o autocracia del régimen.

Variables Relacionales (Interacciones en dat\(Y y dat\)D):

-Conflictos (Y): Variable relacional principal. Cuantitativa discreta (conteo de conflictos). Define una red dirigida donde \(y_{i,j}\) es el flujo de agresión del país \(i\) al \(j\). -Interacción Política (D[,,1]): Cuantitativa continua. Mide la cercanía o distancia entre sistemas de gobierno. -Importaciones (D[,,2]): Cuantitativa continua. Representa la dependencia económica y flujos comerciales. -Organizaciones Intergubernamentales (D[,,3]): Cuantitativa discreta. Conteo de membresías compartidas en organismos internacionales (OIG).Distancia (D[,,4]): Cuantitativa continua. -Distancia física entre las capitales o centros de poder.

Construcción del Grafo y Métricas Estructurales Construimos la red de conflictos asegurando que los atributos de los países se asignen correctamente a cada vértice.

# 1. Preparar el grafo desde la matriz de conflictos
# mode = "directed" porque el inicio de un conflicto tiene un origen y un destino
g_conflict <- graph_from_adjacency_matrix(dat$Y, 
                                          mode = "directed", 
                                          weighted = "frecuencia", 
                                          diag = FALSE)

# 2. Asignar nombres y atributos nodales
V(g_conflict)$population <- dat$X[,1]
V(g_conflict)$gdp        <- dat$X[,2]
V(g_conflict)$polity     <- dat$X[,3]

# 3. Cálculo de métricas fundamentales
orden_c    <- vcount(g_conflict)
tamano_c   <- ecount(g_conflict)
# Diámetro geodésico (sin considerar pesos para medir 'pasos' de conflicto)
diametro_c <- diameter(g_conflict, directed = TRUE, weights = NA)

cat("Orden (Países analizados):", orden_c, "\n")

## Orden (Países analizados): 130

cat("Tamaño (Relaciones de conflicto activas):", tamano_c, "\n")

## Tamaño (Relaciones de conflicto activas): 203

cat("Diámetro de la red:", diametro_c, "\n")

## Diámetro de la red: 9

Visualización Topológica Presentamos la red sin considerar los atributos nodales para identificar visualmente la densidad del conflicto global y la posible formación de bloques o países aislados.

set.seed(123)
# Usamos el layout Kamada-Kawai por ser eficiente en redes de este tamaño (130 nodos)
coords_c <- layout_with_kk(g_conflict)

plot(
  g_conflict,
  layout = coords_c,
  vertex.size = 4,
  vertex.label = NA,
  vertex.color = "#C0392B", # Rojo oscuro para representar conflicto
  vertex.frame.color = "white",
  edge.arrow.size = 0.2,
  edge.color = adjustcolor("gray20", alpha.f = 0.2),
  main = "Estructura Global de Conflictos (Años 90)"
)

library(igraph)
library(RColorBrewer)

# 1. Preparación del grafo y limpieza
# Eliminamos países sin conflictos para limpiar la visualización
g_clean <- delete.vertices(g_conflict, V(g_conflict)[degree(g_conflict) == 0])

# 2. Decoración de Vértices (Basada en tus ejemplos)
# Color: Usamos una paleta divergente (Set1 o RdYlBu) para el régimen político
# Mapeamos 'polity' (-10 a 10) a una escala de colores
cols <- colorRampPalette(c("red", "yellow", "blue"))(21)
V(g_clean)$color <- cols[V(g_clean)$polity + 11]
V(g_clean)$frame.color <- "white"

# Tamaño: Proporcional a la raíz cuadrada del grado (como en el ejemplo de Karate)
V(g_clean)$size <- sqrt(degree(g_clean)) * 4

# Etiquetas: Solo a los nodos importantes (Top 10% de conflictos) para no saturar
umbral <- quantile(degree(g_clean), 0.9)
V(g_clean)$label <- ifelse(degree(g_clean) >= umbral, V(g_clean)$name, NA)
V(g_clean)$label.cex <- 0.8
V(g_clean)$label.color <- "black"

# 3. Decoración de Aristas
E(g_clean)$color <- adjustcolor("gray70", alpha.f = 0.4)
E(g_clean)$arrow.size <- 0.2

# 4. Visualización con Layout Fruchterman-Reingold (más orgánico)
set.seed(456)
plot(g_clean, 
     layout = layout_with_fr, 
     main = "Red de Conflictos Decorada (Años 90)",
     sub = "Rojo: Autocracia | Azul: Democracia | Tamaño: Grado de Conflicto")

# Añadir una leyenda para entender los colores
legend("bottomleft", legend=c("Autocracia", "Transición", "Democracia"), 
       fill=c("red", "yellow", "blue"), bty="n", cex=0.8)

por la cnatidad d einformaicón probamos un diagrama de arco para visualizar la red

library(ggraph)
library(tidygraph)
library(dplyr)

# 1. Preparación de los datos (estilo tidy)
g_tidy <- as_tbl_graph(g_conflict) %>%
  activate(nodes) %>%
  mutate(
    # Calculamos el grado para poder filtrar o resaltar
    degree = centrality_degree(mode = "all"),
    # Clasificación de régimen político para el color
    Regimen = case_when(
      polity <= -6 ~ "Autocracia",
      polity > -6 & polity < 6 ~ "Transición",
      polity >= 6 ~ "Democracia"
    )
  ) %>%
  # Opcional: Filtramos países sin conexiones para limpiar el eje
  filter(degree > 0) %>%
  # Ordenamos por Polity para que el eje X tenga un sentido analítico
  arrange(polity)

# 2. Visualización
ggraph(g_tidy, layout = "linear") + 
  # Arcos:
  geom_edge_arc(aes(edge_alpha = ..index..), 
                strength = 1, 
                edge_colour = "gray50",
                show.legend = FALSE) + 
  # Nodos: tamaño por PIB y color por tipo de régimen
  geom_node_point(aes(size = gdp, color = Regimen), alpha = 0.8) + 

  # Estética de colores y escalas
  scale_color_manual(values = c("Autocracia" = "#E74C3C", 
                                "Transición" = "#F1C40F", 
                                "Democracia" = "#3498DB")) +
  scale_size_continuous(range = c(2, 10), name = "PIB") +
  # Títulos y limpieza de fondo
  labs(title = "Red de Conflictos Globales (Años 90)",
       subtitle = "Eje X ordenado por Régimen Político (Izquierda: Autocracia | Derecha: Democracia)",
       color = "Régimen") +
  theme_graph() +
  # El margen inferior es crítico para que quepan los nombres verticales
  theme(legend.position = "top",
        plot.margin = margin(20, 20, 80, 20))

Top 5 de Países más Propensos al Conflicto Identificamos a los actores principales según su grado de emisión (países que inician el conflicto) y de recepción (países que son blanco de conflictos).

# Cálculo de grados de entrada y salida
recibidos <- degree(g_conflict, mode = "in")
emitidos  <- degree(g_conflict, mode = "out")

# Identificación de los 5 principales
top_recibe <- sort(recibidos, decreasing = TRUE)[1:5]
top_emite  <- sort(emitidos, decreasing = TRUE)[1:5]

# Generación de tabla comparativa
resumen_conflictos <- data.frame(
  Ranking = 1:5,
  Pais_Receptor = names(top_recibe),
  N_Conflictos_Recibidos = as.numeric(top_recibe),
  Pais_Emisor = names(top_emite),
  N_Conflictos_Emitidos = as.numeric(top_emite)
)

knitr::kable(resumen_conflictos, 
             caption = "Países con mayor involucramiento en conflictos (Emisión vs Recepción)")

Países con mayor involucramiento en conflictos (Emisión vs Recepción)
Ranking	Pais_Receptor	N_Conflictos_Recibidos	Pais_Emisor	N_Conflictos_Emitidos
1	IRQ	15	IRQ	27
2	USA	8	JOR	26
3	HAI	7	USA	11
4	TUR	6	UGA	7
5	JPN	5	CHN	6

Punto 9. Special Types of Graphs.

A continuación se resume y replica la sección 2.4.2 (Special Types of Graphs, p. 24) de Statistical Analysis Of Network Data With R (Kolaczyk y Csárdi, 2020).

Familias grafos

Existen familias de grafos con estructuras características que aparecen frecuentemente en la práctica. A continuación, replicamos las cuatro familias principales del libro (Fig. 2.2).

library(igraph)

# Generación de las 4 familias
g.full <- make_full_graph(7)
g.ring <- make_ring(7)
g.tree <- make_tree(7, children=2, mode="undirected")
g.star <- make_star(7, mode="undirected")

# Configuración de visualización similar a Fig. 2.2
par(mfrow=c(2, 2), mai = c(0.2, 0.2, 0.2, 0.2))
plot(g.full, main="Complete")
plot(g.ring, main="Ring")
plot(g.tree, main="Tree")
plot(g.star, main="Star")

Complete Graph: Cada vértice está unido a todos los demás. Útil para definir cliques.

Regular Graph: Todos los vértices tienen el mismo grado \(d\). El anillo es 2-regular.

Tree: Conectado y sin ciclos. Es fundamental en algoritmos de redes. Posee raíz, ancestros, descendientes y hojas.

k-star: Caso especial de árbol con una raíz y \(k\) hojas.

Directed Acyclic Graphs (DAGs)

Un DAG es un grafo dirigido sin ciclos. A diferencia de un árbol, su grafo subyacente puede contener ciclos, pero las direcciones impiden el retorno al origen.

# Verificación de DAG (usando un grafo de ejemplo 'dg')
dg <- make_ring(3, directed = TRUE)
is_dag(dg)

## [1] FALSE

Bipartite Graphs

Representan redes de “pertenencia” (ej. actores en películas). El conjunto de vértices se divide en dos grupos, y las aristas solo existen entre grupos distintos.

# Creación de red bipartita actor-película
g.bip <- graph_from_literal(actor1:actor2:actor3,
                            movie1:movie2, 
                            actor1:actor2 - movie1,
                            actor2:actor3 - movie2)

V(g.bip)$type <- grepl("^movie", V(g.bip)$name)
print_all(g.bip, v=T)

## IGRAPH 5ca7087 UN-B 5 4 -- 
## + attr: name (v/c), type (v/l)
## + vertex attributes:
## |       name  type
## | [1] actor1 FALSE
## | [2] actor2 FALSE
## | [3] actor3 FALSE
## | [4] movie1  TRUE
## | [5] movie2  TRUE
## + edges from 5ca7087 (vertex names):
## [1] actor1--movie1 actor2--movie1 actor2--movie2 actor3--movie2

Proyecciones Bipartitas

Las proyecciones permiten reducir la red bipartita a una red de un solo tipo de nodo (ej. solo actores conectados por películas comunes).

proj <- bipartite_projection(g.bip)

# Red de actores (proyección 1)
print_all(proj[[1]])

## IGRAPH 5cafdff UNW- 3 2 -- 
## + attr: name (v/c), weight (e/n)
## + edges from 5cafdff (vertex names):
## [1] actor1--actor2 actor2--actor3

# Red de películas (proyección 2)
print_all(proj[[2]])

## IGRAPH 5cafe64 UNW- 2 1 -- 
## + attr: name (v/c), weight (e/n)
## + edge from 5cafe64 (vertex names):
## [1] movie1--movie2

Complementos de Visualización (Réplica Extendida)

Para ilustrar los conceptos de grafos regulares y proyecciones mencionados en el texto, añadimos estas representaciones:

# 1. Grafo 4-regular (Lattice/Rejilla) mencionado en el texto
g.lattice <- make_lattice(dimvector = c(3, 3))

# 2. Visualización de la Proyección de Actores
# (Representa a los actores conectados si compartieron película)
proj <- bipartite_projection(g.bip)
g.actors <- proj[[1]]

par(mfrow=c(1, 2), mar=c(2,2,2,2))
plot(g.lattice, layout=layout_on_grid, main="4-regular Lattice")
plot(g.actors, vertex.color="lightblue", main="Actor Projection")

Punto 10. Los Siete Puentes de Königsberg: El Origen de la Teoría de Grafos

El problema consistía en cruzar los siete puentes de la ciudad de Königsberg sobre el río Pregel sin pasar por ninguno dos veces. Leonhard Euler demostró en 1736 que esto era imposible, transformando el mapa en un grafo de nodos (tierras) y aristas (puentes).

Réplica del Grafo de Königsberg en R Podemos modelar la ciudad como un multigrafo (ya que hay múltiples puentes entre las mismas masas de tierra) y verificar la “Regla de los Grados” de Euler.

library(igraph)

# Creamos el grafo usando una lista de aristas para asegurar el multigrafo
# N=Norte, S=Sur, W=Isla Oeste, E=Isla Este
enlaces <- c("N","W", "N","W",  # 2 puentes N-W
             "S","W", "S","W",  # 2 puentes S-W
             "N","E",           # 1 puente N-E
             "S","E",           # 1 puente S-E
             "W","E")           # 1 puente W-E

konigsberg <- graph(edges = enlaces, directed = FALSE)

## Warning: `graph()` was deprecated in igraph 2.1.0.
## ℹ Please use `make_graph()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# 1. Verificación de Grados (Deben ser: N=3, S=3, W=5, E=3)
grados_reales <- degree(konigsberg)
print(grados_reales)

## N W S E 
## 3 5 3 3

# 2. Condición de Euler:
# Un camino euleriano existe si el número de nodos de grado impar es 0 o 2.
n_impares <- sum(grados_reales %% 2 != 0)

cat("Número de nodos con grado impar:", n_impares, "\n")

## Número de nodos con grado impar: 4

cat("¿Es posible el recorrido sin repetir puentes?:", n_impares <= 2, "\n")

## ¿Es posible el recorrido sin repetir puentes?: FALSE

# Visualización para confirmar
plot(konigsberg, edge.curved=0.3, vertex.color="orange", main="Multigrafo de Königsberg")

Conclusión técnica: Como los 4 nodos tienen grados impares (\(N=3, S=3, E=3, W=5\)), no existe un camino euleriano.

Punto 11. La Paradoja de la Amistad

Planteada por Scott Feld, esta paradoja dicta que, en promedio, tus amigos tienen más amigos que tú. Esto no es una percepción subjetiva, sino una propiedad matemática de las redes basada en el sesgo de los nodos de alto grado (hubs).

Demostración Matemática con Código Vamos a generar una red aleatoria y comparar el grado promedio de la red frente al grado promedio de los vecinos.

 # 1. Generar una red de "Mundo Pequeño" (Watts-Strogatz)
set.seed(123)
net <- sample_smallworld(dim=1, size=50, nei=2, p=0.1)

# 2. Calcular el grado promedio de los usuarios (m)
promedio_usuario <- mean(degree(net))

# 3. Calcular el grado promedio de los amigos de cada usuario
# Para cada nodo, vemos el grado de sus vecinos y promediamos
grados_vecinos <- sapply(V(net), function(x) {
  vecinos <- neighbors(net, x)
  mean(degree(net, vecinos))
})
promedio_amigos <- mean(grados_vecinos)

# Comparación
resultados <- data.frame(
  Concepto = c("Promedio de mis amigos", "Promedio de los amigos de mis amigos"),
  Valor = c(promedio_usuario, promedio_amigos)
)
print(resultados)

##                               Concepto    Valor
## 1               Promedio de mis amigos 4.000000
## 2 Promedio de los amigos de mis amigos 4.188667

¿Por qué ocurre? Sesgo de Muestreo: Los individuos con muchos amigos (hubs) pertenecen a los círculos sociales de muchas personas, por lo que aparecen con más frecuencia en los cálculos de promedios de vecindad.

Aplicación en Salud Pública: En lugar de vacunar a personas al azar, es más eficiente pedir a personas al azar que nombren a un amigo y vacunar a ese amigo, ya que, por la paradoja, ese amigo estará más “conectado” y será un mejor cortafuegos para el virus.

Primer Taller de Redes

Helen Granados Rodríguez - Universidad Nacional de Colombia

2026-02-23