1 Cooperation in the classroom

1.1 Descripción

Este notebook presenta el análsis de las redes de cooperación que se establecen en los cursos como consecuencia de la aplicación de la adaptacón del juego de las fichas. Los objetivos son:

1- Descripción topológica general de la red 2- Análisis de reciprocidad
3- Estudio de formación de la red 4. Aplicación de ERGM

En esta primera instancia, el método se aplica al estudio de un único curso, el 48 con 7 niños.

1.2 Seteo Inicial

Cargo las librerias a usar y los datos.

knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)

rm(list = ls())
library(tidyverse)
library(broom)
library(stargazer)
library(cowplot)
library(lmtest)
library(plm)
library(kableExtra)
library(readr)
library(statnet)
library(ergm)
library(ergm.count)
library(data.table)

Importar datos, sobre los individuos y sobre las diadas.

#datos colegio

Data_diada_Colegios <- read_csv("Data_diada_Colegios.csv")

#Datos diada

Data_indiv_Colegios <- read_csv("Data_indiv_Colegios.csv")
Data_indiv_Colegios$Sexo <- as.factor(Data_indiv_Colegios$Sexo) #corregir que sexo sea un factor

Se extrae de las diadas, la información de las redes por cada curso participante del estudio.

#Crea el edgelist From (emisor)- to(receptor) -weight (Fichas enviadas por el emisor al receptor) - Id_curso 
red<-Data_diada_Colegios %>% 
    mutate(Id_Receptor=as.character(Id_Receptor)) %>%
    select(from=Id_Emisor, to=Id_Receptor, weight, rev_weight,  Id_Curso)%>% 
    group_by(Id_Curso)

1.3 Definción red de envios

Iniciamos con la relación diadica entre el alumno i y j, en el cual el peso \(w_ij\) indica la cantidad de tokens enviados por i a j, esta cantidad puede ser entre 0 y 10. Es apreciable que a nivel de todas las diadas del estudio, se tiene la siguiente distribución de envíos.

hist(red$weight, breaks=0:100, main="Histograma de tokens enviados, Red cooperación en la sala de clase", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(0,10))

Para realizar el análisis topológico trabajaré inicialmente con un único curso, para visualizar y contextualizar el análisis. Luego se elaborarán indicadores globales a nivel de la población completa de cursos que participaron del experimento.

El curso seleccionado es la clase 48 con 7 estudiantes. Se seleccionó dado que es un número pequeño de estudiantes y podrá dar luces para el estudio de clases de mayor y menor tamaño. Para este, se realizará una descripción topológica y se realizarán visualizaciones que permitan describir la dinámica de cooperación que elicita el juego y del cual la red da cuenta.

1.3.1 Definición general de la red e informaicón relevante

#Voy a quedarme con un único curso, el 56 que tiene 15 estudiantes.

red_48<-dplyr::filter(red, Id_Curso==48) %>%
  ungroup

#crearemos la lista de nodos/individuos, que será utilizada.

nodos_48 <- red_48 %>%
  select(id=from) %>%
  distinct(id)

# Creamos un dataframe que tiene únicamente la edgelist de envios, filtrando cuando el envio es 0

edge_48 <- red_48 %>%
  select(from, to, weight) %>%
  filter(weight>0)

# Creamos un dataframe de atributos individuales: sexo, grades, asistencia

atributosi<- Data_indiv_Colegios %>% 
    group_by(Id_Curso) %>%
    select(Id, Sexo, grades, asistencia)

atributosi_48<- dplyr::filter(atributosi, Id_Curso==48) %>%
  ungroup

#creamos un dataframe de atributos del edge - particularmente GAP de notas y relación de amistad

atributose_48<- filter(Data_diada_Colegios, Id_Curso==48) %>%
  select(from=Id_Emisor, to=Id_Receptor, friends4)

Podemos observar el edgelist de envios relevante en la siguiente tabla, que muestra los envios de las diadas:

knitr::kable(edge_48[,1:3]) %>% 
    kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width ="400px" , height = "300px")

from	to	weight
1401	1399	10
1402	1399	3
1404	1399	4
1405	1399	10
1407	1399	3
1408	1399	7
1399	1401	3
1402	1401	3
1404	1401	4
1405	1401	4
1407	1401	4
1408	1401	4
1399	1402	6
1401	1402	2
1404	1402	6
1405	1402	10
1407	1402	3
1408	1402	6
1399	1404	4
1401	1404	4
1402	1404	6
1405	1404	5
1407	1404	4
1408	1404	5
1399	1405	4
1401	1405	4
1402	1405	4
1404	1405	3
1407	1405	2
1408	1405	5
1399	1407	4
1401	1407	6
1402	1407	4
1404	1407	6
1405	1407	9
1408	1407	5
1399	1408	6
1401	1408	5
1402	1408	5
1404	1408	4
1405	1408	5
1407	1408	4

Para esta red, tenemos la siguiente distribucón de envíos:

hist(red_48$weight, breaks=0:10, main="Histograma de tokens enviados, Red cooperación en la sala de clase", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(0,10))

