Taller 1. Análisis de redes sociales

Estadística. Universidad Nacional de Colombia

library(igraph)
library(dplyr)
library(kableExtra)

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

a. Graficar \(G\).

Usando la librería igraph podemos generar directamente el grafo a partir de la lista de aristas con la función graph_from_edgelist. Esta función requiere como entrada una matriz \(k \times 2\) siendo \(k\) el tamaño del grafo, teniendo en cuenta que si el nodo no aparece dentro de la lista de aristas no se añadirá al grafo, en cambio se deberán agregar estos nodos desconectados a partir de la función add_vertices:

edges = matrix(ncol = 2, byrow = T, data = c(1, 2,
                                             1, 3,
                                             2, 3,
                                             2, 4,
                                             2, 5, 
                                             3, 5, 
                                             4, 5))
G = graph_from_edgelist(el = edges, directed = F)

set.seed(1305)
par(mar = c(0,0,3,0))
plot.igraph(G, edge.arrow.size = 0.1,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5,
            main = 'Undirected graph (Item 1)')

Graph Item 1

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

En este caso, se pueden utilizar varias funciones del paquete igraph para el mismo fin:

• Orden: gorder, vcount
• Tamaño: gsize, ecount
• Diámetro: diameter

Nota: Para todas las funciones se recibe como único argumento el grafo.

Punto1 = list('graph' = G, 'order' = gorder(G),
              'size' = gsize(G), 'diameter' = diameter(G))

for (i in 2:4){
  cat('The', names(Punto1)[i], 'of the graph is:', Punto1[[i]], '\n')
}

## The order of the graph is: 5 
## The size of the graph is: 7 
## The diameter of the graph is: 2

c. Calcular el grado de cada vértice.

La función degree de la librería igraph nos ayuda a conocer el grado de cada vertice:

Punto1$degree = cbind('Node' = 1:5, 'Degree' = degree(G))

Node	Degree
1	2
2	4
3	3
4	2
5	3

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

En este caso, no es necesario generar un nuevo grafo (Aunque podríamos simplemente eliminar los nodos que no queremos elegir) pues la función subgraph genera el subgrafo utilizando los nodos que le indiquemos:

Punto1$subgraph = subgraph(graph = G, vids =  c(1,2,3,4))

set.seed(1305)
par(mar = c(0,0,3,0))
plot.igraph(Punto1$subgraph, edge.arrow.size = 0.1,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5,
            main = 'Undirected graph (Item 1)')
mtext(bquote(bold('Subgraph with 1,2,3 and 4 nodes')), side = 3, line = -0.5, 
      col = 'gray')

Subgraph item 2

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

Este punto es muy similar al anterior, se utiliza la misma estructura y funciones:

a. Graficar \(G\).

edges = matrix(ncol = 2, byrow = T, data = c(1, 3,
                                             2, 3,
                                             2, 4,
                                             2, 5,
                                             3, 1, 
                                             3, 5, 
                                             4, 5,
                                             5, 4))
G = graph_from_edgelist(el = edges, directed = T)

set.seed(1305)
par(mar = c(0,0,3,0))
plot.igraph(G, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5,
            main = 'Directed graph (Item 2)')

Subgraph item 2

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

Punto2 = list('graph' = G, 'order' = gorder(G),
              'size' = gsize(G), 'diameter' = get_diameter(G))

for (i in 2:4){
  cat('The', names(Punto2)[i], 'of the graph is:', Punto2[[i]], '\n')
}

## The order of the graph is: 5 
## The size of the graph is: 8 
## The diameter of the graph is: 1 3 5 4

c. Calcular el grado de cada vértice del grafo.

Punto2$degree = cbind('nodes' = 1:5, 'degree' = degree(G))
# cat('The degree for each node is:\n')
print(Punto2$degree)

##      nodes degree
## [1,]     1      2
## [2,]     2      3
## [3,]     3      4
## [4,]     4      3
## [5,]     5      4

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

Punto2$subgraph = subgraph(graph = G, vids =  c(1,2,3,4))

set.seed(1305)
par(mar = c(0,0,3,0))
plot.igraph(Punto2$subgraph, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5,
            main = 'Directed graph (Item 2)')
mtext(bquote(bold('Subgraph with 1,2,3 and 4 nodes')), side = 3, line = -0.5, 
      col = 'gray')

Subgraph item 2

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

a. Graficar todos los posibles estados relacionales de una triada.

cat('Para este caso habrán', 2 ** (choose(3, 2)), 'posibles estados con', choose(3,2), 'posibles enlaces.')

## Para este caso habrán 8 posibles estados con 3 posibles enlaces.

Para este caso, además de las funciones de igraph utilizaremos la función combn de Rbase para generar dos cosas principalmente

• edges = combn(c(1,2,3), 2, simplify = F): Genera todas las posibles conexiones entre nodos. Es decir, genera todas las combinaciones posibles de dos pares entre los nodos, tenga en cuenta que esto se hace suponiendo que el grado sea no dirigido pues la función combn no tiene en cuenta el orden de los nodos. Como simplify = F se generará un objeto de tipo lista donde cada elemento de esa lista es un par de nodos (Arista) de tipo vector numérico.

• combn(edges, k, simplify = F): Genera todas las combinaciones de k aristas posibles a partir de la lista dada por la función anterior. Tenga en cuenta que en este caso, se tendrán a lo sumo \(\binom{3}{2} = 3\) aristas en el grafo por lo que no podemos utilizar \(k > 3\) o la función devolverá un error. En este caso se retornará nuevamente una lista de las posibles aristas para cada caso.

Finalmente, como se tiene una lista de aristas no es posible pasar directamente esta lista a igraph para crear el grafo y además si un nodo no está dentro de las aristas no se dibujará, por esto se genera un grafo vacío de 3 nodos para ponerle los vértices después con add_edges a partir del vector numérico generado con unlist a cada una de las listas de aristas.

