Null Model - School Hierachy

We realize a re-wiring pf the school cooperation game. This rewiring is based on a permutation approach.

Due features ofthe network: - Complete (0 holds meaning) - Weighted - Directed

I use different two types of randomization:

1. preserving sendings/recieved and shuffling them. It preserverves out-strength/ in-strength and tokens frequency
2. Re-sampling sendings/recieved/both from a normal distribution based on each individual mean and sd of sent/recieved/both tokens. It preserves out-strength/ in-strength/both.

Opening data:

rm(list = ls())
library(igraph)

Attaching package: ‘igraph’

The following objects are masked from ‘package:stats’:

    decompose, spectrum

The following object is masked from ‘package:base’:

    union

library(tidyverse)

Registered S3 method overwritten by 'dplyr':
  method           from
  print.rowwise_df     
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ───────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
✓ ggplot2 3.3.0     ✓ purrr   0.3.3
✓ tibble  3.0.0     ✓ dplyr   0.8.5
✓ tidyr   1.0.2     ✓ stringr 1.4.0
✓ readr   1.3.1     ✓ forcats 0.5.0
── Conflicts ──────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::as_data_frame() masks tibble::as_data_frame(), igraph::as_data_frame()
x purrr::compose()       masks igraph::compose()
x tidyr::crossing()      masks igraph::crossing()
x dplyr::filter()        masks stats::filter()
x dplyr::groups()        masks igraph::groups()
x dplyr::lag()           masks stats::lag()
x purrr::simplify()      masks igraph::simplify()

library(ggnetwork)

#Datos diada

Data_diada_Colegios <- read_csv("~/Dropbox/Asuntos UDD/Research-UDD/Capybara/1- Jerarquias escolares/Analisis jerarquias en r/Data_diada_Colegios.csv")

#datos colegio
Data_indiv_Colegios <- read_csv("~/Dropbox/Asuntos UDD/Research-UDD/Capybara/1- Jerarquias escolares/Analisis jerarquias en r/Data_indiv_Colegios.csv")

Network configuration

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

One class example

Initially, I use one small class (class 48, n=7) to illustrate the algorithms and results. The following section I extend it to the whole sample.

Creamos una red de los atributos principales del nodo (genero, grades, etc)

To construct any measure, this approach is based on the adjacency matrix. La matriz de adjacencias se construye en base a la lista de vínculos, donde cada celda indica los envios del alumno i (fila) al j(columna).

Re armamos el in, out y total strengt con la matriz de adyacencia, voy simplemente a crear una copia (como data frame) y a sumar horizontal y verticalmente.

La suma horizontal es el oustrenght y la verical el instrenght.

Trabajo con matriz de adyacencia

Ahora vamos a reconstruir el in y out strenght desde la matriz de adyacencia y en base a esta hacer algunas randomizaciones.

La matriz de adjacencias se construye en base a la lista de vínculos, donde cada celda indica los envios del alumno i (fila) al j(columna).

graph_48<-igraph::graph_from_data_frame(edge_48, directed=TRUE, vertices = nodos_48)

matrix_A48 <- igraph::as_adjacency_matrix(graph_48,type="both",names=TRUE,sparse=FALSE, attr="weight");

print(matrix_A48)

     1401 1402 1404 1405 1407 1408 1399
1401    0    2    4    4    6    5   10
1402    3    0    6    4    4    5    3
1404    4    6    0    3    6    4    4
1405    4   10    5    0    9    5   10
1407    4    3    4    2    0    4    3
1408    4    6    5    5    5    0    7
1399    3    6    4    4    4    6    0

Re armamos el in, out y total strengt con la matriz de adyacencia, voy simplemente a crear una copia (como data frame) y a sumar horizontal y verticalmente.

La suma horizontal es el oustrenght y la verical el instrenght.

matrix_A48b <- as.data.frame(matrix_A48) 

matrix_A48b$outstrenght = rowSums(matrix_A48)

library(dplyr)

col_sum48 = as.data.frame(colSums(matrix_A48))
col_sum48

NA

matrix_A48b <- merge(matrix_A48b, col_sum48, by="row.names") 
matrix_A48b

matrix_A48b %>% rename(id="Row.names", instrength="colSums(matrix_A48)")

NA

