#start with clean workspace 
rm(list=ls())
getwd()

## [1] "C:/Users/ninab/OneDrive/Documenten/GitHub/labjournal"

1 packages

library(data.table) 
library(tidyverse) 

## ── Attaching packages ─────────────────────────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.0      ✔ stringr 1.4.1 
## ✔ readr   2.1.2      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between()   masks data.table::between()
## ✖ dplyr::filter()    masks stats::filter()
## ✖ dplyr::first()     masks data.table::first()
## ✖ dplyr::lag()       masks stats::lag()
## ✖ dplyr::last()      masks data.table::last()
## ✖ purrr::transpose() masks data.table::transpose()

require(stringi)

## Loading required package: stringi

require(Rsiena)

## Loading required package: Rsiena

## Warning in library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, : there
## is no package called 'Rsiena'

require(igraph)

## Loading required package: igraph
## 
## Attaching package: 'igraph'
## 
## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union
## 
## The following objects are masked from 'package:purrr':
## 
##     compose, simplify
## 
## The following object is masked from 'package:tidyr':
## 
##     crossing
## 
## The following object is masked from 'package:tibble':
## 
##     as_data_frame
## 
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## 
## The following object is masked from 'package:base':
## 
##     union

2 Data

#load dataobjects
load("./data/descriptives/UU_net_array_sym.RData")
load("./data/descriptives/UU_dfv2.RData")

3 custum functions

# density: observed relations divided by possible relations
fdensity <- function(x) {
    # x is your nomination network make sure diagonal cells are NA
    diag(x) <- NA
    # take care of RSiena structural zeros, set as missing.
    x[x == 10] <- NA
    sum(x == 1, na.rm = T)/(sum(x == 1 | x == 0, na.rm = T))
}

# calculate intragroup density
fdensityintra <- function(x, A) {
    # A is matrix indicating whether nodes in dyad have same node attributes
    diag(x) <- NA
    x[x == 10] <- NA
    diag(A) <- NA
    sum(x == 1 & A == 1, na.rm = T)/(sum((x == 1 | x == 0) & A == 1, na.rm = T))
}

# calculate intragroup density
fdensityinter <- function(x, A) {
    # A is matrix indicating whether nodes in dyad have same node attributes
    diag(x) <- NA
    x[x == 10] <- NA
    diag(A) <- NA
    sum(x == 1 & A != 1, na.rm = T)/(sum((x == 1 | x == 0) & A != 1, na.rm = T))
}

# construct dyadcharacteristic whether nodes are similar/homogenous
fhomomat <- function(x) {
    # x is a vector of node-covariate
    xmat <- matrix(x, nrow = length(x), ncol = length(x))
    xmatt <- t(xmat)
    xhomo <- xmat == xmatt
    return(xhomo)
}

# a function to calculate all valid dyads.
fndyads <- function(x) {
    diag(x) <- NA
    x[x == 10] <- NA
    (sum((x == 1 | x == 0), na.rm = T))
}

# a function to calculate all valid intragroupdyads.
fndyads2 <- function(x, A) {
    diag(x) <- NA
    x[x == 10] <- NA
    diag(A) <- NA
    (sum((x == 1 | x == 0) & A == 1, na.rm = T))
}

4 descriptives

soc_df$div.net <- as.numeric(soc_df$div)

summary(soc_df$div.net)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   23.96   31.89   36.10   44.11  100.00

sd(soc_df$div.net, na.rm=TRUE)

## [1] 26.66588

table(soc_df$div.net)

## 
##     0    10 17.86 20.83    25 26.19 28.57    30 31.43 32.35 33.33 36.36  37.7 38.46 42.86    44 
##     5     1     1     1     3     1     2     1     1     1     2     1     1     1     1     1 
## 44.44 57.14  62.5 76.92 78.05    80 89.47   100 
##     1     1     1     1     1     1     1     1

hist(soc_df$div.net, col="lightblue", main='UU: ethnic diversity egonets', xlab='Percentage non-Dutch collaborators')

summary(soc_df$div.ego)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  1.0000  0.6875  1.0000  1.0000

table(soc_df$div.ego)

## 
##  0  1 
## 10 22

hist(soc_df$div.ego, col="lightblue")

summary(soc_df$nauthors)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    5.50   12.00   16.19   24.25   61.00

sd(soc_df$nauthors, na.rm=TRUE)

## [1] 14.40976

hist(soc_df$nauthors, col="lightblue", main='UU: number of co-authors', xlab='Number of co-authors since 2019')

summary(soc_df$pub_first)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1976    1997    2010    2006    2016    2022

sd(soc_df$pub_first, na.rm=TRUE)