# En general se pueden construir 2** (kC2) grafos
edges = combn(c(1,2,3), 2, simplify = F)                      # Conexiones posibles
grafos = list('one edge' = combn(edges, 1, simplify = F),     # Todas las combinaciones de 1 conexión posibles
              'two edges' = combn(edges, 2, simplify = F),    # TOdas las combinaciones de 2 conexiones posibles
              'three edges' = combn(edges, 3, simplify = F))  # TOdas las combinaciones de 3 conexiones posibles

empty = make_empty_graph(n = 3, directed = FALSE)             # Este es un grafo vacío
for (i in 1:3){
  for (j in 1:length(grafos[[i]])){
    grafos[[i]][[j]] = add_edges(graph = empty,               # Al grafo vacío se le agregan los enlaces o aristas
                                 edges = unlist(grafos[[i]][[j]]))
  }
}

grafos$`no edges`[[1]] = empty                                # El caso 'base' o el grafo desconectado

par(mfrow = c(2,4), mar = c(1,3,2,3))
for (i in names(grafos)){
  for (j in grafos[[i]]){
    set.seed(1305)
    plot(j,
         edge.arrow.size = 0.1, edge.color = 'black', edge.width = 1.5,
         vertex.label.color = 'black', vertex.label.cex = 2.5,
         vertex.color = 'gray', vertex.frame.color = NA, vertex.size = 40)
    title(main = i, cex.main = 1.5, font = 2)
    # mtext(i, side = 3, line = -1, col = 'darkgray', font = 2, cex = 0.8)
  }
  mtext('All possible graphs with 3 nodes', side = 1, line = -1.6, 
      col = adjustcolor('dodgerblue4', alpha = 0.25), font = 2, 
      cex = 1.3, adj = 0.99, outer = T)
}

b. Identificar los estados isomorfos.

La librería igraph ya tiene implementada la función isomorphic para determinar si dos grafos dados son o no isomorfos. Sin embargo, sólo funciona con dos grafos simultáneamente por lo que la siguiente implementación revisa uno por uno cada uno de los grafos que tienen la misma cantidad de aristas para definir un representante de cada isomorfismo.

for (i in names(grafos)){
  graphs = grafos[[i]]
  if (length(graphs) > 1){
    iso = rep(F, length(graphs))
    for (j in 1:length(graphs)){
      if (!iso[j]){
        flags = unlist(lapply(graphs, function(x) isomorphic(x,graphs[[j]])))
        flags[j] = F
        iso = iso | flags 
      }
    }
    grafos[[i]] = grafos[[i]][!iso]
  }
}

Nota: Tenga en cuenta que se están haciendo cálculos reiterados innecesarios pues dentro de lapply se revisa siempre si existe o no isomorfismo entre el grafo actual y los grafos hacia delante del grafo actual, el grafo actual, pero también los grafos hacia atrás que ya han sido revisados antes por lo que puede cambiarse este parte para cuando se requieran revisar los isomorfismos de los grafos con mayor cantidad de nodos.

par(mfrow = c(1,4), mar = c(0,3,2,3))
for (i in names(grafos)){
  for (j in 1:length(grafos[[i]])){
    set.seed(1305)
    plot(grafos[[i]][[j]],
         edge.arrow.size = 0.1, edge.color = 'black', edge.width = 1.5,
         vertex.label.color = 'black', vertex.label.cex = 2.5,
         vertex.color = 'gray', vertex.frame.color = NA, vertex.size = 40)
    title(main = i, cex.main = 2.5, font = 2)
    # mtext(i, side = 3, line = -2.1, col = 'darkgray', font = 2, cex = 1.3)
  }
}
mtext('All isomorphic graphs with 3 nodes', side = 1, line = -1.6, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, 
      cex = 1.5, adj = 0.99, outer = T)

4. Graficar todos los grafos conectados con 4 vértices.

La función igraph::is_connected devuelve TRUE si un grafo es conectado o FALSE si un grafo no lo es. Utilizaremos esta función acompañada de la generación de grafos que utilizamos en el punto anterior para generar todos los grafos conectados de 4 vértices. Teniendo en cuenta que se necesitan al menos 3 vértices para conectar todos los vértices y que sólo hay una forma de conectar los nodos con 6 vértices:

# En general se pueden construir 2** (kC2) grafos
edges = combn(c(1,2,3, 4), 2, simplify = F)                   # Conexiones posibles
grafos = list('three edges' = combn(edges, 3, simplify = F),  # Todas las combinaciones de 3 conexiones posibles
              'four edges' = combn(edges, 4, simplify = F),   # Todas las combinaciones de 4 conexiones posibles
              'five edges' = combn(edges, 5, simplify = F),   # Todas las combinaciones de 5 conexiones posibles
              'six edges' = combn(edges, 6, simplify = F))    # Todas las combinaciones de 6 conexiones posibles

empty = make_empty_graph(n = 4, directed = FALSE)             # Este es un grafo vacío
for (i in names(grafos)){
  lista = list()
  for (j in 1:length(grafos[[i]])){
    grafo = add_edges(graph = empty,                          # Al grafo vacío se le agregan los enlaces o aristas
                      edges = unlist(grafos[[i]][[j]]))
    if (is_connected(grafo)){
      lista[[length(lista) + 1]] = grafo
    }
  }
  grafos[[i]] = lista
}

par(mfrow = c(6,7), mar = c(1,1,1,1))
for (i in names(grafos)){
  for (j in 1:length(grafos[[i]])){
    set.seed(1305)
    plot(grafos[[i]][[j]],
         edge.arrow.size = 0.1, edge.color = 'black', edge.width = 3,
         vertex.label.color = 'black', vertex.label.cex = 3,
         vertex.color = 'gray', vertex.frame.color = NA, vertex.size = 55)
    # title(main = "Autogenerated graph", cex.main = 2, font = 2)
    # mtext(i, side = 3, line = -1.2, col = 'darkgray', font = 2, cex = 1.3)
  }
}
mtext('All the connected graphs with 4 nodes.', side = 1, line = -1.8, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 2, adj = 0.99, outer = T)