Rewired by shufling

Shuffling sendings: Row-wise randomization

This randomization preserves sendings frecuency and outstrenght. It can be interpreted as a generosity/trust/cooperation disposition from the i kid.

Vamos a realizar el siguiente algoritmo para randomizar las filas y evadir los selfloops, trabajando con vectores usando un enforque de permutación.

One adjacency matrix

1. para cada fila, extraigo la lista de elementos sin incluir la diagonal. (elementos a la izquierda y a la derecha)

2. reordeno los elementos de la lista aleatoriamente

3. se agregan a una matriz de la randomización

F=as.vector(as.matrix(nodos_48[,1]))
x=dim(nodos_48)[1]
  
for (i in 1:x) {
  
#1. seleccionar la i fila en la matriz
  f = as.vector(matrix_A48[i,])
  
#2. sacar el 0 corresponduente en i
  f = f[-c(i)]

#3. mezcla aleatoria de los elementos restantes
  set.seed(5) 
  f = sample(f,replace= FALSE)

#4. agregar el cero en i

  f = append(f, 0, after=i-1)

#5. agregar a la matriz aleatoria usando rbind?

  F=rbind(F, f)
}

F=F[2:8,]
colnames(F) <- as.vector(as.matrix(nodos_48[,1]))
rownames(F) <- as.vector(as.matrix(nodos_48[,1]))

F

     1401 1402 1404 1405 1407 1408 1399
1401    0    4    4    2    5    6   10
1402    6    0    4    3    5    4    3
1404    6    3    0    4    4    6    4
1405   10    5    4    0    5    9   10
1407    3    4    4    4    0    2    3
1408    6    5    4    5    5    0    7
1399    6    4    3    4    4    6    0

matrix_A48

     1401 1402 1404 1405 1407 1408 1399
1401    0    2    4    4    6    5   10
1402    3    0    6    4    4    5    3
1404    4    6    0    3    6    4    4
1405    4   10    5    0    9    5   10
1407    4    3    4    2    0    4    3
1408    4    6    5    5    5    0    7
1399    3    6    4    4    4    6    0

 rowSums(F)

1401 1402 1404 1405 1407 1408 1399 
  31   25   27   43   20   32   27 

rowSums(matrix_A48)

1401 1402 1404 1405 1407 1408 1399 
  31   25   27   43   20   32   27 

 colSums(F)

1401 1402 1404 1405 1407 1408 1399 
  37   25   23   22   28   33   37 

colSums(matrix_A48)

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

n simulated adjacency 3-d array

Rewired by sampling

Sampling sendings: Row-wise randomization

Vamos a realizar el siguiente algoritmo para randomizar las filas y evadir los selfloops, trabajando con vectores.

1. para cada fila, extraigo la lista de elementos sin incluir la diagonal. (elementos a la izquierda y a la derecha)

2. reordeno los elementos de la lista aleatoriamente

3. se agregan a una matriz de la randomización

4. la matriz de randomización se agrega a un array 3-d

One adjacency matrix

matrix_A48

     1401 1402 1404 1405 1407 1408 1399
1401    0    2    4    4    6    5   10
1402    3    0    6    4    4    5    3
1404    4    6    0    3    6    4    4
1405    4   10    5    0    9    5   10
1407    4    3    4    2    0    4    3
1408    4    6    5    5    5    0    7
1399    3    6    4    4    4    6    0

f = as.vector(matrix_A48[1,])
f = as.vector(f[-c(1)])
f

[1]  2  4  4  6  5 10

typeof(f)

[1] "double"

mean(matrix_A48)

[1] 4.183673

length(f)

[1] 6

sd(f)

[1] 2.71416

try <- floor(rnorm(length(f), mean(f), sd(f) ))

try

[1] 5 9 3 3 3 4

pos <- function(vec) all(vec >= 0 & vec <= 9 & vec%%1==0)

pos(try)

[1] TRUE

Dist normal

sumas = rowSums(matrix_A48)
  F=as.vector(as.matrix(nodos_48[,1]))
  x=dim(nodos_48)[1]

