Taller 1 Análisis de Redes

#setwd("~/Desktop/Universidad/Maestria Estadistica/Análisis Estadístico de Redes")
suppressMessages(suppressWarnings(library(igraph)))
suppressMessages(suppressWarnings(library(ggraph)))
suppressMessages(suppressWarnings(library(tidygraph)))

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\} \}\).
1. Graficar \(G\)
2. Calcular el orden, el tamaño, y el diámetro del grafo.
3. Calcular el grado de cada vértice.
4. Graficar el subgrafo generado por los nodos 1, 2, 3, y 4.

Solución Punto 1:

# Esta es una red binaria no dirigida
g1 <- graph_from_literal(1-2, 1-3, 2-3, 2-4, 2-5, 3-5, 4-5)

# Visualización sencilla
par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
set.seed(123)
plot(g1, 
     vertex.color = "lightblue",
     main = "Red binaria no dirigida con 5 nodos")

El orden del grafo es el número de vértices \(\mid V \mid\), el tamaño es el número de aristas \(\mid E \mid\) y el diámetro es el valor máximo de las distancias geodésicas entre los pares de los vértices.

# Tamaño del grafo
ecount(g1)

## [1] 7

# Orden del grafo
vcount(g1)

## [1] 5

# Diámetro
diameter(g1)

## [1] 2

Se tienen 7 aristas distribuidas en 5 nodos. Que el diámetro sea de 2 muestra que desde todos los nodos se puede a cualquier otro solo recorriendo dos aristas.

# Grado de cada vértice
(grado1 <- degree(g1))

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

El nodo 2 presenta el mayor grado, esto muestra que es el que tienen mayor número de aristas conectadas.

# Subgrafo inducido
g1_sub <- induced_subgraph(g1, vids = c(1, 2, 3, 4))

# Visualización
par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
set.seed(123)
plot(g1_sub, 
     vertex.color = "lightblue",
     main = "Subgrafo generado por los nodos {1, 2, 3 y 4}")

Considere el digrafo \(𝐺=(𝑉,𝐸)\), con \(𝑉=\{1,2,3,4,5\}\) y \(𝐸=\{(1,3);(2,3);(2,4);(2,5);(3,1);(3,5);(4,5);(5,4)\}\).
1. Graficar 𝐺.
2. Calcular el orden, el tamaño, y el diámetro del grafo.
3. Calcular el grado de cada vértice del grafo.
4. Graficar el subgrafo generado por los nodos 1, 2, 3, y 4.

Solución Punto 2:

# Esta es una red binaria dirigida
g2 <- graph_from_literal(1++3, 2-+3, 2-+4, 2-+5, 3-+5, 4++5)
V(g2)$name <- 1:5

# Visualización
par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
set.seed(123)
plot(g2, 
     vertex.color = "lightblue",
     main = "Red binaria dirigida con 5 nodos")

Nota: Se re-nombran los nodos en orden consecutivo de 1 a 5, para evitar confusiones más adelante.

# Tamaño del grafo
ecount(g2)

## [1] 8

# Orden del grafo
vcount(g2)

## [1] 5

# Diametro del grafo
diameter(g2, directed = TRUE)

## [1] 3

Se cuenta con 8 aristas repartidas en 5 vértices. El diámetro nos dice que las distancias geodésicas en el grafo diridido toman valores máximos de 3 (cuando estas son finitas).

# Grado de entrada
degree(g2, mode = "in")

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

# Grado de salida
degree(g2, mode = "out")

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

El vértice 5 es el que tiene mayor número de aristas que salen de sí, mientras que este solo recibe una conexión. El nodo 3, por otro lado, no tiene aristas dirigidas hacia él, pero si apunta hacia otros nodos con tres aristas.

# Subgrafo inducido
g2_sub <- induced_subgraph(g2, vids = c(1, 2, 3, 4))

# Visualización
par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
set.seed(123)
plot(g2_sub, 
     vertex.color = "lightblue",
     main = "Subgrafo generado por los nodos {1, 2, 3 y 4}")

Una triada es un subgrafo generado por una tripla de vértices.
1. Graficar todos los posibles estados relacionales de una triada.
2. Identificar los estados isomorfos.

Solución Punto 3:

# Definir los grafos deseados
g3_1 <- make_empty_graph(n=3, directed = FALSE)
g3_2 <- make_graph(edges = c(1,2), n = 3, directed = FALSE)
g3_3 <- make_graph(edges = c(1,3), n = 3, directed = FALSE)
g3_4 <- make_graph(edges = c(2,3), n = 3, directed = FALSE)
g3_5 <- make_graph(edges = c(1,2, 1,3), n = 3, directed = FALSE)
g3_6 <- make_graph(edges = c(1,2, 2,3), n = 3, directed = FALSE)
g3_7 <- make_graph(edges = c(1,3, 2,3), n = 3, directed = FALSE)
g3_8 <- make_graph(edges = c(1,2, 1,3, 2,3), n = 3, directed = FALSE)

# Lista de grafos
grafos <- list(g3_1, g3_2, g3_3, g3_4, g3_5, g3_6, g3_7, g3_8)

# Layout fijo
layout_fijo <- matrix(c(0, 1.5,
                        -1, 0,
                        1, 0), ncol = 2, byrow = TRUE)

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

for(i in 1:length(grafos)){
  plot(grafos[[i]],
       layout = layout_fijo,
       vertex.size = 50,
       vertex.color = "lightblue",
       vertex.label.cex = 1.2,
       edge.width = 3,
       main = paste("Grafo", i))
}

Dos grafos son isomorfos si existe una permutación de los vértices que convierte uno en el otro. Note que en este caso tenemos 4 estados isomorfos:

Grafo sin aristas
Grafo con 1 arista
Grafo con 2 aristas
Grafo con 3 aristas

Las agrupaciones se muestran a continuación:

Escribir una función en R o Python que simule redes tanto dirigidas como no dirigidas a partir de enlaces aleatorios independientes e idénticamente distribuidos con una probabilidad de éxito dada. Esta rutina debe tener como argumentos el orden de la red, la probabilidad de interacción (por defecto 0.5), el tipo de red (por defecto no dirigida) y la semilla (por defecto 42), y además, tener como retorno la matriz de adyacencia y una visualización. Probar esta rutina generando cuatro casos diferentes.

Solución Punto 4:

sim_red_aleatoria <- function(n, prob = 0.5, tipo = "undirected", semilla = 42) {
  
  set.seed(semilla)
  
  if (!tipo %in% c("undirected", "directed")) {
    stop("El argumento 'tipo' debe ser 'undirected' o 'directed'")
  }
  
  # Matriz de adyacencia
  A <- matrix(0, n, n)
  
  if (tipo == "undirected") {
    # Recorremos la matriz triangular superior (i<j)
    for (i in 1:(n-1)) {
      for (j in (i+1):n) {
        # Crear las aristas con probabilidad prob
        A[i,j] <- rbinom(1, 1, prob)
        # Se hace la matriz simétrica porque la red es no dirigida
        A[j,i] <- A[i,j]
      }
    }
  } else if (tipo == "directed"){
    # Como la red es no dirigida, se recorre toda la matriz sin simetrias
    for (i in 1:n) {
      for (j in 1:n) {
        if (i != j) {
          A[i,j] <- rbinom(1, 1, prob)
        }
      }
    }
  }
  
  diag(A) <- 0
  
  # Visualización
  grafo <- graph_from_adjacency_matrix(A)
  plot(grafo, vertex.color = "lightblue")
  
  return(A)
}

La función creada se prueba mediante los siguientes ejemplos:

par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
# Red no dirigida
sim_red_aleatoria(n=9, prob = 0.3, tipo = "undirected", semilla = 42)

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,]    0    1    1    0    1    0    0    1    0
##  [2,]    1    0    0    1    0    1    1    0    0
##  [3,]    1    0    0    1    1    0    0    0    1
##  [4,]    0    1    1    0    0    1    1    0    0
##  [5,]    1    0    1    0    0    0    1    0    1
##  [6,]    0    1    0    1    0    0    1    1    0
##  [7,]    0    1    0    1    1    1    0    0    0
##  [8,]    1    0    0    0    0    1    0    0    1
##  [9,]    0    0    1    0    1    0    0    1    0

par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
# Red no dirigida
sim_red_aleatoria(n=5, prob = 0.2, tipo = "undirected", semilla = 42)

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