Sin embargo, podemos simplemente revisar los isomorfos de 4 vértices que representan grafos conectados utilizando nuevamente una aproximación parecida a la que se utilizó en el punto anterior:

for (i in names(grafos)){
  graphs = grafos[[i]]
  if (length(graphs) > 1){
    iso = rep(F, length(graphs))
    for (j in 1:length(graphs)){
      if (!iso[j]){
        flags = unlist(lapply(graphs, function(x) isomorphic(x,graphs[[j]])))
        flags[j] = F
        iso = iso | flags 
      }
    }
    grafos[[i]] = grafos[[i]][!iso]
  }
}

par(mfrow = c(2,3), mar = c(1,1,1,2))
for (i in names(grafos)){
  for (j in 1:length(grafos[[i]])){
    set.seed(1305)
    plot(grafos[[i]][[j]],
         edge.arrow.size = 0.1, edge.color = 'black', edge.width = 2,
         vertex.label.color = 'black', vertex.label.cex = 2.5,
         vertex.color = 'gray', vertex.frame.color = NA, vertex.size = 45)
    # title(main = "Isomorphic graph", cex.main = 2.4, font = 2)
    # mtext(i, side = 3, line = -0.65, col = 'darkgray', font = 2, cex = 1.3)
  }
}
mtext('All the connected graphs with 4 nodes (As isomorphism)', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.5, adj = 0.99, outer = T)