for (i in 1:x){
  
  
  #2. Extraer el vector de la matriz de ayacencia y scarle el 0
  
  fila = as.vector(matrix_A48[i,])
  
#3. sacar el 0 corresponduente en i
  fila = fila[-c(i)]

  #4. crear el vector aleatorio, que preserve la suma deseada
    s=0

    while (s!=sumas[i]) { #trabaja dentro del vector, crea uno aleatorio no negativo que de la suma iterativamente
      #vector <- floor(runif(6, min=0, max=11)) #uniforme para asgurarme que corre
      vector <-floor(rnorm(length(fila), mean(fila), sd(fila) ))
      #ARREGLAR EL TRUNCAMIENTO
      s <- sum(vector) 
    }

  #5. agregar el cero en i al vector

    f = append(vector, 0, after=i-1)
  
  #6. agregar a la matriz aleatoria usando rbind

  
    F=rbind(F, f)  
  
}

  #5. Seleccionar los elementos para los nombres de las columnas y filas y definir la matriz de adyacencia aleatoria generada

  F=F[2:8,]
  colnames(F) <- as.vector(as.matrix(nodos_48[,1]))
  rownames(F) <- as.vector(as.matrix(nodos_48[,1]))
  
  F

     1401 1402 1404 1405 1407 1408 1399
1401    0    7    7    6    4    3    4
1402    4    0    6    5    3    3    4
1404    6    5    0    4    3    5    4
1405    6    9    5    0    7    8    8
1407    4    3    3    4    0    3    3
1408    5    6    4    5    5    0    7
1399    5    2    4    5    7    4    0

Dist uniforme

  sumas = rowSums(matrix_A48)
  F=as.vector(as.matrix(nodos_48[,1]))
  x=dim(nodos_48)[1]

for (i in 1:x){
  
  
  #2. Extraer el vector de la matriz de ayacencia y scarle el 0
  
  #fila = as.vector(matrix_A48[i,])
  
#2. sacar el 0 corresponduente en i
  #fila = fila[-c(i)]

  #2. crear el vector aleatorio, que preserve la suma deseada
    s=0

    while (s!=sumas[i]){
      vector <- floor(runif(6, min=0, max=11)) #uniforme para asgurarme que corre
      #vector <-rnorm((x-1), mean=sumas[i]/(x-1), sd=sd(fila) ) # x-1 es porque es para los compañeros
      s <- sum(vector) 
    }

  #3. agregar el cero en i al vector

    f = append(vector, 0, after=i-1)
  
  #4. agregar a la matriz aleatoria usando rbind

  
    F=rbind(F, f)  
  
}

  #5. Seleccionar los elementos para los nombres de las columnas y filas y definir la matriz de adyacencia aleatoria generada

  F=F[2:8,]
  colnames(F) <- as.vector(as.matrix(nodos_48[,1]))
  rownames(F) <- as.vector(as.matrix(nodos_48[,1]))
  
  F

     1401 1402 1404 1405 1407 1408 1399
1401    0    9    9    2    1    5    5
1402    3    0    1    1    2   10    8
1404    4    8    0   10    5    0    0
1405    6    6    9    0    9    9    4
1407    8    2    0    8    0    2    0
1408    1    9    6    8    1    0    7
1399    1    4    3   10    2    7    0

n simulated adjacency 3-d array

library("abind")

arr <- matrix_A48
n= 1000 #número de simulaciones

for (j in 1:n) {

  sumas = rowSums(matrix_A48)
  F=as.vector(as.matrix(nodos_48[,1]))
  x=dim(nodos_48)[1]


  for (i in 1:x){
  
    #2. Extraer el vector de la matriz de ayacencia y scarle el 0
  
  fila = as.vector(matrix_A48[i,])
  
#3. sacar el 0 corresponduente en i
  fila = fila[-c(i)]

  #4. crear el vector aleatorio, que preserve la suma deseada
    s=0

    while (s!=sumas[i]) { #trabaja dentro del vector, crea uno aleatorio no negativo que de la suma iterativamente
      #vector <- floor(runif(6, min=0, max=11)) #uniforme para asgurarme que corre
      vector <-floor(rnorm(length(fila), mean(fila), sd(fila) ))
      s <- sum(vector) 
    }


  #3. agregar el cero en i al vector

    f = append(vector, 0, after=i-1)
  
  #4. agregar a la matriz aleatoria usando rbind

  
    F=rbind(F, f)  
  
  }

  #5. Seleccionar los elementos para los nombres de las columnas y filas y definir la matriz de adyacencia aleatoria generada

  F=F[2:8,]
  colnames(F) <- as.vector(as.matrix(nodos_48[,1]))
  rownames(F) <- as.vector(as.matrix(nodos_48[,1]))

  arr <- abind(arr,F)
}