# Red dirigida
sim_red_aleatoria(n=5, prob = 0.2, tipo = "directed", semilla = 42)

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

# Red dirigida
sim_red_aleatoria(n=5, prob = 1, tipo = "directed", semilla = 1)

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

Escribir una función en R o Python que reconstruya la matriz de adyacencia a partir de la matriz de aristas y una lista de vértices asilados (si los hay). Probar esta rutina con una red no dirigida de 25 nodos simulada a partir de enlaces aleatorios independientes e idénticamente distribuidos con probabilidad de éxito 0.1. Graficar la red de prueba.

Solución Punto 5:

adj_from_edge <- function(edge_matrix, tipo = "undirected", vertices_aislados = NULL) {
  
  if (!tipo %in% c("undirected", "directed")) {
    stop("El tipo debe ser 'undirected' o 'directed'")
  }
  
  # Determinar número total de nodos
  n <- max(c(edge_matrix, vertices_aislados))
  
  # Crear matriz vacía
  A <- matrix(0, n, n)
  
  # Asignar aristas
  A[edge_matrix] <- 1
    
  # Si el no dirigida, también toca llenar la triangular inferior
  if (tipo == "undirected") {
    A[cbind(edge_matrix[,2], edge_matrix[,1])] <- 1
  }

  diag(A) <- 0
  
  return(A)
}

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

# Simulación de la red pedida
set.seed(123)
g5 <- sample_gnp(n = 25, p = 0.1, directed = FALSE)

A_prueba <- adj_from_edge(as_edgelist(g5), 
                          tipo = "undirected",
                          vertices_aislados = which(degree(g5)==0)) 

A_verdadera <- as_adjacency_matrix(g5, sparse = F)
all(A_prueba==A_verdadera)

## [1] TRUE

Se verifica que la matriz de adyacencia reconstruida es igual a la obtenida por la función as_adjacency_matrix del paquete igraph.

plot(g5, 
     vertex.color = "lightblue",
     main = "Red simulada no dirigida de 25 nodos. \n Enlaces con probabilidad de 0.1 de ocurrir")

Escribir una función en R o Python que reconstruya la matriz de aristas y una lista de vértices asilados (si los hay) a partir de la matriz de adyacencia. Probar esta rutina con una red no dirigida de 25 nodos simulada a partir de enlaces aleatorios independientes e idénticamente distribuidos con probabilidad de éxito 0.1. Graficar la red de prueba.

Solución Punto 6:

edge_from_adj <- function(adj_matrix, tipo = "undirected"){
  
  if (!tipo %in% c("undirected", "directed")) {
    stop("El tipo debe ser 'undirected' o 'directed'")
  }
  
  # Vértices aislados
  V_aislados <- which(rowSums(adj_matrix)==0)
  
  # Matriz de aristas
  if (tipo == "undirected") {
    # El arr.ind permite guardar los indices del arreglo (lo que necesitamos)
    edge_list <- which(adj_matrix == 1, arr.ind = TRUE)
    edge_list <- edge_list[edge_list[,1] < edge_list[,2], , drop = FALSE]
  } 
  else if (tipo == "directed"){
    edge_list <- which(adj_matrix == 1, arr.ind = TRUE)
  }
  return(list(vertices_ailsados = V_aislados,
         edge_list = edge_list))
}

Se simula la red de prueba y se confirma que la matriza de aristas reconstruida es igual a la obtenida por la función as_edgelist.

par(mfrow = c(1,1), mar = c(1, 1, 2, 1))
set.seed(9)

g6 <- sample_gnp(n = 25, p = 0.1, directed = FALSE)

A <- as_adjacency_matrix(g6, sparse = FALSE)
B <- edge_from_adj(A, tipo = "undirected")

B$vertices_ailsados

## [1] 16

B$edge_list