5. Escribir una rutina que reconstruya la matriz de adyacencia a partir de la matriz de aristas y una lista de vértices aislados (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.

Primero necesitamos generar un grafo con la probabilidad dada bien sea dirigido o no dirigido. Para eso, se crea la función genEdgelist que recibe la cantidad de nodos, si el grafo es o no dirigido y la probabiidad de éxito:

• Primero se mapean todos los posibles enlaces entre dos vértices del grafo. (Con la función combn)
• Luego se generan unos y ceros (Unos para si el enlace está presente en el grafo y cero si no) para cada enlace.
• La matriz de enlaces estará definida por aquellos enlaces que se marcaron con 1.

genEdgelist = function(n = 10, directed = T, prob = 0.1){
  nodes = seq(1:n)
  edges = t(combn(nodes,2, simplify = T))
  if (directed){
    edges = rbind(edges,
                  cbind(edges[,2], edges[,1]))
  }
  selected = rbinom(n = nrow(edges), size = 1, prob = prob)
  edges = edges[(selected == 1),]
  return(list('nodes' = n, 'edges' = edges))
}

Nota: Como se tiene que hay nodos que pueden no quedar conectados se devuelve también el número de nodos totales. Sin embargo, esta función no genera nodos con nombres.

set.seed(1305)
edgeList = genEdgelist(n = 25, directed = F, prob = 0.1)

Tenga en cuenta que las etiquetas de salida y entrada en el caso de grafos no dirigidos se vuelven irrelevantes

Edge list matrix

Salida	1	1	2	2	3	3	3	3	4	5	6	6	7	7	7	8	9	11	13	13	13	13	14	14	14	16	16	16	17	20	24
Entrada	21	22	14	22	5	7	13	18	19	12	14	16	13	16	22	11	15	20	14	16	22	23	18	21	25	17	21	24	18	25	25

## Se seleccionaron 31 vértices de 300 vértices posibles.

Crearemos un grafo a partir de la matriz de aristas de forma que podamos comparar este y el grafo generado a partir de la matriz de adyacencia luego:

G = make_empty_graph(n = 25, directed = F)
G = add_edges(G, edges = t(edgeList$edges))

La función encargada de recuperar la matriz de adyacencia a partir de la matriz de aristas y una lista de nodos desconectados funciona de la siguiente forma:

• Se extraen los nombres de los nodos.
• Se crea una matriz de \(n \times n\) donde \(n\) es la cantidad de nodos que se encontraron.
• Se llena la matriz poniendo 1 en las coordenadas \((i, j)\) dadas en la matriz \(k \times 2\) de aristas.
• En el caso de que se tenga un grafo no dirigido se suma la matriz anterior con su transpuesta y esta será la matriz de salida

Nota: Esta función puede manejar directamente las etiquetas de los nodos por lo que modificamos la matriz de aristas para que tenga texto en cambio de números.

edges = matrix(as.character(edgeList$edges), ncol = 2, byrow = F)

Los nodos desconectados se pueden encontrar así:

nodes = as.character(seq(1:25))
nodes = setdiff(nodes, 
                unique(c(unique(edges[,2]),
                         unique(edges[,1]))))

## Los nodos: 10 son los nodos que están desconectados.

AdjFromEdges = function(edges, vertices = NULL, directed = F){
 nodes = c(unique(c(unique(edges[,2]),
                    unique(edges[,1]))),
           vertices) 
 A = matrix(0,ncol = length(nodes), 
           nrow = length(nodes))
 colnames(A) = rownames(A) = nodes
 A[edges] = 1
 if (!directed){
   A = A + t(A)
 }
 return(A)
}

# Aplicandolo al grafo de ejemplo:
A = AdjFromEdges(edges = edges, vertices = nodes, directed = F)

# Esto se hace solamente con el fin de que se los gráfico se generen con el mismo layout
A = A[as.character(seq(1:25)), as.character(seq(1:25))]

G1 = graph_from_adjacency_matrix(A, mode = 'undirected')

par(mfrow = c(1,2))
set.seed(1305)
plot.igraph(G,
            vertex.color = 'gray', 
            vertex.size = 18,
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            vertex.label.cex = 1.1,
            edge.width = 1.5)
title(main = "Adjacency matrix", cex.main = 1.6, font = 2)
set.seed(1305)
plot.igraph(G1, edge.arrow.size = 0.1,
            vertex.color = 'gray', 
            vertex.size = 18,
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            vertex.label.cex = 1.1,
            edge.width = 1.5)
title(main = "Edge list matrix", cex.main = 1.6, font = 2)

Graph from adjacency matrix vs graph from edge list matrix

a = as_adjacency_matrix(G, sparse = F)
b = as_adjacency_matrix(G1, sparse = F)
cat('Se encontraron exactamente',sum(a != b), 'diferencias entre los dos grafos.')

## Se encontraron exactamente 0 diferencias entre los dos grafos.

6. Escribir una rutina 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.

Primero necesitamos una función que genere la amtriz de adyacencia. La siguiente función precisamente hace eso:

• Crea una matriz de ceros de tamaño \(n \times n\) donde \(n\) es el orden del grafo deseado.
• Genera 1 y 0 para llenar la triangular superior de esa matriz (Generar los enlaces).
• Si la red deseada es no dirigida se suma la matriz por su transpuesta.
• Si la red deseada es dirigida se generan unos y ceros para la triangular inferior.

ErgosRenyi = function(n = 25, symmetrical = TRUE, prob = 0.1){
  A = matrix(0, ncol = n, nrow = n)
  edges = rbinom(n = (n*(n-1))/2, size = 1, prob = prob)
  A[upper.tri(A)] = edges
  if (symmetrical){
    A = A + t(A)
  } else {
    edges = rbinom(n = (n*(n-1))/2, size = 1, prob = prob)
    A[lower.tri(A)] = edges
  }
  return(A)
}

set.seed(2012)
A = ErgosRenyi()

La matriz de adyacencia generada por esta función para 25 nodos y una red no dirigida es:

Adjacency matrix

0	0	0	1	0	0	0	1	0	1	0	0	0	1	0	0	0	0	0	0	0	0	1	1	0
0	0	0	0	1	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0
0	0	0	0	0	0	0	0	1	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0
1	0	0	0	1	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0	0
0	1	0	1	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0	0	1	0	0
1	0	0	0	1	0	0	0	0	0	1	0	0	1	0	0	0	1	0	0	0	0	0	0	0
0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0
1	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	1	0	0	0	0	1	0	0	0	1	0	0	0	0	0	0	0	0	1	0	0	0	0
0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0	1	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
1	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1
0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	1	0	0	1	0	0	0
0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0	1	0	0	0	1	0	0	0	0
0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	1	0	0	0	0	0	1	0	0
0	0	0	0	0	0	1	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	1	0	0	0	0	0	0	0
0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0
1	0	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0
1	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0

Una vez realizada la matriz de adyacencia utilizaremos la siguiente función para extraer la matriz de aristas y los vertices aislados:

EdgeFromAdj = function(A){
  edges = c()
  vertices = c()
  if (sum(A != t(A)) == 0){
    A[upper.tri(A)] = 0
  }
  for (i in 1:nrow(A)){
    conections = which(A[i,] != 0)
    if (length(conections) > 0){
      edges = rbind(edges, cbind(i,conections))
    } else {
      if (sum(A != t(A))) {vertices = cbind(vertices, i)}
    }
  }
  vertices = vertices[!(vertices %in% edges[, "conections"])]
  colnames(edges) = names(vertices) = NULL
  return(list('edges' = edges, 'vertices' = vertices))
}

Esta función esencialmente:

• Revisa si la matriz es simétrica.
• Si la matriz es simétrica se elimina la triangular superior (Se reemplaza con cero)
• Para cada fila i de la matriz A se revisa qué columna j contiene unos (Con la función which).
• Si hay al menos un uno en esa fila, se añade a la lista de aristas (edges) todos los elementos de esa fila con unos (i, j).
• Si no hay unos en esa fila el número de fila se añade a la lista de vertices aislados (vertices)

Una vez declarada la función podemos utilizar a la matriz generada con ErgosRenyi (A) para generar nuestra matriz de aristas:

edges = EdgeFromAdj(A)

## Los nodos del grafo que tienen al menos una conexión son: 
##       4 5 8 9 10 11 12 14 16 18 19 20 21 22 23 24 25 1 2 3 17 7 15 
##  Y los nodos aislados son: 
##       6 13

Finalmente, para revisar que efectivamente los dos grafos son iguales definimos grafos para cada uno y graficamos:

G = graph_from_edgelist(edges$edges, directed = F)
# Comúnmente debería de ser encesario añadir los vértices aislados al grafo. Sin 
# embargo, debido a que los nodos son números igraph completa los faltantes y ayuda a que
# los layouts sean idénticos.

G1 = graph_from_adjacency_matrix(A, mode = 'undirected')


par(mfrow = c(1,2))
set.seed(1305)
plot.igraph(G1,
            vertex.color = 'gray', 
            vertex.size = 18,
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            vertex.label.cex = 1.1,
            edge.width = 1.5)
title(main = "Adjacency matrix", cex.main = 1.6, font = 2)
set.seed(1305)
plot.igraph(G, edge.arrow.size = 0.1,
            vertex.color = 'gray', 
            vertex.size = 18,
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            vertex.label.cex = 1.1,
            edge.width = 1.5)
title(main = "Edge list matrix", cex.main = 1.6, font = 2)

Graph from adjacency matrix vs graph from edge list matrix

a = as_adjacency_matrix(G, sparse = F)
b = as_adjacency_matrix(G1, sparse = F)
cat('Se encontraron exactamente',sum(a != b), 'diferencias entre los dos grafos.')

## Se encontraron exactamente 0 diferencias entre los dos grafos.

# a = as_adjacency_matrix(G, sparse = F)
b = as_adjacency_matrix(G1, sparse = F)
cat('Se encontraron exactamente',sum(A != b), 'diferencias entre los dos grafos.')

## Se encontraron exactamente 0 diferencias entre los dos grafos.

7. Hacer una rutina 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 como 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.

Note que la función ErgosRenyi ya sirve como base para lo que se desea construir. Sin embargo, se deben agregar como argumento la semilla y como salida la visualización del grafo. Así pues, podemos o modificar completamente la función o utilizar una función para llamar esa función agregandolé lo que nos hace falta. Se modificará la función original y se le pondrá otro nombre:

Punto7 = function(n = 25, symmetrical = TRUE, prob = 0.5, seed = 42){
  A = matrix(0, ncol = n, nrow = n)
  set.seed(seed)
  edges = rbinom(n = (n*(n-1))/2, size = 1, prob = prob)
  A[upper.tri(A)] = edges
  if (symmetrical){
    A = A + t(A)
  } else {
    edges = rbinom(n = (n*(n-1))/2, size = 1, prob = prob)
    A[lower.tri(A)] = edges
  }
  
  # =====> Gráfico
  par(mar = c(2.5, 2.5, 2.5, 2.5))
  cols = c('white', '#8B0000')
  image( 1:nrow(A), 1:ncol(A),  A[,seq(nrow(A),1)], 
         col = cols, xlab = '', ylab = '', axes = F)
  axis(3, at = 1:ncol(A), labels = 1:nrow(A), las = 2, col = 'darkgray', tick = F)
  axis(2, at = 1:nrow(A), labels = nrow(A):1, las = 2, col = 'darkgray', tick = F)
  for (i in 1:nrow(A)) {
    abline(h = i - 0.5, col = "darkgray", lwd = 0.5)  # Líneas horizontales
    abline(v = i - 0.5, col = "darkgray", lwd = 0.5)  # Líneas verticales
  }
  mtext(bquote(bold('Adjacency matrix')), col = 'darkgray', side = 1, outer = F, adj = 1, line = 1)
  box(col = 'darkgray')
  map = recordPlot()
  return(list('Adjacency matrix' = A, 'Heatmap' = map))
}

Se comprobará para los siguientes casos para un grafo del mismo orden (30):

• Gráfico dirigido y no dirigido
• Con probabilidad 0.5 y 0.99

sym = c(TRUE, FALSE)
prob = c(0.5, 0.8)

# Definir el layout
layout(matrix(c(0,0,1,2,3,4), ncol = 2, byrow = T), heights = c(0.2,1.6,1.6))

# Continuar con tu código original
lista = list()
for (i in sym){
  for (j in prob){
    lista[[paste('directed:', i, 'prob:', j)]] = Punto7(n = 30, symmetrical = i, prob = j, 
                                                        seed = rbinom(n = 1, size = 20, prob = 0.5))
    mtext(paste('directed:', i, 'prob:', j), font = 2, side = 1, adj = -0.1,
          cex = 0.8, line = 0.7)
  }
}

Heatmap comparison

8. 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 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).