dim(arr)= c(x,x, n+1) #formatea el array a las dimensiones filas, columnas, 
arr=arr[,,2:n]

matrix_A48[6,1]

[1] 4

fila = as.vector(matrix_A48[6,])
fila = fila[-c(6)]

mean(fila)

[1] 5.333333

sd(fila)

[1] 1.032796

arr[6,1, ]

  [1] 5 5 4 6 6 5 5 6 5 4 6 5 4 6 5 6 4 5 4 5 6 5 5 6 7 3 4 4 6 4 4 3 4 5 5 5 6 6 5 6 4 6 5 6 6 6 6 4 5 4 6 5 5 6 7 4 3 6 5 5 7 4 8 8 6 5
 [67] 6 6 6 6 6 5 7 6 4 5 6 5 3 6 7 5 7 6 7 5 6 5 8 5 4 6 4 4 5 5 5 6 5 5 5 4 4 5 6 5 6 5 6 6 6 4 6 7 6 6 3 5 5 4 5 6 5 6 7 6 7 5 6 7 5 4
[133] 4 5 4 6 6 5 7 5 6 6 5 4 5 7 5 6 4 8 6 6 4 5 5 5 4 5 5 6 4 6 5 5 7 3 7 6 5 6 6 5 6 6 6 6 6 5 5 4 6 6 7 5 6 5 6 4 6 4 6 6 6 6 5 2 4 5
[199] 5 6 3 6 3 5 4 5 5 5 6 5 4 5 7 4 5 6 5 5 6 5 6 5 6 5 4 4 4 6 6 6 4 6 4 5 5 4 4 4 5 7 6 6 6 4 4 4 5 6 5 4 5 3 6 4 3 4 6 5 5 6 7 7 5 6
[265] 4 4 4 5 5 5 5 3 7 5 6 5 5 6 4 5 6 4 4 5 5 7 6 6 5 6 4 5 5 6 5 6 5 3 6 5 6 5 6 7 5 5 5 6 6 6 4 5 6 5 6 4 5 6 5 7 6 6 5 5 5 6 5 5 5 4
[331] 6 4 5 5 5 5 7 6 4 6 6 8 5 6 5 8 5 4 4 7 4 4 4 4 6 5 7 4 5 4 7 6 5 5 5 4 5 5 4 5 8 6 5 6 6 5 7 5 5 5 5 7 5 5 4 6 5 6 5 4 5 5 4 5 4 6
[397] 6 6 6 5 4 5 5 4 6 4 5 5 6 4 6 6 5 3 6 5 5 4 6 5 4 5 5 6 6 5 6 5 4 4 5 5 5 4 6 7 7 4 5 4 6 5 7 5 5 6 5 5 4 7 6 6 4 5 5 5 5 6 6 7 5 7
[463] 5 7 6 4 6 5 5 6 6 6 6 5 4 6 6 6 5 7 5 7 5 6 7 5 7 3 6 5 5 6 6 5 4 4 4 6 5 6 6 7 6 6 7 6 5 4 6 5 4 5 7 6 6 6 6 7 5 5 4 7 8 5 6 5 7 5
[529] 4 5 5 3 5 7 4 5 5 6 6 7 7 5 4 5 5 5 4 5 5 6 4 4 4 5 5 6 6 4 5 5 6 6 5 5 5 6 7 5 5 6 4 5 5 5 5 7 5 5 6 7 4 5 4 4 5 4 6 3 6 6 5 4 5 6
[595] 6 6 7 3 6 5 5 6 6 7 6 5 6 6 7 6 4 5 6 6 6 6 6 6 6 7 5 6 4 5 5 5 6 5 5 5 7 6 6 5 6 6 6 6 6 4 5 5 4 5 4 5 5 5 5 6 5 6 5 5 5 4 6 3 6 6
[661] 6 6 6 5 4 5 4 4 7 6 5 5 6 5 6 7 4 6 5 5 6 5 3 6 5 5 5 7 5 6 5 5 5 4 5 5 6 4 5 4 5 6 6 6 5 4 7 5 6 7 7 8 4 7 7 6 4 7 5 6 5 5 5 6 5 6
[727] 6 4 5 8 5 5 6 4 6 6 5 4 5 5 6 5 6 5 6 5 6 4 5 4 5 3 6 6 5 7 4 6 6 4 5 6 6 7 5 6 7 5 4 5 5 4 4 5 7 5 6 5 5 5 4 5 7 3 6 4 5 6 5 4 5 7
[793] 5 3 6 6 5 6 6 6 6 7 5 6 5 6 6 6 6 5 5 5 5 5 6 6 6 5 5 7 5 6 6 6 5 5 7 5 5 4 5 4 5 6 7 5 5 5 8 5 6 5 6 4 3 7 5 6 4 5 7 4 6 6 5 5 5 4
[859] 5 6 5 6 6 6 7 4 6 4 4 5 5 4 6 6 6 6 5 4 4 6 5 6 4 5 6 3 5 6 4 6 6 6 5 5 6 5 6 5 8 6 5 6 7 5 5 5 5 5 5 6 7 5 4 5 5 4 6 5 6 6 6 6 5 5
[925] 6 5 3 6 5 5 4 6 6 4 5 5 6 3 5 4 6 4 5 6 5 5 3 6 5 6 5 6 5 6 5 3 6 6 4 4 6 5 4 4 5 5 5 6 6 4 4 5 5 4 5 5 5 6 6 5 5 5 5 4 5 5 7 5 5 4
[991] 6 5 6 6 7 6 5 5 5