##       row col
##  [1,]   4   5
##  [2,]   6   7
##  [3,]   1   8
##  [4,]   3   9
##  [5,]   7   9
##  [6,]   2  10
##  [7,]   4  11
##  [8,]   6  11
##  [9,]   7  11
## [10,]   2  12
## [11,]   7  12
## [12,]  12  13
## [13,]   8  14
## [14,]  12  15
## [15,]   3  17
## [16,]  14  17
## [17,]   6  19
## [18,]   8  19
## [19,]   9  19
## [20,]   3  20
## [21,]  17  20
## [22,]  18  20
## [23,]  17  21
## [24,]  18  21
## [25,]  11  22
## [26,]  12  22
## [27,]  13  22
## [28,]  14  22
## [29,]  20  23
## [30,]   5  24
## [31,]   2  25
## [32,]   8  25
## [33,]  17  25
## [34,]  19  25

all(as_edgelist(g6)==B$edge_list)

## [1] TRUE

plot(g6, 
     vertex.color = "lightblue",
     main = "Red simulada no dirigida de 25 nodos. \n Enlaces con probabilidad de 0.1 de ocurrir")

Considere el conjunto de datos dado en addhealth.RData recopilado por The National Longitudinal Study of Adolescent Health, asociado con un estudio escolar sobre salud y comportamientos sociales de adolescentes de varias escuelas en los Estados Unidos (los datos se encuentran disponibles en la página web del curso). Los participantes nominaron hasta 5 niños y 5 niñas como amigos y reportaron el número de actividades extracurriculares en las que participaron juntos. El archivo addhealth.RData contiene una lista con dos arreglos, X y E. X tiene tres campos: female (0 = No, 1 = Sí), race (1 = Blanco, 2 = Negro, 3 = Hispano, 4 = Otro). E también tiene tres campos: V1 (vértice de “salida”) V2 (vértice de “llegada”) activities (número de actividades extracurriculares).
1. Identificar y clasificar las variables nodales.
2. Identificar y clasificar las variables relacionales.
3. Calcular el orden, el tamaño, y el diámetro del grafo.
4. Graficar la red sin tener en cuenta las variables nodales.
5. Identificar el top 5 de los nodos más propensos a emitir/recibir relaciones.

Solución Punto 7:

load("addhealth.RData")

Variables nodales:
- Género (si es mujer o no): Cualitativa nominal
- Raza: Cualitativa nominal
- Grado: Cualitativa ordinal
Variables relacionales:
- Amigos y actividades: La relación está dada por si una persona considera a otra su amig@. Esta es dirigida, simple y ponderada por las actividades que los adolescentes comparten juntos (los pesos son una variable cuantitativa discreta).

Se muestra a continuación el encabezado de la matriz con los atributos de los nodos y la dimensión de esta.

# Atributos 
head(dat$X)

##      female race grade
## [1,]      1    1     9
## [2,]      0    1     9
## [3,]      1    2    11
## [4,]      1    1     9
## [5,]      1    2     7
## [6,]      1    2    11

# Dimensión (número de vértices)
dim(dat$X)

## [1] 255   3

Se leen los datos correspondientes:

# Leer el grafo y asignar los pesos
g7 <- graph_from_data_frame(as.data.frame(dat$E), directed = TRUE, vertices = cbind(1:nrow(dat$X), dat$X))
E(g7)$weight <- dat$E[,3]

is_directed(g7)

## [1] TRUE

is_weighted(g7)

## [1] TRUE

is_simple(g7)

## [1] TRUE

Como se mencionó previamente, la red es dirigida, ponderada y simple.

vcount(g7)

## [1] 255

ecount(g7)

## [1] 1264

diameter(g7)

## [1] 32

El orden del grafo \(|V|\) nos dice que hay 255 vértices, es decir, 255 adolescentes. Adicionalmente, se cuenta con 1264 aristas entre los nodos. Por otro lado, el diámetro del grafo es igual a 32, dejando ver que la red es mediana estructuralmente hablando.

A continuación se grafica la red sin tener en cuenta las variables nodales, mediante la función ggraph.

# Objeto para manejar con ggraph
g7_tbl <- as_tbl_graph(g7)

set.seed(123)

set_graph_style(plot_margin = margin(1,1,1,1))

# Layout y coordenadas espaciales para los nodos aislados
layout7 <- create_layout(g7_tbl, layout = 'fr')
layout7$y[degree(g7, mode = "all") == 0] <- -10