Es apreciable que no existen envios 0, la mayoría de envios fue 4 y existen menos de 5 envios del máximo posibles, 10 tokens. Es anticipable, entonces, que esta sea una red súmamente densa.

Y construimos el objeto de la red de envios.

library(igraph)
red_48_envios <- igraph::graph_from_data_frame(d = edge_48, vertices = nodos_48, directed = TRUE)

2 Descripcion topológica de la red de envios

2.1 Conectividad y densidad

Un primer elemento a analizar corresponde a la densidad de la red de envios, e identificar si existen individuos aislados. Si consideramos el total de envios, es apreciable que esta es una red súmamente densa. La mayoría de niños se envía al menos un token, por lo cual del total posible de vínculos entre nodos, ocurre un 92.29%.

edge_density(red_48_envios, loops=F)

## [1] 1

2.2 Diametro y distancia media

El diametro es una primera aproximación al tamaño de la red y a su conectividad. Este corresponde la mayor distancia geodésica de la red.

diameter(red_48_envios, directed=T, unconnected=FALSE)

## [1] 9

diam <- get_diameter(red_48_envios, directed=T)
diam

## + 3/7 vertices, named, from 5f46a7d:
## [1] 1405 1404 1399

Es apreciable que el diametro de la red es de 9 y contempla a 3/7 de los vértices, a los estudiantes 1405 1404 1399. No es de extrañar que el diametro contemple a tan pocos nodos, ya que la red tiene una alta densidad.

La distancia media, corresponde al promedio de la geodésica entre todos los pares de nodos de la red. En este caso corresponde a 1, es decir que la mayoría de los nodos estan a de 1 geodésica de distancia. Resultado en concordancia con los anteriores.

igraph::average.path.length(red_48_envios, directed=T, unconnected = F)

## [1] 1

2.3 Análisis de Centralidad

Centralidad analiza la “importancia” de os nodos en la red, se puede medir de varias maneras si teine muchas conexiones (grado/degree), es de fácil acceso (closesness) está bien conectado, es popular (eigenvalue) o está en el camino de varias geodésicas (betweeness). En esta sección revisaremos cada una de esas perspectivas y concluiremos con una tabla resumen.

2.3.1 Centralidad de grado (Degree)

Primer elemento describir es el grado de cada nodo y la distribución de estos. El grado del vértice i (\(k_i\)) corresponde al número de nodos con los cuales mantiene un vínculo, es decir:

\[ k_i=\sum_{j\in N} l_i\]

La lógica de la centralidad de grado es que se consiedaraá un nodo central en la red, en la medida de que tiene más vínculos.

centralidad_grado <- igraph::degree(red_48_envios)
centralidad_grado

## 1401 1402 1404 1405 1407 1408 1399 
##   12   12   12   12   12   12   12

En este caso, corresponde al total de links, ya que todos le realizan algun envio a otros. Dado que esta es una red dirigida y con pesos, entonces un indicador que nos permite entenderlo mejor sería el , el y el

2.3.2 In and Out degree

#Incoming degrees:
indeg_48=degree(red_48_envios, mode="in")
indeg_48

## 1401 1402 1404 1405 1407 1408 1399 
##    6    6    6    6    6    6    6

#Outgoing degrees:
outdeg_48=degree(red_48_envios, mode="out")
outdeg_48

## 1401 1402 1404 1405 1407 1408 1399 
##    6    6    6    6    6    6    6

2.3.3 In and outstrengt

strength_48<-strength(red_48_envios)
strength_48

## 1401 1402 1404 1405 1407 1408 1399 
##   53   58   55   65   54   61   64

instrength_48<-strength(red_48_envios, mode="in")
instrength_48

## 1401 1402 1404 1405 1407 1408 1399 
##   22   33   28   22   34   29   37

outstrength_48<-strength(red_48_envios, mode="out")
instrength_48

## 1401 1402 1404 1405 1407 1408 1399 
##   22   33   28   22   34   29   37

deg <- degree(red_48_envios, mode="all")

Usando la información obtenida en el punto anterior, se genera el gráfico de distribución de grado a través de un histograma.

hist(deg, breaks=0:30, main="Histograma de grado, Red cooperación en la sala de clase", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(0,30))

Es decir, cada uno tiene grado igual. Así, que la distribución de grado no es informativa. Podemos hacer, en cambio la distribución del strength, in y out más informativas para una red como la que estamos analizando.

hist(strength_48, breaks=20:70, main="Histograma de strength, Red cooperación en la sala de clase", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(50,70))

hist(instrength_48, breaks=20:70, main="Histograma de outstrength, Red cooperación en la sala de clase", col="light green", xlab="Grado nodo", ylab="Freecuencia", xlim=c(20,70))

hist(outstrength_48, breaks=20:70, main="Histograma de instrength, Red cooperación en la sala de clase", col="red", xlab="Grado nodo", ylab="Freecuencia", xlim=c(20,70))