hist(arr[6,1,])

Funciòn intervalo de confianza

confidence_interval <- function(vector, interval) {
  # Standard deviation of sample
  vec_sd <- sd(vector)
  # Sample size
  n <- length(vector)
  # Mean of sample
  vec_mean <- mean(vector)
  # Error according to t distribution
  error <- qt((interval + 1)/2, df = n - 1) * vec_sd / sqrt(n)
  # Confidence interval as a vector
  result <- c("lower" = vec_mean - error, "upper" = vec_mean + error)
  return(result)
}

confidence_interval(arr[6,1,],0.95)

   lower    upper 
5.232114 5.354472 

matrix_A48[6,1]

[1] 4

net = matrix_A48
  
m = matrix(ncol = length(net[,1]),nrow = length(net[,1]))

for (i in 1:x){
  
  for (j in 1:x){
  m[i,j]=mean(arr[i,j,])  
  }
  
}

m

         [,1]     [,2]     [,3]     [,4]     [,5]     [,6]     [,7]
[1,] 0.000000 5.040040 5.206206 5.307307 5.214214 5.140140 5.092092
[2,] 4.196196 0.000000 4.211211 4.179179 4.142142 4.144144 4.127127
[3,] 4.553554 4.540541 0.000000 4.495495 4.473473 4.459459 4.477477
[4,] 7.188188 7.148148 7.202202 0.000000 7.161161 7.195195 7.105105
[5,] 3.380380 3.331331 3.342342 3.308308 0.000000 3.315315 3.322322
[6,] 5.293293 5.363363 5.306306 5.340340 5.347347 0.000000 5.349349
[7,] 4.449449 4.573574 4.493493 4.467467 4.468468 4.547548 0.000000

Análisis estadístico

Filtración de la red

—- Solución approach: de bootstraping

Definir un intrevalo de confianza con las simulaciones

1. ordenamos del menor a menor
2. generamos un intervalo con el 95% interior
3. vemos si el observado está dentro del intervalo de confianza
4. matriz de 0 y 1

Resultadso/metricas:

1. Matriz de enlaces significativos: 4
2. Diferencias significativas: -1.7 [quede Pendiente]

Función que arma el intervalo de confianza

confidence_interval <- function(vector, interval) {
  # Standard deviation of sample
  vec_sd <- sd(vector)
  # Sample size
  n <- 10 #length(vector)
  # Mean of sample
  vec_mean <- mean(vector)
  # Error according to t distribution
  error <- qt((interval + 1)/2, df = n - 1) * vec_sd / sqrt(n)
  # Confidence interval as a vector
  result <- c("lower" = vec_mean - error, "upper" = vec_mean + error)
  return(result)
}