load('../Data/addhealth.RData')

a. Identificar las variables nodales.

colnames(dat$X)

## [1] "female" "race"   "grade"

Dentro del archivo dat$X está conformado por tres columnas:

• Género
• Raza
• Grado

De las cuales las tres son variables nodales.

b. Identificar y clasificar las variables relacionales.

colnames(dat$E)

## [1] "V1"         "V2"         "activities"

En cuanto a las variables relacionales, sólo se encuentra la variable activities en la que se relaciona una variable de peso de la interacción entre dos nodos (Cantidad de actividades) por lo que tenemos una red ponderada y no dirigida.

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

Note que existen nodos aislados pues en la lista de variables nodales se tienen:

cat(nrow(dat$X),'variables')

## 255 variables

Mientras que en la lista de aristas se registran:

cat(length(unique(c(dat$E[,"V1"], dat$E[,"V2"]))), 'aristas.')

## 248 aristas.

Sin embargo, en un principio si creamos un objeto con 255 vertices en igraph y añadimos los enlaces luego deberían quedar completos los vértices.

G = make_empty_graph(n = 255, directed = F)
G = add_edges(G,edges = t(dat$E[,c('V1','V2')]))

cat('El grafo generado cuenta con',gorder(G),'nodos.')

## El grafo generado cuenta con 255 nodos.

Por lo que finalmente para el grafo completo se tendrá que:

## The order of the graph is: 255 
## The size of the graph is: 1264 
## The diameter of the graph is: 7

d. Graficar la red sin tener en cuenta las variables nodales.

set.seed(1305)
layout <- layout_with_kk(G)

# Con el layout Kamada-Kawai los nodos desconectados tienden a quedar o dentro del grafo o
# afuera del área gráfica por lo que se reubican dentro de un área no tan "poblada" de la
# representación del grafo.

layout[degree(G) == 0, ] <- cbind(runif(sum(degree(G) == 0), -6, 0),
                                  runif(sum(degree(G) == 0), 5, 10))
# lay = layout_nicely(G)
# lay = layout_with_kk(G)
# lay = layout_with_graphopt(G, charge = 0.0001, mass = 180)
rotate_layout <- function(layout, theta) {
  rotation_matrix <- matrix(c(cos(theta), -sin(theta), sin(theta), cos(theta)), nrow = 2)
  t(rotation_matrix %*% t(layout))
}

# layout <- rotate_layout(layout, (1 * pi )/8 )

# Se utilizaron colores distintos para verificar dónde estaban quedando ubicados
# los nodos aislados
colores = rep(adjustcolor('darkslategray4', 0.4), 255)
colores[degree(G) == 0] = adjustcolor('salmon', 0.6)
coloresFrame = rep('darkslategray4', 255)
coloresFrame[degree(G) == 0] = 'salmon'

# Colores por género
# colores = rep(adjustcolor('darkslategray4', 0.4), 255)
# colores[dat$X[,"female"] == 1] = adjustcolor('salmon', 0.6)
# coloresFrame = rep('darkslategray4', 255)
# coloresFrame[dat$X[,"female"] == 1] = 'salmon'
# La razón de los dos grupos que se muestran no está relacionada con el género