plot(density(strength_48), xlim=c(0,70), ylim=c(0,0.08), main = "Comparación distribución Strength", ylab = "Densidad")
lines(density(instrength_48), col="red")
lines(density(outstrength_48), col="green")
legend( x="bottomleft",
        legend=c("Strength","instrength","outstrength"),
        col=c("black", "red", "green"), lwd=1, merge=FALSE )

2.3.4 Centralidad de cercanía (closeness)

La centralidad de cercanía, en relación a la distancia a otras en el grafo. Se refiere a la inversa de la distancia geodésica a otros nodos en la red.

centralidad_cercania <- closeness(red_48_envios,normalized=T)
centralidad_cercania

##      1401      1402      1404      1405      1407      1408      1399 
## 0.2307692 0.2400000 0.2222222 0.1538462 0.3000000 0.1875000 0.2222222

2.3.5 Centralidad de Valor propio (Eigenvalue)

Esta centralidad se refiere a la ponderación de la centralidad de los nodos que les rodean. Será más central, en la medida de que está conectado a otros nodos centrales.

# centralidad eigenvalue
centralidad_eigen <- eigen_centrality(red_48_envios)
centralidad_eigen$vector

##      1401      1402      1404      1405      1407      1408      1399 
## 0.8358025 0.9115344 0.8573899 1.0000000 0.8447096 0.9460208 0.9873847

En este caso, tenemos que la gran mayoria tiene una alta centralidad de cercanía.

2.3.6 Centralidad de Intermediación (Betweenness)

Es una medida de centralidad basada en la psoición de Broker o intermediador. Se identifica por el número de geodésicas que pasan por el nodo o vértice. En este caso, ningun nodo tiene un rol especial de intermediación (Un resultado algo extraño, tal vez consecuencia de el bajo diametro y alta densidad de la red).

centralidad_intermediacion <- betweenness(red_48_envios, normalized = T)
centralidad_intermediacion

##       1401       1402       1404       1405       1407       1408       1399 
## 0.11666667 0.06666667 0.01666667 0.00000000 0.00000000 0.00000000 0.00000000

2.3.7 Cuadro resumen de centralidades

De los cálculos anteriores, se elabora la siguiente tabla resumen:

centralidades <- cbind(centralidad_grado,
                       centralidad_cercania,
                       centralidad_eigen$vector,
                       centralidad_intermediacion,
                       strength_48,
                       outstrength_48,
                       instrength_48) 
colnames(centralidades) <- c("grado", "cercania", "eigen", "intermediacion", "strength", "outstrength", "instrength")
centralidades

##      grado  cercania     eigen intermediacion strength outstrength instrength
## 1401    12 0.2307692 0.8358025     0.11666667       53          31         22
## 1402    12 0.2400000 0.9115344     0.06666667       58          25         33
## 1404    12 0.2222222 0.8573899     0.01666667       55          27         28
## 1405    12 0.1538462 1.0000000     0.00000000       65          43         22
## 1407    12 0.3000000 0.8447096     0.00000000       54          20         34
## 1408    12 0.1875000 0.9460208     0.00000000       61          32         29
## 1399    12 0.2222222 0.9873847     0.00000000       64          27         37

2.4 Popularidad - Page Rank

Para una red como la descrita, tal vez una forma más apropiada de medir centralidad o importancia en la red es a través del pagerank. Esta medida

Bruch and Newman (2018), propose to use Page-Rank of recieved messages in an online dating site as an alternative to measure social rank , representing a hierarchy of desirability. Following this idea we use page-rank of received tokens, as a mesure of recipient of deference by others, a mesure of status in the classroom.

#PageRank:
pr_48 <-page.rank(red_48_envios,directed=T)$vector
## Note that page.rank function returns a vector of values, an eigenvalue and computational options. We only need a vector here. The same concerns hub and authority scores.
pr_48

##      1401      1402      1404      1405      1407      1408      1399 
## 0.1213855 0.1525986 0.1435980 0.1219020 0.1509750 0.1499532 0.1595876

2.5 Hubs y authority

#Hubs:
hPB=hub.score(red_48_envios)$vector

#Authorities:
authPB=authority.score(red_48_envios)$vector

op <- par(mfrow = c(2, 3))
plot(pr_48, hPB, xlab="PageRank", ylab="Hubs", col="blue")
plot(pr_48, authPB, xlab="PageRank", ylab="Authorities", col="blue")
plot(hPB, authPB, xlab="Hubs", ylab="Authorities", col="blue")
plot(indeg_48, outdeg_48, xlab="In- degree", ylab="Out- degree", col="blue")
plot(indeg_48, authPB, xlab="In- degree", ylab="Authorities", col="blue")
plot(outdeg_48, hPB, xlab="Out- degree", ylab="Hubs", col="blue")

2.6 Triadas y transitividad

Podemos revisar de tipo de relacion existe entre todas las posibles triadas del grafo, usando la clasificación https://igraph.org/r/doc/triad_census.html. Cabe destacar que este análisis es especialmente interesante para grafos direccionados.

igraph::triad_census(red_48_envios)

##  [1]  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0 35

motifs(red_48_envios, 3)

##  [1] NA NA  0 NA  0  0  0  0  0  0  0  0  0  0  0 35