Algoritmo de filtrado mediante el intervalo de confianza

#recordar los siguientes parametros importantes: n= número de simulaciones, x= número de niños en el curso, arr= array 3D, de cada simulación . Cada diada relevante se indica como arr[i,j,] para todas las simulaciones

net <- matrix_A48 # la matriz de adyacencia relevante del curso, con las observaciones

#armar las matrices relevates vacias
envios_sig=d_free=t_bin=phi=t=matrix(ncol = length(net[,1]),nrow = length(net[,1]))

k=0
IC=0.95 #Nivel de confianza


for(i in 1:length(net[,1])){ #loop corre para cada elemento de la fila
  Mi<-sum(net[,i]) #out-strength de i (suma de todos los out degree) 
  
  for(j in 1:length(net[,1])){ #loop corre para cada columna
    k=k+1 #contador
    
    Mj<-sum(net[,j]) #out-strength de j 
    
    # phi[i,j]<-((net[i,j]*N)-(Mi*Mj))/(sqrt(Mi*Mj*(N-Mi)*(N-Mj))) # Vale la pena explorar este approach
    
    c= confidence_interval(arr[i,j,], IC) # crea un intervalo de confianza usando la simulación

    t_bin[i,j]<-ifelse( (c[1]>net[i,j] | c[2]<net[i,j]),1,0) # matriz cero o uno si el enlace es significativo usando el intervalo de confianza
    
    envios_sig[i,j]<-ifelse( (c[1]>net[i,j] | c[2]<net[i,j]), net[i,j],0)
  }
}

colnames(envios_sig) <- as.vector(as.matrix(nodos_48[,1]))
rownames(envios_sig) <- as.vector(as.matrix(nodos_48[,1]))

envios_sig

     1401 1402 1404 1405 1407 1408 1399
1401    0    2    0    0    0    0   10
1402    3    0    6    0    0    5    3
1404    0    6    0    3    6    0    0
1405    4   10    5    0    9    5   10
1407    4    0    4    2    0    4    0
1408    4    0    0    0    0    0    7
1399    3    6    0    0    0    6    0

net

     1401 1402 1404 1405 1407 1408 1399
1401    0    2    4    4    6    5   10
1402    3    0    6    4    4    5    3
1404    4    6    0    3    6    4    4
1405    4   10    5    0    9    5   10
1407    4    3    4    2    0    4    3
1408    4    6    5    5    5    0    7
1399    3    6    4    4    4    6    0

t_bin

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    0    1    0    0    0    0    1
[2,]    1    0    1    0    0    1    1
[3,]    0    1    0    1    1    0    0
[4,]    1    1    1    0    1    1    1
[5,]    1    0    1    1    0    1    0
[6,]    1    0    0    0    0    0    1
[7,]    1    1    0    0    0    1    0

Un ejemplo numérico especifico

net[2,3]

[1] 6

mean(arr[2,3,])

[1] 4.211211

sd(arr[2,3,])

[1] 1.061456

v<-as.vector(arr[2,3,])
v

  [1] 3 3 5 6 4 4 4 6 3 3 4 5 3 3 4 5 4 3 5 3 2 4 4 2 3 5 3 5 6 5 3 4 5 4 5 5 3 5 4 3 4 6 5 5 3 4 4 4 5 3 4 2 6 5 5 5 5 3 5 4 6 7 4 3 4 4
 [67] 4 3 3 5 4 3 2 4 5 5 5 5 5 3 3 2 4 4 5 4 7 4 5 3 4 3 4 5 3 4 6 4 4 4 3 4 3 5 5 4 4 5 3 4 4 3 4 4 3 5 5 3 4 4 4 4 6 5 3 4 5 3 4 3 5 4