ggraph(layout7) +
  geom_edge_link(aes(width = weight),
                 alpha = 0.1,
                 colour = "grey40",
                 arrow = arrow(length = unit(2, "mm")),
                 end_cap = circle(1, "mm")) +
  geom_node_point(size = 2.5,
                  colour = "magenta3") +
  scale_edge_width(range = c(0.5, 2.5)) +
  theme_void() +
  theme(legend.position = "none") +
  ggtitle("Red dirigida ponderada para las relaciones de los adolescentes - Add Health")

Para identificar el top 5 de los nodos más propensos a emitir/recibir relaciones se calculan el grado de entrada y de salida de los nodos, y se ordenan de mayor a menor.

# Grados de salida y de entrada
grados_in7 <- degree(g7, mode = "in")
grados_out7 <- degree(g7, mode = "out")

# Ordenarlos
ord_grados_in7 <- sort(grados_in7, decreasing = TRUE)
ord_grados_out7 <- sort(grados_out7, decreasing = TRUE)

head(ord_grados_in7, 5)

##  29  44 181 129 150 
##  19  17  17  15  15

head(ord_grados_out7, 5)

##  8 12 14 19 27 
## 10 10 10 10 10

El individuo al que más personas consideran como amig@ es el 29, con 19 relaciones entrantes; seguido de los individuos 44, 181, 129 y 150 con 17 relaciones recibidas. A su vez, cinco de los individuos que más amigos dicen tener (10 amigos) son los adolescentes 8, 12, 14, 19 y 27, ya que son los que más relaciones emiten.

# Objeto para manejar con ggraph
V(g7)$color <- scales::alpha("magenta3", 0.4)
V(g7)[c(29, 44, 181, 129, 150)]$color <- "darkblue"

g7_tbl <- as_tbl_graph(g7)

set.seed(123)
set_graph_style(plot_margin = margin(1,1,1,1))

# Layout y coordenadas espaciales para los nodos aislados
layout7 <- create_layout(g7_tbl, layout = 'fr')
layout7$y[degree(g7, mode = "all") == 0] <- -10

ggraph(layout7) +
  geom_edge_link(aes(width = weight),
                 alpha = 0.1,
                 colour = "grey40",
                 arrow = arrow(length = unit(2, "mm")),
                 end_cap = circle(1, "mm")) +
  geom_node_point(aes(colour = color),
                  size = 2.5) +
  scale_edge_width(range = c(0.5, 2.5)) +
  scale_colour_identity() +
  theme_void() +
  theme(legend.position = "none") +
  labs(
    title = "Red dirigida ponderada para las relaciones de los adolescentes - Add Health",
    subtitle = "Los nodos con mayor grado de entrada se denotan con color azul oscuro"
  )

Considere el conjunto de datos dado en conflict.RData recopilado por Mike Ward y Xun Cao del departamento de Ciencias Políticas de la Universidad de Washington, asociado con datos de conflictos entre países en los años 90 (los datos se encuentran disponibles en la página web del curso). El archivo conflict.RData contiene una lista con tres arreglos, X, Y, y D. X tiene tres campos: population (población en millones), gdp (PIB en millones de dolares) polity (puntuación política, un índice de democracia). Y hace referencia a una matriz \(𝐘=[y_{i,j}]\) en la que \(y_{i,j}\) representa el número de conflictos iniciados por el país \(i\) hacia el país \(j\). Finalmente, D es un arreglo de tres dimensiones dimensiones cuya tercera dimensión contiene indices entre cada par de países asociados con: comercio (dimensión 1), importaciones (dimensión 2), organizaciones intergubernamentales (dimensión 3), y distancia geográfica (dimensión 4).
1. Identificar y clasificar las variables nodales.
2. Identificar y clasificar las variables relacionales.
3. Calcular el orden, el tamaño, y el diámetro del grafo.
4. Graficar la red sin tener en cuenta las variables nodales.
5. Identificar el top 5 de los nodos más propensos a emitir/recibir relaciones de acuerdo con los conflictos.

Solución Punto 8:

load("conflict.RData")