transitivity(red_48_envios, type="global")

## [1] 1

transitivity(red_48_envios, type="local")

## [1] 0.2272727 0.2272727 0.2272727 0.2272727 0.2272727 0.2272727 0.2272727

Vemos que nuevamente no es una herramienta informativa para una red tan densa como la de envíos, ya que reconoce todas las triadas posibles como realizadas. Una alternativa es trabajar con una subred, como la de reciprocidad o sub y sobre envios que se trabajan en las secciones posteriores.

3 Visualizaciones

En esta sección se realizan algunas visualizaciones para al red de envíos.

3.1 Visualización general de la red de envios

Visualización tradicional, no entrega mayor información más que casi todos se realizan envios.

##Usando tidygraph y ggraph (vienen del tidyverse)

library(tidygraph)
library(ggraph)

Una red complementaria el la de amistad.

friends_network<-Data_diada_Colegios %>% 
    mutate(Id_Receptor=as.character(Id_Receptor)) %>%
    select(from=Id_Emisor, to=Id_Receptor, friends2, Id_Curso)%>%
    ungroup


friends_48<- filter(friends_network, Id_Curso==48)%>%
  ungroup %>%
  filter(friends2==1)  %>%
  select(from, to)

gtidy_48<- as_tbl_graph(red_48_envios)