[133] 5 4 3 4 3 3 3 5 5 5 4 3 3 5 5 3 4 6 5 4 4 5 3 4 3 4 5 4 5 5 5 3 4 5 5 6 4 4 6 2 4 4 3 6 5 5 6 3 4 4 3 6 3 3 3 4 4 6 6 3 3 3 2 3 4 3
[199] 6 6 5 3 4 7 4 3 3 2 4 4 5 3 3 4 4 4 4 4 5 4 4 3 3 3 6 4 4 5 4 4 3 5 3 5 5 4 3 7 6 2 5 3 5 3 6 3 3 4 4 4 4 4 5 5 7 4 5 4 4 3 4 4 4 5
[265] 4 4 5 4 5 5 4 6 5 6 4 3 5 5 3 4 5 5 4 3 4 5 5 5 2 4 4 5 3 4 5 5 4 5 4 3 4 5 3 4 2 5 4 5 4 4 3 2 3 4 4 4 4 6 5 3 7 4 5 5 4 4 4 3 3 2
[331] 4 1 4 3 3 4 4 4 4 6 3 4 4 4 4 5 3 4 4 6 3 4 3 4 2 5 4 5 4 3 4 4 4 4 5 3 6 4 3 4 3 4 7 3 4 6 6 6 4 5 4 5 1 4 4 5 4 5 4 4 5 5 4 5 4 4
[397] 4 4 3 4 3 4 3 3 4 4 5 6 4 3 5 4 6 3 5 4 5 5 5 5 4 3 5 4 6 5 3 4 3 5 4 4 5 5 4 6 5 4 3 6 3 4 4 5 4 6 3 2 5 5 7 6 3 5 4 3 4 5 4 5 3 4
[463] 5 5 3 4 6 5 4 4 4 3 3 5 5 5 6 4 5 5 4 3 4 4 5 5 3 5 4 2 6 5 5 5 7 3 4 6 2 5 5 5 6 3 4 2 4 6 5 2 3 4 4 4 5 3 2 4 4 5 3 4 6 5 4 5 5 5
[529] 5 4 5 5 5 5 5 5 5 4 4 4 4 3 6 7 5 3 3 4 3 3 2 5 5 5 3 3 4 3 5 3 4 5 4 5 3 5 4 3 5 4 4 5 5 5 5 4 5 5 3 5 4 5 4 5 6 5 5 5 5 4 4 5 4 6
[595] 6 5 4 4 4 4 4 4 5 6 5 5 4 4 5 4 6 2 3 4 6 3 3 4 4 5 4 5 4 5 5 5 5 4 4 3 4 5 4 6 6 5 4 3 5 3 6 4 5 5 4 5 5 4 4 5 3 3 5 4 4 3 5 5 3 5
[661] 4 5 4 3 6 5 3 2 5 4 4 4 2 5 4 6 3 3 5 3 3 7 5 3 6 5 3 4 4 4 4 4 3 4 6 4 2 5 4 4 5 4 5 5 5 5 4 3 3 4 5 4 4 3 4 4 4 4 3 4 6 4 4 6 3 5
[727] 4 3 3 6 5 3 3 5 4 6 4 4 5 4 3 6 5 5 7 4 5 3 5 4 4 3 5 4 2 4 4 3 3 5 4 5 1 6 4 4 5 3 5 5 3 5 4 5 3 5 4 4 4 4 3 3 5 4 5 3 4 2 7 4 4 4
[793] 5 3 4 6 2 4 4 4 4 2 4 4 5 5 5 4 5 5 4 5 5 3 3 4 6 3 4 5 5 3 4 4 3 5 4 5 3 2 5 2 3 4 3 3 4 5 5 4 5 6 4 3 6 3 4 4 7 5 4 4 3 5 4 3 4 5
[859] 4 5 5 5 4 5 3 4 2 3 3 6 5 6 3 4 6 6 4 2 5 3 3 3 4 6 4 4 4 6 6 3 3 3 4 4 4 4 3 2 4 3 5 5 7 4 6 4 5 3 5 5 4 5 5 5 5 5 3 5 5 4 5 4 4 4
[925] 4 4 3 3 2 5 5 3 5 6 4 5 5 3 6 5 4 5 3 5 6 4 4 5 4 5 2 3 2 5 4 4 4 3 5 3 5 4 4 4 5 3 7 3 5 6 4 5 2 5 3 4 5 5 4 4 7 5 5 5 5 4 2 4 6 5
[991] 6 5 5 4 4 6 3 4 3

error <- qt(0.975, df=length(arr[2,3,])-1)*sd(arr[2,3,])/sqrt(length(arr[2,3,]))
error