Variables nodales:
- population (Población): Cuantitativa continua y positiva
- gdp (PIB en millones de dólares): Cuantitativa continua
- polity (Puntuación política): Cuantitativa continua, entre rangos de -10 a 10
Variables relacionales: Esta es una red multicapa con las siguientes relaciones
- Conflictos: La relación principal está dada por los países que inician conflictos con otros. Esta es dirigida y ponderada por el número de conflictos presentados.
- Política interna: Además de la variable mencionada, s cuenta con 4 variables de política pública: Comercio, importaciones, organizaciones intergubernamentales y distancia geográfica. Todas son ponderadas y no dirigidas, a excepción de la variable importaciones que es dirigida.

# Hay 130 paises 
# X: variables nodales
# Y: matriz de adyacencia dirigida ponderada (conflictos entre paises)
# D: relaciones adicional entre países
g8_conflict <- graph_from_adjacency_matrix(dat$Y, mode = "directed", weighted = TRUE, diag = FALSE)
is_weighted(g8_conflict)

## [1] TRUE

is_directed(g8_conflict)

## [1] TRUE

Esta red es dirigida y ponderada, como se mencionó previamente.

#g8_trade <- graph_from_adjacency_matrix(dat$D[,,1], mode = "undirected", weighted = TRUE, diag = FALSE)
#g8_import <- graph_from_adjacency_matrix(dat$D[,,2], mode = "directed", weighted = TRUE, diag = FALSE)
#g8_oig <- graph_from_adjacency_matrix(dat$D[,,3], mode = "undirected", weighted = TRUE, diag = FALSE)
#g8_distance <- graph_from_adjacency_matrix(dat$D[,,4], mode = "undirected", weighted = TRUE, diag = FALSE)

vcount(g8_conflict)

## [1] 130

ecount(g8_conflict)

## [1] 203

diameter(g8_conflict)

## [1] 14

La red de conflictos cuenta con 203 relaciones, repartidas en 130 países. La máxima distancia geodésica es de 14, por lo que esta es la longitud del máximo camino más corto que conecta a dos vértices.

A continuación se grafica el grafo con la funció ggraph

# Objeto para manejar con ggraph
g8_tbl <- as_tbl_graph(g8_conflict)

set.seed(123)
set_graph_style(plot_margin = margin(1,1,1,1))

# Layout
layout8 <- create_layout(g8_tbl, layout = 'fr')

ggraph(layout8) +
  geom_edge_link(aes(width = weight),
                 alpha = 0.3,
                 colour = "gray62",
                 arrow = arrow(length = unit(2, "mm")),
                 end_cap = circle(1, "mm")) +
  geom_node_point(size = 3,
                  colour = "royalblue") +
  scale_edge_width(range = c(0.5, 3)) +
  theme_void() +
  theme(legend.position = "none") +
  ggtitle("Red dirigida ponderada para los conflictos entre países")

# Grados de salida y de entrada
grados_in8 <- degree(g8_conflict, mode = "in")
grados_out8 <- degree(g8_conflict, mode = "out")

# Ordenarlos
ord_grados_in8 <- sort(grados_in8, decreasing = TRUE)
ord_grados_out8 <- sort(grados_out8, decreasing = TRUE)

head(ord_grados_in8, 5)

## IRQ USA HAI TUR JPN 
##  15   8   7   6   5

head(ord_grados_out8, 5)

## IRQ JOR USA UGA CHN 
##  27  26  11   7   6

Como se hizo antes, para identificar a los individuos más propensos a emitir/recibir relaciones se calculan los grados de salida y entrada de los vértices. Los países que han sido foco de más conflictos son Iraq, Estados Unidos, Haiti, Turquia y Japon, con 15, 8, 7, 6 y 5 conflictos recibidos. Mientras tanto, los países que más conflictos han iniciado son Iraq, Jordania, Estados Unidos, Uganda y China, con 27, 26, 11, 7 y 6 conflictos.

V(g8_conflict)$color <- scales::alpha("royalblue", 0.6)
V(g8_conflict)[c("IRQ", "JOR")]$color <- "red"
V(g8_conflict)[c("USA", "HAI")]$color <- "green"

# Objeto para manejar con ggraph
g8_tbl <- as_tbl_graph(g8_conflict)

set.seed(123)
set_graph_style(plot_margin = margin(1,1,1,1))

# Layout
layout8 <- create_layout(g8_tbl, layout = 'fr')

layout8[58,1] <- -5.2
layout8[51,2] <- 2.5