par(mar = c(0,3,0,0))
plot.igraph(Punto8$graph, edge.arrow.size = 0.1, layout = layout,
            vertex.color = colores, 
            vertex.frame.color = coloresFrame, 
            edge.color = adjustcolor('gray', alpha = 0.8),
            vertex.label = NA, 
            vertex.size = 2.5,
            edge.width = 1.8,
            edge.curved = 0)
# title(main = 'Relationships between students', col = 'black', font = 2, cex.main = 1.5, 
#       line = -0.8, side = 2)
mtext(bquote(bold('Relationships between students')), side = 2, cex = 1.6, line = 0.8, las = 3,
      col = adjustcolor('black', alpha = 0.7))
mtext('The red dots represent the isolated nodes.', side = 1, line = -3, 
      col = adjustcolor('black', alpha = 0.8), font = 2, cex = 0.7, 
      adj = 0.99, outer = T)

e. Identificar el top 5 de los nodos más propensos a emitir/recibir relaciones.

Los nodos más propensos a emitir o recibir relaciones (En una red no dirigida) son aquellos con un grado más alto:

grados = degree(G)
grados = cbind('Nodo' = 1:255, 'Grado' = grados)
grados = as.data.frame(grados) %>% 
  mutate(Grado = as.numeric(Grado)) %>%
  arrange(desc(Grado))

Nodo	Grado
29	28
44	25
129	25
150	25
162	24

9. 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. 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 \(\scriptsize{\mathbf{Y}=[y_{i,j}]}\) en la que \(\scriptsize{y_{i,j}}\) representa el número de conflictos iniciados por el país \(i\) hacia el país \(j\). Finalmente, Des 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).

load(file = '../Data/conflict.RData')
str(dat)

## List of 3
##  $ X: num [1:130, 1:3] 24.78 3.28 27.89 10.66 34.77 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:130] "AFG" "ALB" "ALG" "ANG" ...
##   .. ..$ : chr [1:3] "population" "gdp" "polity"
##  $ Y: num [1:130, 1:130] 0 0 0 0 0 0 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:130] "AFG" "ALB" "ALG" "ANG" ...
##   .. ..$ : chr [1:130] "AFG" "ALB" "ALG" "ANG" ...
##  $ D: num [1:130, 1:130, 1:4] 0 -17.7 18.1 11.8 -33.3 ...
##   ..- attr(*, "dimnames")=List of 3
##   .. ..$ : chr [1:130] "AFG" "ALB" "ALG" "ANG" ...
##   .. ..$ : chr [1:130] "AFG" "ALB" "ALG" "ANG" ...
##   .. ..$ : chr [1:4] "polity_int" "imports" "shared_igos" "distance"

a. Identificar las variables nodales.

Las variables nodales serán solamente aquellas que se encuentran disponibles en dat$X pues las variables dentro de dat$D son variables de los enlaces como tal mientras que lo que se encuentra guardado en dat$Y es la matriz de adyacencia.

colnames(dat$X)

## [1] "population" "gdp"        "polity"

Las variables nodales son:

• population: Población del país.
• gdp: PIB del país en millones de doláres.
• polity: Puntuación política del país.

b. Identificar y clasificar las variables relacionales.

dimnames(x = dat$D)[[3]]

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

En este caso, las variables relacionales son:

• polity_int: Comercio entre dos países.
• imports: Importaciones entre dos países.
• shared_igos: Organizaciones intergubernamentales entre dos países.
• distance: Distancia geográfica entre dos países.

Nota: Si bien no todos los países están conectados por la variable de conflicto, para todos los países sí existen estas variables por lo que es sencillo obtener las variables relacionadas con los pares relacionados por conflicto.

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

De una vez creamos el objeto de tipo igraph y guardamos todos los atributos preguntados en una lista:

G = graph_from_adjacency_matrix(dat$Y, mode = 'directed', weighted = T)
Punto9 = list('graph' = G, 'order' = gorder(G),
              'size' = gsize(G), 'diameter' = diameter(G))

for (i in 2:4){
  cat('The', names(Punto9)[i], 'of the graph is:', Punto9[[i]], '\n')
}

## The order of the graph is: 130 
## The size of the graph is: 203 
## The diameter of the graph is: 14

Teniendo en cuenta que la matriz de adyacencia representa el número de conflictos iniciados por un país \(i\) con un país \(j\) la red que tenemos es dirigida y ponderada.

d. Graficar la red sin tener en cuenta las variables nodales.

set.seed(1305)
# layout <- layout_with_kk(G)
layout = layout_with_fr(G)
par(mar = c(0,1,0,0))
plot.igraph(Punto9$graph, edge.arrow.size = 0.35, layout = layout,
            vertex.color = adjustcolor('darkslategray4', 0.4), 
            vertex.frame.color = 'darkslategray4', 
            edge.color = adjustcolor('darkgray', alpha = 0.95),
            vertex.label = NA, 
            vertex.size = 2.9,
            edge.width = 1.8,
            edge.curved = 0)
mtext(bquote(bold('Conflictos iniciados entre países')), side = 2, cex = 1.6, las = 3, line = -0.95,
      col = adjustcolor('black', alpha = 0.7))

e. Identificar el top 5 de los nodos más propensos a emitir/recibir relaciones de acuerdo con los conflictos.

Los nodos más propensos a emitir o recibir relaciones (En una red no dirigida) son aquellos con un grado más alto:

grados = degree(G, mode = 'all')
grados = cbind('Nodo' = names(grados), 'Grado' = grados)
grados = as.data.frame(grados) %>% 
  mutate(Grado = as.numeric(Grado)) %>%
  arrange(desc(Grado))

Nodo	Grado
IRQ	42
JOR	27
USA	19
TUR	11
CHN	10

Por otro lado, al ser una red dirigida podemos ver el top 5 por popularidad:

grados = degree(G, mode = 'in')
grados = cbind('Nodo' = names(grados), 'Grado' = grados)
grados = as.data.frame(grados) %>% 
  mutate(Grado = as.numeric(Grado)) %>%
  arrange(desc(Grado))

Nodo	Grado
IRQ	15
USA	8
HAI	7
TUR	6
JPN	5

Y sociabilidad:

grados = degree(G, mode = 'out')
grados = cbind('Nodo' = names(grados), 'Grado' = grados)
grados = as.data.frame(grados) %>% 
  mutate(Grado = as.numeric(Grado)) %>%
  arrange(desc(Grado))

Nodo	Grado
IRQ	27
JOR	26
USA	11
UGA	7
CHN	6

Nota: Teniendo en cuenta que el grado no tiene en cuenta la cantidad de conflictos inciada entre un papis y otro.

10. 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).

Existen muchos tipos de grafos, y entre ellos algunos importantes para el análisis estadístico de redes sociales especialmente por la estructura como tal del grafo:

GRAFOS COMPLETAMENTE CONECTADOS: Un grafo en el que cualquier vértice está conectado a cualquier otro vértice. Es decir, la matriz de adyacencia debería de verse como una matriz cuya triangular superior e inferior son unos:

g =  make_full_graph(n = 7, directed = F)

Matriz de adyacencia para grafo completamente conectado (Con 7 nodos)

0	1	1	1	1	1	1
1	0	1	1	1	1	1
1	1	0	1	1	1	1
1	1	1	0	1	1	1
1	1	1	1	0	1	1
1	1	1	1	1	0	1
1	1	1	1	1	1	0

Y debería verse así:

set.seed(1305)
l = layout_in_circle(g)
par(mar = c(0,0,0,0))
plot.igraph(g, layout = l,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black',
            edge.width = 1, edges.curved = 0)