[1] 0.06590133

lower=mean(arr[2,3,])-error
lower

[1] 4.14531

c=confidence_interval(arr[2,3,], 0.95)
c

   lower    upper 
3.451892 4.970531 

(c[1]>net[2,3] | c[2]<net[2,3])

lower 
 TRUE 

Chequea si el valor observado está en el intervalo

t<-ifelse( (c[1]>net[2,3] | c[2]<net[2,3]),1,0)
t

lower 
    1 

Pendientes

Sampling sendings and recieved: Row and column-wise randomization

Full sample analysis

Rewired by sampling

Sampling sendings: Row-wise randomization

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

#crea la lista de nodos
nodos <- red %>%
  select(id=from, Id_Curso) %>%
  distinct(id) %>%
  group_by(Id_Curso)

# divide dataframe por Id_Curso
red<-group_split(red)
nodos<-group_split(nodos)

# graph_from_data_frame: crea grafo desde edgelist
graphs<-lapply(red,graph_from_data_frame,directed=T) #lapply= l-list apply

#gen adyacency matrix
matrix_A<-lapply(graphs,as_adjacency_matrix,names=TRUE,sparse=FALSE, attr="weight" )

random_rowsample <- function(red,nodos, n ){
  
  arr <-red
  
  for (j in 1:n) {

  sumas = rowSums(red)
  F=as.vector(as.matrix(nodos[,1]))
  x=dim(nodos)[1]
  
    for (i in 1:x){
  
    #2. Extraer el vector de la matriz de ayacencia y scarle el 0
  
    fila = as.vector(red[i,])
  
    #3. sacar el 0 corresponduente en i
    
    fila = fila[-c(i)]

  #4. crear el vector aleatorio, que preserve la suma deseada
    s=0

    while (s!=sumas[i]) { #trabaja dentro del vector, crea uno aleatorio no negativo que de la suma iterativamente
      #vector <- floor(runif(6, min=0, max=11)) #uniforme para asgurarme que corre
      vector <-floor(rnorm(length(fila), mean(fila), sd(fila) ))
      s <- sum(vector) 
    }
  
    }
  
  #5. Seleccionar los elementos para los nombres de las columnas y filas y definir la matriz de adyacencia aleatoria generada

  F=F[2:8,]
  colnames(F) <- as.vector(as.matrix(nodos[,1]))
  rownames(F) <- as.vector(as.matrix(nodos[,1]))

  arr <- abind(arr,F)
  }

  dim(arr)= c(x,x, n+1) #formatea el array a las dimensiones filas, columnas, 
  arr=arr[,,2:n]
  
   
  }
  

library("abind")

arr <- matrix_A48
n= 1000 #número de simulaciones

for (j in 1:n) {

  sumas = rowSums(matrix_A48)
  F=as.vector(as.matrix(nodos_48[,1]))
  x=dim(nodos_48)[1]


  for (i in 1:x){
  
    #2. Extraer el vector de la matriz de ayacencia y scarle el 0
  
  fila = as.vector(matrix_A48[i,])
  
#3. sacar el 0 corresponduente en i
  fila = fila[-c(i)]

  #4. crear el vector aleatorio, que preserve la suma deseada
    s=0

    while (s!=sumas[i]) { #trabaja dentro del vector, crea uno aleatorio no negativo que de la suma iterativamente
      #vector <- floor(runif(6, min=0, max=11)) #uniforme para asgurarme que corre
      vector <-floor(rnorm(length(fila), mean(fila), sd(fila) ))
      s <- sum(vector) 
    }


  #3. agregar el cero en i al vector

    f = append(vector, 0, after=i-1)
  
  #4. agregar a la matriz aleatoria usando rbind

  
    F=rbind(F, f)  
  
  }

  #5. Seleccionar los elementos para los nombres de las columnas y filas y definir la matriz de adyacencia aleatoria generada

  F=F[2:8,]
  colnames(F) <- as.vector(as.matrix(nodos_48[,1]))
  rownames(F) <- as.vector(as.matrix(nodos_48[,1]))

  arr <- abind(arr,F)
}

dim(arr)= c(x,x, n+1) #formatea el array a las dimensiones filas, columnas, 
arr=arr[,,2:n]