ggraph(layout8) +
  geom_edge_link(aes(width = weight),
                 alpha = 0.4,
                 colour = "gray62",
                 arrow = arrow(length = unit(2, "mm")),
                 end_cap = circle(1, "mm")) +
  geom_node_point(
    aes(colour = color),
    size = 3) +
  geom_node_label(
    aes(label = ifelse(name %in% c("IRQ","JOR","USA", "HAI"), name, NA),
        fill = color),
    linewidth = 0,   # sin borde negro
    size = 3
  ) +
  scale_colour_identity() +
   scale_fill_identity() +
  scale_edge_width(range = c(0.5, 3)) +
  theme_void() +
  theme(legend.position = "none") +
  labs(
    title = "Red dirigida ponderada para los conflictos entre países",
    subtitle = "En rojo los países más conflictivos y en verde los que más conflictos reciben"
  )

## Warning: Removed 126 rows containing missing values or values outside the scale range
## (`geom_label()`).

## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## not found in Windows font database

## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database

Sintetizar y replicar 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).

Solución Punto 9:

Esta sección nos habla sobre las familias de grafos que existen: Completos, Tipo anillo, Tipo árbol y Tipo estrella.

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")

par(mfrow=c(2, 2), mai = c(0.2, 0.2, 0.2, 0.2))
set.seed(1908)
plot(g.full)
plot(g.ring)
plot(g.tree , layout = layout_as_tree(g.tree, circular = T))
plot(g.star, layout = layout_as_star)

Grafo completo: Es aquel en el que todos los vértices están unidos por aristas. Un ciclo, por ejemplo, es un subgrafo completo.
Grafo regular: Grafo en el que todos los vértices tienen el mismo grado \(d\). Un ejemplo de grafo regular es el anillo.
Árbol: Un grafo conectado sin ciclos es llamado árbol. La unión disjunta de estos grafos se denomina bosque. Un digrafo cuyo grafo subyacente es un árbol se denota como árbol dirigido. Estos árboles comúnmente tienen un vértice especial llamado raíz, caracterizado por ser el único vértice que tiene un camino directo a los demás. Estos grafos se llaman árbol enraizado. Los vértices que preceden a otros se llaman ancestros, y los que siguen a otros se llaman descendientes. Los ancestros inmediatos son padres, y los descendientes inmediatos son hijos. Un vértice sin hijos se llama hoja. La distancia de la raíz a la hoja más lejana es la profundidad del árbol.
Estrella: Una k-estrella es un tipo especial de árbol que consiste en una raíz con \(k\) hojas.

Una generalización del concepto de árbol es el grafo dirigido acíclico (DAG). Como su nombre lo indica, es un grafo dirigido que no tiene ciclos. A diferencia de los árboles dirigidos, su grafo subyacente no es un árbol ya que al eliminar la dirección, presenta ciclos.

Finalmente, un grafo bipartito es un grafo \(G=(V,E)\) en el que el conjunto de vértices se puede dividir en dos conjuntos disjuntos \(V_1\) y \(V_2\), y las aristas tienen un extremo en \(V_1\) y el otro en \(V_2\). Un ejemplo de esta es la red que estudia las relaciones entre actores y películas (miembros y organizaciones).

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 f841511 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 f841511 (vertex names):
## [1] actor1--movie1 actor2--movie1 actor2--movie2 actor3--movie2

plot(g.bip, layout = -layout_as_bipartite(g.bip)[,2:1],
     vertex.size = 70, 
     vertex.shape=ifelse(V(g.bip)$type, "rectangle", "circle"),
     vertex.label.cex = 1,
     vertex.color = ifelse(V(g.bip)$type, "red", "cyan"))

Es común acompañar un grafo bipartito con al menos uno de sus grafos inducidos. Por ejemplo, un grafo \(G_1=(V_1, E_1)\) definido en los vértices \(V_1\) y que asigna una arista al par de vértices que tienen aristas en \(E\) a un vértice común en \(V_2\). Es decir, se conforma una red de miembros en la que dos miembros se conectan con una arista si hacen parte de la misma organización. Estos grafos son llamados proyecciones.

La proyección para la red g.bip se presenta a continuación:

proj <- bipartite_projection(g.bip)
print_all(proj[[1]])

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

print_all(proj[[2]])

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