## [1] 13.40825

hist(soc_df$pub_first, col="lightblue", main='UU: year first publication', xlab='Year first publication')

table(soc_df$gender4)

## 
##  0  1 
## 13 19

hist(soc_df$gender4, col="lightblue")

5 degree

5.1 net 1

net1 <- net_soc_array[ ,, 1]
diag(net1) <- 0
degree <- rowSums(net1)
hist(degree)

summary(degree)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.5625  1.0000  3.0000

sd(degree)

## [1] 0.9482582

5.2 net 2

net2 <- net_soc_array[ ,, 2]
diag(net2) <- 0
degree <- rowSums(net2)
hist(degree)

summary(degree)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   0.000   0.625   1.000   3.000

sd(degree)

## [1] 1.039541

5.3 net 3

net3 <- net_soc_array[ ,, 3]
diag(net3) <- 0
degree <- rowSums(net3)
hist(degree)

summary(degree)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   1.000   1.188   2.000   4.000

sd(degree)

## [1] 1.281066

6 igraph object

6.1 net 1

net1_g <- igraph::graph_from_adjacency_matrix(net1, mode = c("undirected"))
plot(net1_g)

igraph::degree(net1_g)

##  [1] 1 0 0 2 0 2 0 0 2 0 0 3 3 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 2 0 0 0

igraph::dyad.census(net1_g)

## $mut
## [1] 9
## 
## $asym
## [1] 0
## 
## $null
## [1] 487

igraph::triad.census(net1_g)

## Warning in igraph::triad.census(net1_g): At core/misc/motifs.c:1165 : Triad census called on an
## undirected graph.

##  [1] 4699    0  253    0    0    0    0    0    0    0    7    0    0    0    0    1

igraph::edge_density(net1_g)

## [1] 0.01814516

sum(igraph::degree(net1_g))

## [1] 18

6.2 net 2

net2_g <- igraph::graph_from_adjacency_matrix(net2, mode = c("undirected"))
plot(net2_g)

igraph::degree(net2_g)

##  [1] 1 0 0 3 0 1 0 1 2 0 0 3 3 0 0 0 0 0 3 1 1 0 0 1 0 0 0 0 0 0 0 0

igraph::dyad.census(net2_g)

## $mut
## [1] 10
## 
## $asym
## [1] 0
## 
## $null
## [1] 486

igraph::triad.census(net2_g)

## Warning in igraph::triad.census(net2_g): At core/misc/motifs.c:1165 : Triad census called on an
## undirected graph.

##  [1] 4672    0  277    0    0    0    0    0    0    0   10    0    0    0    0    1

igraph::edge_density(net2_g)

## [1] 0.02016129

sum(igraph::degree(net2_g))

## [1] 20

6.3 net 3

net3_g <- igraph::graph_from_adjacency_matrix(net3, mode = c("undirected"))
plot(net3_g)

igraph::degree(net3_g)

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

igraph::dyad.census(net3_g)

## $mut
## [1] 19
## 
## $asym
## [1] 0
## 
## $null
## [1] 477

igraph::triad.census(net3_g)

## Warning in igraph::triad.census(net3_g): At core/misc/motifs.c:1165 : Triad census called on an
## undirected graph.

##  [1] 4416    0  521    0    0    0    0    0    0    0   20    0    0    0    0    3

igraph::edge_density(net3_g)

## [1] 0.03830645

sum(igraph::degree(net3_g))

## [1] 38

7 density

7.1 net 1

net_und <- net1 + t(net1)
net_und[net_und==2] <- 1

sum(net_und, na.rm=TRUE)

## [1] 18

fdensity(net1)

## [1] 0.01814516

7.2 net 2

net_und <- net2 + t(net2)
net_und[net_und==2] <- 1

sum(net_und, na.rm=TRUE)

## [1] 20

fdensity(net2)

## [1] 0.02016129

7.3 net 3

net_und <- net3 + t(net3)
net_und[net_und==2] <- 1

sum(net_und, na.rm=TRUE)

## [1] 38

fdensity(net3)

## [1] 0.03830645

8 inter-/intragroup density

div_m <-  fhomomat(soc_df$div.ego)

# calculate intra-/intergroup density diversity ego
fdensityintra(x=net_und, A=div_m) 

## [1] 0.05072464

fdensityinter(x=net_und, A=div_m)

## [1] 0.02272727

# calculate intra-/intergroup density gender
gender_m <-  fhomomat(soc_df$gender4)
fdensityintra(x=net_und, A=gender_m) 

## [1] 0.04417671

fdensityinter(x=net_und, A=gender_m)

## [1] 0.03238866