mtext('A complete graph with 7 nodes.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Nota: Este tipo de grafos son especialmente útiles cuando se quieren estudiar sub grafos completos dentro de redes más complejos (En inglés clique).

GRAFO REGULAR: Es aquel grafo en el que todos los vértices tienen el mismo grado sin excepción:

g =  make_ring(n = 7, directed = F)

La matriz de adyacencia del grafo debería sumar lo mismo en todas sus filas y columnas:

Matriz de adyacencia para grafo regular (Con 7 nodos)

0	1	0	0	0	0	1
1	0	1	0	0	0	0
0	1	0	1	0	0	0
0	0	1	0	1	0	0
0	0	0	1	0	1	0
0	0	0	0	1	0	1
1	0	0	0	0	1	0

Y debería verse así:

set.seed(1305)
par(mar = c(0,0,0,0))
plot.igraph(g, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5)
mtext('A regular graph with 7 nodes.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Nota: Cuando el grafo tiene el grado común \(k\) el grafo se llama \(k\) regular

ÁRBOL: Un grafo conectado sin ciclos (i.e. No es posible volver a un vértice partiendo desde sí mismo). En general este tipo de grafos es importante como una estructura de datos en algoritmos computacionales. Un grafo de este tipo debería verse así:

g = make_tree(n = 7, children = 2, mode = 'undirected')

set.seed(1305)
par(mar = c(0,0,0,0))
plot.igraph(g, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5)
mtext('A tree graph with 7 nodes.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Además de esto, cuando el grafo es dirigido tenemos un vértice especial llamado raíz que es un vértice desde el cual se puede llegar a cualquier otro vértice del árbol:

g = make_tree(n = 7, children = 2, mode = 'out')

set.seed(1305)
par(mar = c(0,0,0,0))
plot.igraph(g, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5)
mtext('A directed tree graph with 7 nodes.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Por ejemplo, en este caso, la raíz del árbol sería el número 1. También se puede hablar de hojas: Los últimos vértices del árbol desde los cuáles no se puede llegar a ningún otro vértice; ancestros: aquellos vértices antes de un vértice partiendo desde la raíz (Sin contar las hojas) y finalmente os descendientes que es la definición contraria de ancestro. Un ancestro inmediato es llamado padre y un descendiente inmediato es llamado hijo.

Finalmente, existe dos tipos especiales de grafo:

Uno llamado DAG (Directed Acyclic graph) que es un grafo con la estructura del árbol que realmente no es un árbol por la dirección de sus enlaces:

g = make_tree(n = 7, children = 2, mode = 'in')

set.seed(1305)
par(mar = c(0,0,0,0))


g = make_tree(n = 7, children = 2, mode = 'out')

# Definir un layout con `layout.reingold.tilford` y especificar la raíz
layout <- layout_as_tree(g,  flip.y = F)  # Nodo raíz definido


plot.igraph(g, edge.arrow.size = 0.4,
            layout = layout,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5, edge.arrow.mode = T)
mtext('A DAG with 7 nodes.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Y una \(k\)-estrella que sí es un árbol, pero que solamente tiene una raíz y hojas (Para ser específico tiene \(k\) hojas).

g = make_star(n = 7, mode = 'undirected')

set.seed(1305)
par(mar = c(0,0,0,0))
plot.igraph(g, edge.arrow.size = 0.4,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black', 
            edge.width = 1.5)
mtext('A 7-star graph.', side = 1, line = -1.2, 
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

Nota: Cuando se tienen varios árboles disjuntos en una sola red se llama bosque.

GRAFOS BIPARTITOS: Un grafo \(G = (V, E)\) donde el conjunto de vértices \(V\) puede ser dividido en dos conjuntos disjuntos \(V_1\) y \(V_2\) y en el que el conjunto de aristas conecta solamente vértices de \(V_1\) con vértices en \(V_2\) (O viceversa en el caso de ser dirigido.)

Es decir, un grafo bipartito representa relaciones entre dos conjuntos de individuos que pueden representar inidividuos de distinta naturaleza (por ejemplo Actores y películas, empleados y empresas, etc).

Generalmente, estos grafos se representan así:

g <- graph_from_literal(actor1:actor2:actor3,movie1:movie2, actor1:actor2 - movie1, actor2:actor3 - movie2)
V(g)$type <- grepl("^movie", V(g)$name)

set.seed(1305)

plot(g, layout= -layout_as_bipartite(g)[,2:1],
     vertex.size=60, vertex.shape=ifelse(V(g)$type,
                                         "rectangle", "circle"),
     vertex.label.cex=1.5,
     vertex.label.color = 'black',
     vertx.label.font = 3,
     vertex.color=ifelse(V(g)$type, adjustcolor('salmon', 0.6),
                         adjustcolor('darkslategray4', 0.8)),
     vertex.frame.color=ifelse(V(g)$type, 'salmon', 'darkslategray4'),
     edge.color = 'black')

mtext('Bipartite graph', side = 1, line = -1.2,
      col = adjustcolor('dodgerblue4', alpha = 0.45), font = 2, cex = 1.1, adj = 0.99, outer = T)

De estos grafos especiales, se pueden derivar grafos \(V_1 - V_1\) o \(V_2 - V_2\). Es decir, grafos de vertices del mismo conjunto cuyas conexiones representan si un actor actuó con otro actor en la misma película por ejemplo o si una película tiene el mismo actor que otra por ejemplo.

11. Sintetizar y explicar el problema de los puentes de Königsberg

El problema de los puentes de Königsberg, también conocido como el problema de los siete puentes, parte de una premisa sencilla:

Dado un sistema de siete puentes que conectan cuatro áreas, ¿es posible cruzar cada puente exactamente una vez visitando todas las áreas?

En particular, si los puentes están organizados de la siguiente manera:

Por más que se intente resolver, la respuesta es simple: no es posible recorrer los siete puentes sin repetir alguno de ellos. Esta conclusión fue alcanzada por Leonhard Euler, quien además sentó las bases de la teoría de grafos como herramienta matemática para resolver problemas como este.

Representación del problema como grafo

Cada isla o área puede representarse como un nodo en un grafo, y cada puente se convierte en una arista entre los nodos. De esta forma, el problema de los puentes de Königsberg se modela como el siguiente grafo:

g = make_empty_graph(n = 4, directed = T)
g = add_edges(graph = g, edges = c(1,2,1,2,1,3,2,
                                    3,2,4,2,4,3,4), 
              directed = T)

layout = matrix(c(0, 1, 
                  -1, 0,
                  1, 0, 
                  0, -1), 
                ncol = 2, byrow = T)
par(mar = c(0,0,2.3,0))
plot.igraph(g, edge.arrow.size = 0,
            layout = layout,
            vertex.color = 'gray', 
            vertex.frame.color = NA, 
            edge.color = 'black',
            vertex.label.color = 'black',
            main = 'El problema de los \n puentes de Königsberg')

Condiciones para un recorrido Euleriano

La tarea consiste en pasar por todas las aristas del grafo exactamente una vez. Hoy en día, este tipo de recorrido se conoce como camino euleriano. Según Euler, solo existen dos escenarios en los que esta tarea es posible:

• Si el grafo tiene exactamente dos nodos con grado impar: El recorrido debe comenzar en uno de los nodos de grado impar y terminar en el otro.

• Si todos los nodos tienen grado par: El recorrido puede comenzar y terminar en el mismo nodo.

Cualquier grafo que cumpla con alguna de estas dos puede ser recorrido por un camino Euleariano.

Aplicación al grafo de Königsberg

El grafo que representa el problema tiene los siguientes grados:

grados = degree(g)

Nodo	Grado
1	3
2	5
3	3
4	3

Es decir, todos los nodos tienen grado impar. Por lo tanto, el grafo no cumple con las condiciones necesarias para un camino Euleriano y no es posible resolver el problema de los puentes de Königsberg.

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

La paradoja de la amistad es un fenómeno en redes sociales que parece contraintuitivo: “En promedio, tus amigos tienen más amigos que tú”. Esta observación, aunque sorprendente, tiene una explicación matemática relacionada con las propiedades de los grafos que representan redes sociales.

Explicación matemtica

En una red social, los nodos representan personas y las aristas representan amistades entre ellas. La paradoja surge porque los nodos con mayor grado (es decir, las personas más populares) tienen más conexiones y, por tanto, son más propensos a aparecer como amigos de otros nodos.

En términos más técnicos:

• Si seleccionamos un nodo al azar y calculamos el grado medio de sus vecinos, este grado medio será mayor que el grado del nodo original.

• Esto ocurre porque los nodos con más conexiones contribuyen más al promedio ponderado del grado de los vecinos.

Ejemplo

Supongamos una pequeña red:

• Persona A tiene 2 amigos (B y C).
• Persona B tiene 4 amigos (A, C, D, E).
• Persona C tiene 3 amigos (A, B, F).

En este caso:

• Grado promedio de A: Los amigos de A (B y C) tienen grados 4 y 3. El promedio es (4 + 3)/2 = 3.5.
• Grado de A: Es 2.

Conclusión: Los amigos de A, en promedio, tienen más amigos que A.

Aplicaciones:

La paradoja de la amistad tiene implicaciones prácticas en estudios de redes:

1. Propagación de información: Las personas con más conexiones (hubs) juegan un papel crucial en la difusión de información o contagios en la red.
2. Percepción social: Puede influir en cómo las personas perciben su popularidad relativa, causando un sesgo en la autoevaluación.
3. Diseño de estrategias: Para intervenciones en redes, como campañas de vacunación o marketing, identificar nodos clave es esencial.

---

El código fuente para cada uno de los puntos está subido en github aquí. Para generar el archivo html debe renderizarse el archivo Taller 1.Rmd con el botón knit o presionando Ctrl + k. Para correr cada punto por separado deben primero en cargarse las librerías que se cargan en el archivo Taller 1.Rmd.