plot(red_48_envios, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

red_48_friends <- igraph::graph_from_data_frame(d = friends_48, vertices = nodos_48, directed = TRUE)

plot(red_48_friends, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

Visualización de red de envios, directamente, solo mostrando las fichas enviadas y recibidas.

ggraph(gtidy_48, layout = "linear") + 
   geom_edge_arc( aes(width = weight), alpha = 0.9) + 
  scale_edge_width(range = c(0.1, 3)) +
  labs(edge_width = "Tokens") +
  geom_node_point(size = 15)+
  geom_node_text(aes(label = nodos_48$id), color="white") +
  theme_graph()

Podriemaos agregar alguna información sobre los nodos y sobre los edges. De los nodos agregaremos como color el sexo y de los edges como color el tipo de amistad, y como tamaño de los nodos el pagerank.

ggraph(gtidy_48, layout = "linear") + 
  geom_edge_arc(aes(width = weight, color=atributose_48$friends4), alpha = 0.9) + 
  scale_edge_width(range = c(0.5, 3.5)) +
  geom_node_point( aes(colour=atributosi_48$Sexo), size=(pr_48*18)^(3))+
  geom_node_text(aes(label = nodos_48$id), color="white") +
  labs(edge_width = "Sent tokens", edge_color="Declared friendship") +
  scale_color_manual(name = "Gender", labels = c("Female", "Male"), values = c("hotpink3", "steelblue2")) + 
  guides(color = guide_legend(order=1, direction="vertical")) +
  theme_graph()

3.2 Visualizaciones cooperación mínima

Un primer elemento para entender la red de cooperación puede ser estudiando que relaciones se acercan al máximo teórico del juego, es decir que ambos se envíen todos los tokens.

Definiremos la red de aporte mínimo, dejando únicamente los nodos que tengan un valor mayor o igual a cierta cantidad de tokens.

sent_48_3 <-edge_48 %>%
  filter(weight>=3)

sent_48_3<-igraph::graph_from_data_frame(sent_48_3, directed=T)

plot(sent_48_3, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_4 <-edge_48 %>%
  filter(weight>=4)

sent_48_4<-igraph::graph_from_data_frame(sent_48_4, directed=T)


plot(sent_48_4, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_5 <-edge_48 %>%
  filter(weight>=5)

sent_48_5<-igraph::graph_from_data_frame(sent_48_5, directed=T)


plot(sent_48_5, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_6 <-edge_48 %>%
  filter(weight>=6)

sent_48_6<-igraph::graph_from_data_frame(sent_48_6, directed=T)


plot(sent_48_6, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_7 <-edge_48 %>%
  filter(weight>=7)

sent_48_7<-igraph::graph_from_data_frame(sent_48_7, directed=T)


plot(sent_48_7, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_8 <-edge_48 %>%
  filter(weight>=8)

sent_48_8<-igraph::graph_from_data_frame(sent_48_8, directed=T)


plot(sent_48_8, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_9 <-edge_48 %>%
  filter(weight>=9)

sent_48_9<-igraph::graph_from_data_frame(sent_48_9, directed=T)


plot(sent_48_8, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

sent_48_10 <-edge_48 %>%
  filter(weight>=10)

sent_48_10<-igraph::graph_from_data_frame(sent_48_10, directed=T)


plot(sent_48_10, edge.arrow.size=0.5, vertex.label.cex=0.8, vertex.size=30, layout=layout_in_circle)

4 Análisis de reciprocidad y descomposición de la red de envios

Iniciamos con la relación diadica entre el alumno i y j, en el cual el peso w_ij indica la cantidad de tokens enviados por i a j, esta cantidad puede ser entre 0 y 10.

Al ser esta una red dirigida con pesos, en la que el elemento es la reciprocidad en la cooperacion, resulta poco informativo…

Siguiendo el trabajo de Squartini et al. (2013), proponen descomponer la relacion diadica entre…

Entonces, definiremos 3 redes derivadas de esta que nos indica diferenet informacion: La red de sobreflujo de envio, la red de sobre flujo de recepcion, la red reciproca y la red de reciprocó.

Acorde a Squartini et al. (2013), en el caso de redes con pesos y dirigidas medir reciprocidad reprsenta cvarios desafíos, en los cuales las medidas que se usan en redes no dirigidas y/o redes sin pesos no representan la realidad de la población.

Los autores proponen un set de medidas a nivel de diada, nodo y red, tal que cumplan 3 criterios: 1. Si se aplica a un red binaria (sin pesos), deben reducir a su contraparte sin pesos. 2. Debe permitir análisis consisten en todos los niveles estructurales (diada, vértice y red) 3. Debe tener un comportamiento matemático controlado bajo modelos nulos con diferentes controles, separando reciprocidad de otras fuentes de (a)simetría.

Medidas a nivel de diada:

Dada una matriz de adjacencies, dado el peso \(w_{ji}\) del vértice i a j: - 0 indica ausencia de relación y de reciprocidad. - Es posible descomponer cada par \((w_{ij}, w_{ji})\) de links recíprocos en una relación bidireccional completamente recíproca (fully reciprocate) más una interacción unidireccional (no reciprocada).

squarini1

Formalmente se define el:

reciprocated weight: \[w_{ij}^\longleftrightarrow=min[w_{ij},w_{ji}, w_{ji}]^\longleftrightarrow \]
Non .reciprocated weight (parte asimétrica): \[w_{ij}^\rightarrow=w_{ij}- w_{ij}^\longleftrightarrow \] y \[w_{ji}^\rightarrow=w_{ji}- w_{ij}^\longleftrightarrow \]

Por lo cuan cualquier díada se puede descomponer en esos tres componentes.

Hacemos los calulos de reciprocidad, sobre y sub envios

red_48 <- red_48 %>%
  rowwise()  %>%
  mutate (rec = min(weight, rev_weight)) %>%
  mutate (sobre_envio=weight-rec) %>%
  mutate (sub_envio=rev_weight-rec)

4.1 Reciprocidad

red_48_rec <- red_48 %>%
  select(from, to, rec) %>%
  filter(rec>0)

Red de reciprocadas

ggraph(red_48_rec, layout = "linear") + 
   geom_edge_arc( aes(width = rec), alpha = 0.9) + 
  scale_edge_width(range = c(0.1, 3)) +
  labs(edge_width = "Recirpocated Tokens") +
  geom_node_point(size = 15)+
  geom_node_text(aes(label = nodos_48$id), color="white") +
  theme_graph()

4.2 RED de sobre envios

red_48_sob <- red_48 %>%
  select(from, to, sobre_envio) %>%
  filter(sobre_envio!=0)

Red de reciprocadas

ggraph(red_48_sob, layout = "linear") + 
   geom_edge_arc( aes(width = sobre_envio), alpha = 0.9) + 
  scale_edge_width(range = c(0.1, 3)) +
  labs(edge_width = "Overflow Tokens") +
  geom_node_point(size = 15)+
  geom_node_text(aes(label = nodos_48$id), color="white") +
  theme_graph()

4.3 Red sub envios

red_48_sub <- red_48 %>%
  select(from, to, sub_envio) %>%
  filter(sub_envio>0)

Red de reciprocadas

ggraph(red_48_sub, layout = "linear") + 
   geom_edge_arc( aes(width = sub_envio), alpha = 0.9) + 
  scale_edge_width(range = c(0.1, 3)) +
  labs(edge_width = "Underflow Tokens") +
  geom_node_point(size = 15)+
  geom_node_text(aes(label = nodos_48$id), color="white") +
  theme_graph()

4.3.1 Visualizaciones de reciprocidad mínima

red_48 <- red_48 %>%
  rowwise()  %>%
  mutate (coop3=ifelse(rec>=3,1,0)) %>%
  mutate (coop4=ifelse(rec>=4,1,0)) %>%
  mutate (coop5=ifelse(rec>=5,1,0)) %>%
  mutate (coop6=ifelse(rec>=6,1,0)) %>%
  mutate (coop7=ifelse(rec>=7,1,0)) %>%
  mutate (coop8=ifelse(rec>=8,1,0)) %>%
  mutate (coop9=ifelse(rec>=9,1,0)) %>%
  mutate (coop10=ifelse(rec>=10,1,0))

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios

red48_sobre_envio<- red_48 %>% 
  select(from, to, sobre_envio, Id_Curso)%>%
  filter(sobre_envio>0)


grafo_48_sobre_envio<-igraph::graph_from_data_frame(red48_sobre_envio, directed=T)


plot(grafo_48_sobre_envio, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_sub_envio<- red_48 %>% 
  select(from, to, sub_envio, Id_Curso)%>%
  filter(sub_envio>0)
  

grafo_48_sub_envio<-igraph::graph_from_data_frame(red48_sub_envio, directed=T)

plot(grafo_48_sub_envio, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop3<- red_48 %>% 
  select(from, to, coop3)%>%
  filter(coop3>0)
  

grafo_48_coop3<-igraph::graph_from_data_frame(red48_coop3, directed=T)

plot(grafo_48_coop3, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop4<- red_48 %>% 
  select(from, to, coop4, Id_Curso)%>%
  filter(coop4>0)
  

grafo_48_coop4<-igraph::graph_from_data_frame(red48_coop4, directed=T)

plot(grafo_48_coop4, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop5<- red_48 %>% 
  select(from, to, coop5, Id_Curso)%>%
  filter(coop5>0)
  

grafo_48_coop5<-igraph::graph_from_data_frame(red48_coop5, directed=T)

plot(grafo_48_coop5, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop6<- red_48 %>% 
  select(from, to, coop6, Id_Curso)%>%
  filter(coop6>0)
  

grafo_48_coop6<-igraph::graph_from_data_frame(red48_coop6, directed=T)

plot(grafo_48_coop6, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30, layout=layout_in_circle)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop7<- red_48 %>% 
  select(from, to, coop7, Id_Curso)%>%
  filter(coop7>0)
  

grafo_48_coop7<-igraph::graph_from_data_frame(red48_coop6, directed=T)

plot(grafo_48_coop7, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30)

# graph_from_data_frame: crea grafo con la edgelist de total de sobre envios


red48_coop10<- red_48 %>% 
  select(from, to, coop10, Id_Curso)%>%
  filter(coop10>0)
  

grafo_48_coop10<-igraph::graph_from_data_frame(red48_coop6, directed=T)

plot(grafo_48_coop10, edge.arrow.size=0.5, vertex.label.cex=0.5, vertex.size=30)

4.4 Medidas de vertices

Usando estas medidas diadicas se definen medidas agregadas a nivel de vértice.

Recordamos la defunción de out e in strength del vértice i como la suma de los link que salen y llegan de este, respectivamente

\[ s_i^{out}=\sum_{j\neq i} w_{ij} \qquad s_i^{in}=\sum_{j\neq i} w_{ij}\]

Los autores proponen las medias de reciprocated strength:

\[ s_i^\longleftrightarrow \equiv \sum_{j\neq i} w_{ij}^\longleftrightarrow \]

Que es el overlap entre el in strength y el outstrent del vértice i. Y también definen la porción n reciprocada como:

\[ s_i^\rightarrow \equiv \sum_{j\neq i} w_{ij}^\rightarrow = s_i^{out}-s_i^\longleftrightarrow \]

y la no reciprocada e in-strength como:

\[ s_i^\leftarrow \equiv \sum_{j\neq i} w_{ij}^\leftarrow = s_i^{in}-s_i^\longleftrightarrow \]

Que representa los flujos salientes y entrantes que exceden a lo contribuidos por sus vecinos en la red.

A nivel de la red completa

Usualmente:

\[ W \equiv \sum_{i}\sum_{j\neq i} w_{ij} = s_i^{out}=s_i^{in} \]

De manera similar, denotamos que el peso total reciprocado (total reciprocated weight) como:

\[ W^{\leftrightarrow} \equiv \sum_{i}\sum_{j\neq i} w_{ij}{\leftrightarrow} = s_i^{\leftrightarrow} \]

Extendiendo una definición comunmente usada por graficos binarios, es posible definir la reciprocidad con peso de la red (weighted reciprocity) como:

\[ r \equiv \displaystyle{\frac{W^{\leftrightarrow}}{W}}\]

Si todos los flujos son perfectamente reciprocados (\[ W^{\leftrightarrow}=W\]), entonces \[r=1\] y si hay ausencia completa de reciprocidad (\[ W^{\leftrightarrow}=0\]), entonces \[r=0\] .

Al comparar con modelo nulo:

Se ha resuelto al introducir una cantidad transformada que permite generalizar el setting presentado:

\[ \rho_{NM} \equiv \displaystyle{\frac{r-(r)_{NM}}{1-(r)_{NM}}}\]

El signo de \[ \rho_{NM} \] es informativo directamente de un incremento, en relación al modelo nulo de la tendencia de reciprocar (\[ \rho_{NM} >0\]) o evitar reciprocar (\[ \rho_{NM} <0\]). Si \[ \rho_{NM} \] es consistente con zero (dentro del error estadístico que se cuantifica en el SI), entonces el nivel observado de reciprocidad es compatible con el que esperariemos puramente por una relacion aleatoria en el modelo nulo.

5 Formación de la red

En esta sección, simulamos la red usando los 3 procesos: Erdös-Renyi, Strogatz-Watts o Barabasi-Albert, para cada una lo graficaremos y extraeremos medidas de distancia promedio y clustering, para compara con la red observada.

Obtenemos primero una red generada con un proceso aleatorio de Erdos-Renyi, con atributos similares a nuestra red.

# erdos.renyi.game(n, p.or.m, type = c("gnp", "gnm"), directed = FALSE, loops = FALSE, ...)
# n: The number of vertices in the graph.
# p.or.m: Either the probability for drawing an edge between two arbitrary vertices (G(n,p) graph), or the number of edges in the graph (for G(n,m) graphs).
# type: The type of the random graph to create, either gnp (G(n,p) graph) or gnm (G(n,m) graph).
# directed: Logical, whether the graph will be directed, defaults to FALSE.
# loops: Logical, whether to add loop edges, defaults to FALSE.

size <- length(V(red_48_envios))
dens <- graph.density(red_48_envios) # probabilidad de un link
er <- erdos.renyi.game(size, dens) # gnp
er.grado <- degree(er)

plot(er, 
     main="Red Simulada - Erdos-Renyi", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(er, circular=T),
     edge.color="grey",
     edge.width=E(er)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=er.grado/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

er.distancia <- round(mean_distance(er),3)
er.clustering <- round(transitivity(er, type="global"),3)

En segundo lugar, obtenemos la red generada por un porceso de Mundos Pequeños, de Strogatz-Watts que simula atributos de la red de envíos

# sample_smallworld(dim, size, nei, p, loops = FALSE, multiple = FALSE)
# dim: Integer constant, the dimension of the starting lattice.
# size: Integer constant, the size of the lattice along each dimension.
# nei: Integer constant, the neighborhood within which the vertices of the lattice will be connected.
# p: Real constant between zero and one, the rewiring probability.
# loops: Logical scalar, whether loops edges are allowed in the generated graph.
# multiple: Logical scalar, whether multiple edges are allowed int the generated graph.

sm <- watts.strogatz.game(1,size,3,0.1) # estoy asumiendo vecindarios de 3 nodos y rewiring de 0.1 (se puede mejorar la precisión)
sm.grado <- degree(sm)
plot(sm, 
     main="Red Simulada - Strogatz-Watts", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(sm, circular=T),
     edge.color="grey",
     edge.width=E(sm)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=sm.grado/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

sm.distancia <- round(mean_distance(sm),3)
sm.clustering <- round(transitivity(sm, type="global"),3)

En tercer lugar, simulamos la red con un proceso que sigue Preferential Attachement, propuesta por Barabasi.

# sample_pa(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL,
#      out.pref = FALSE, zero.appeal = 1, directed = TRUE,
#      algorithm = c("psumtree", "psumtree-multiple", "bag"),
#      start.graph = NULL)
# n; Number of vertices.
# power: The power of the preferential attachment, the default is one, ie. linear
# m: Numeric constant, the number of edges to add in each time step.
# out.dist: Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the out.seq argument is omitted or NULL.
# out.seq: Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.
# out.pref: Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.
# zero.appeal: The 'attractiveness' of the vertices with no adjacent edges. See details below.
# directed: Whether to create a directed graph.
# algorithm: The algorithm to use for the graph generation.
# start.graph: ... If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. 

red.pa <- barabasi.game(size,power=1, m=2, directed=F, algorithm="psumtree") 
degree.red <- degree(red.pa)
l <- layout.reingold.tilford(red.pa, circular=T)
plot(red.pa, 
     main="Red Simulada- Barabasi-Albert", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(red.pa, circular=T),
     edge.color="grey",
     edge.width=E(red.pa)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=degree.red/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

red.pa.distancia <- round(mean_distance(red.pa),3)
red.pa.clustering <- round(transitivity(red.pa, type="global"),3)

Para comprarar la red observada y las simuladas, elaboramos la siguiente tabla resumen:

Es apreciable que tanto la red de Erdos como la de Preferencial Attachemente se parecen a nuestra red. Principalmente,porque la consideran coo si no fuera una red con pesos. Este elemento se debería revisar con más detenimiento para ver la herramienta más adecuada.

6 ERGM

Se usa el modelamiento por Expected Random Graph Model (ERGM) para analizar la plausibilidad de las hipótesis propuestas incialmente, de que el gñenero de los individuos, sus notas así como su condición de amistad estaría afectando la formación de la red.

Inicialmente, estudiamos el que contiene únicamente los edges.

red <- intergraph::asNetwork(red_48_envios)

modelo1 <- ergm(red ~ edges)
summary(modelo1)

## 
## ==========================
## Summary of model fit
## ==========================
## 
## Formula:   red ~ edges
## 
## Iterations:  0 out of 20 
## 
## Monte Carlo MLE Results:
##      Estimate Std. Error MCMC % z value Pr(>|z|)    
## [1,]      Inf          0      0     Inf   <1e-04 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Log-likelihood was not estimated for this fit.
## To get deviances, AIC, and/or BIC from fit `modelo1` run 
##   > modelo1<-logLik(modelo1, add=TRUE)
## to add it to the object or rerun this function with eval.loglik=TRUE.
## 
##  Warning: The following terms have infinite coefficient estimates:
##   1

modelo1$coef

## [1] Inf

Es apreciable que ocurre un error, esto porque el paquete ERGM no está pensado para redes con pesos. Se procede a usar el paquete ERGM.COUNT, que implementa medidas de referencia para las diadas siguiendo distribuciones Poisson, binomial, geometrica y uniforme discreta.

NOTA: no logré hacer ndar el modelo. Se va a hace una alternativa discreta.

Usaremos la red en la que al menos se envían 5 tokens.

red <- intergraph::asNetwork(sent_48_5)

modelo1<-ergm(red ~ edges)
summary(modelo1)

## 
## ==========================
## Summary of model fit
## ==========================
## 
## Formula:   red ~ edges
## 
## Iterations:  3 out of 20 
## 
## Monte Carlo MLE Results:
##       Estimate Std. Error MCMC % z value Pr(>|z|)
## edges  -0.1911     0.3100      0  -0.616    0.538
## 
##      Null Deviance: 58.22  on 42  degrees of freedom
##  Residual Deviance: 57.84  on 41  degrees of freedom
##  
## AIC: 59.84    BIC: 61.58    (Smaller is better.)

modelo1$coef

##      edges 
## -0.1910552

Se proponen dos modelos adicionales, incorporando las notas y si son amigos.

kable(red_48)

from	to	weight	rev_weight	Id_Curso	rec	sobre_envio	sub_envio	coop3	coop4	coop5	coop6
1401	1399	10	3	48	3	7	0	1	0	0	0
1402	1399	3	6	48	3	0	3	1	0	0	0
1404	1399	4	4	48	4	0	0	1	1	0	0
1405	1399	10	4	48	4	6	0	1	1	0	0
1407	1399	3	4	48	3	0	1	1	0	0	0
1408	1399	7	6	48	6	1	0	1	1	1	1
1399	1401	3	10	48	3	0	7	1	0	0	0
1402	1401	3	2	48	2	1	0	0	0	0	0
1404	1401	4	4	48	4	0	0	1	1	0	0
1405	1401	4	4	48	4	0	0	1	1	0	0
1407	1401	4	6	48	4	0	2	1	1	0	0
1408	1401	4	5	48	4	0	1	1	1	0	0
1399	1402	6	3	48	3	3	0	1	0	0	0
1401	1402	2	3	48	2	0	1	0	0	0	0
1404	1402	6	6	48	6	0	0	1	1	1	1
1405	1402	10	4	48	4	6	0	1	1	0	0
1407	1402	3	4	48	3	0	1	1	0	0	0
1408	1402	6	5	48	5	1	0	1	1	1	0
1399	1404	4	4	48	4	0	0	1	1	0	0
1401	1404	4	4	48	4	0	0	1	1	0	0
1402	1404	6	6	48	6	0	0	1	1	1	1
1405	1404	5	3	48	3	2	0	1	0	0	0
1407	1404	4	6	48	4	0	2	1	1	0	0
1408	1404	5	4	48	4	1	0	1	1	0	0
1399	1405	4	10	48	4	0	6	1	1	0	0
1401	1405	4	4	48	4	0	0	1	1	0	0
1402	1405	4	10	48	4	0	6	1	1	0	0
1404	1405	3	5	48	3	0	2	1	0	0	0
1407	1405	2	9	48	2	0	7	0	0	0	0
1408	1405	5	5	48	5	0	0	1	1	1	0
1399	1407	4	3	48	3	1	0	1	0	0	0
1401	1407	6	4	48	4	2	0	1	1	0	0
1402	1407	4	3	48	3	1	0	1	0	0	0
1404	1407	6	4	48	4	2	0	1	1	0	0
1405	1407	9	2	48	2	7	0	0	0	0	0
1408	1407	5	4	48	4	1	0	1	1	0	0
1399	1408	6	7	48	6	0	1	1	1	1	1
1401	1408	5	4	48	4	1	0	1	1	0	0
1402	1408	5	6	48	5	0	1	1	1	1	0
1404	1408	4	5	48	4	0	1	1	1	0	0
1405	1408	5	5	48	5	0	0	1	1	1	0
1407	1408	4	5	48	4	0	1	1	1	0	0

Trabajo de Redes - Notebook complementario

Melanie O

1 Cooperation in the classroom

1.1 Descripción

1.2 Seteo Inicial

1.3 Definción red de envios

1.3.1 Definición general de la red e informaicón relevante

2 Descripcion topológica de la red de envios

2.1 Conectividad y densidad

2.2 Diametro y distancia media

2.3 Análisis de Centralidad

2.3.1 Centralidad de grado (Degree)

2.3.2 In and Out degree

2.3.3 In and outstrengt

2.3.4 Centralidad de cercanía (closeness)

2.3.5 Centralidad de Valor propio (Eigenvalue)

2.3.6 Centralidad de Intermediación (Betweenness)

2.3.7 Cuadro resumen de centralidades

2.4 Popularidad - Page Rank

2.5 Hubs y authority

2.6 Triadas y transitividad

3 Visualizaciones

3.1 Visualización general de la red de envios

3.2 Visualizaciones cooperación mínima

4 Análisis de reciprocidad y descomposición de la red de envios

4.1 Reciprocidad

4.2 RED de sobre envios

4.3 Red sub envios

4.3.1 Visualizaciones de reciprocidad mínima

4.4 Medidas de vertices

5 Formación de la red

6 ERGM