Los actores 1 y 2 están conectados porque participaron en la película 1, mientras que los actores 2 y 3 comparten la película 2. Así mismo, como las películas tienen actores en común, están conectadas por una rista.

Sintetizar y explicar el problema de los puentes de Königsberg (https://www.youtube.com/watch?v=nZwSo4vfw6c&ab_channel=TED-Ed).

Solución Punto 10:

La ciudad de Königsberg estaba separada en cuatro terrenos por el río Pregel, los cuales se comunicaban entre sí por siete puentes. Carl Ehler, alcalde de la ciudad se planteó la pregunta ¿Que ruta le permitiría a alguien cruzar los siete puentes atravesando cada uno una sola vez? La respuesta: es imposible.

El matemático Leonhard Euler, a quien Carl pidió ayuda, explicó el por qué inventando la “Geometría de la Posición” hoy conocida como Teoría de Grafos. Él decidió representar los cuatro terrenos como puntos (nodos) y los puentes como aristas entre ellos, como lo muestra la siguiente imagen.

Acto seguido, Euler decide calcular el grado de cada nodo, lo que corresponde con la cantidad de puentes que tocan cada terreno. ¿Por qué el grado importa? Porque el desafio indica que una persona debe entrar a un nodo (terreno) por un puente y salir por otro distinto, implicando que el número de puentes que toquen dicho terreno debe ser par, con la excepción del inicio y el final del recorrido.

Se observa que en este problema, todos los nodos tienen grado impar, por lo que algún puente deberá cruzarse dos veces.

Con la creación de este nuevo campo matemático, Euler dijo que un camino eureliano que visita cada arco solo una vez solo es posible en dos escenarios:

Dos nodos tienen grado impar (inicio y final) con loos demás con grado impar
Todos los nodos tienen grado par, por lo que el camino inicia y finaliza en el mismo nodo.

Moraleja: Cuando no puedas resolver un problema, crea un nuevo campo matemático :D.

Sintetizar y explicar la paradoja de la amistad (https://www.youtube.com/watch?v=E5f68Xbtd6s&ab_channel=Derivando).

Solución Punto 11:

La paradoja de la amistad propuesta por el sociólogo Scott Feld plantea que “Tus amigos tienen siempre más amigos que tu”. Esto traducido al lenguaje de los grafos enuncia que, en general, el promedio de los grados de los vecinos de un nodo va a ser mayor que el grado de ese nodo. Es decir que, en promedio los vecinos de un nodo tienen más conexiones que ese nodo.

Esta afirmación puede sonar ilógica, pero matemáticamente se sustenta.

Sean

\(n=\) Número de nodos

\(e=\) cantidad total de conexiones (aristas)

\(m=\) media de grados de los nodos

Note que \[m=\frac{\text{número de conexiones}}{\text{número de nodos}}=\frac{2*e}{n}\] porque las conexiones se cuentan dos veces (una conexión entre a y b se cuenta en las conexiones de a y las conexiones de b).

Luego de calcular la media de grados de los nodos queremos calcular la media de los grados de los nodos vecinos, para hacer el contraste. Luego de hacer el desarrollo matemático correspondiente llegamos a que esta es igual a \[\frac{\sum_{j\in\text{vecinos}(v_i)}\text{grados}(v_i)}{\sum \text{grados}(v_i)}=\frac{\sum [\text{grados}(v_i)]^2}{2e}=m+\frac{s^2}{m}\] donde \(s^2\) es la varianza de la distribución de los grados la cual se escribe como \[s^2=\frac{\sum_i{(\text{grados de }V_i)^2}}{n}-m^2\] gracias a la formula que conocemos de la varianza.

Ahora, notese que \(\frac{s^2}{m}>0\) siempre, a no ser que todos los nodos tengan el mismo grado. Por esta razón \(m+\frac{s^2}{m}>m\). Mostrando así que la afirmación de la paradoja se cumple, generalmente.

Una excepción a este planteamiento son los Nodos centrales, los cuales tienen un grado mayor que la media de sus vecinos. Su identificación es importante para el análisis de la red debido a que son críticos, por ejemplo, en el esparcimiento de enfermedades.

Taller 1 Análisis de Redes

Camila Alejandra Pinzón Caro

2026-02-12