Monk Monastery Network

A closer look into Samson dataset

Peter Sullivan
2022-02-17

Introduction to Dataset

The following data set looks at social interactions amoung monks. This data was recorded in 1969. During Sampsons stay at a monestary, 4 monks were expelled from the monestary. Sampson interviewed the monks about positive relations between monks. Each monk ranked their top three choices. A tie is represented by monks liking another monk. The data was gathered three times to see if group sentiment changed over time.

Describe the Network

ls()


[1] "network_igraph"  "network_nodes"   "network_statnet"
print(network_statnet)


 Network attributes:

  vertices = 18 

  directed = TRUE 

  hyper = FALSE 

  loops = FALSE 

  multiple = FALSE 

  total edges= 88 

    missing edges= 0 

    non-missing edges= 88 



 Vertex attribute names: 

    cloisterville group vertex.names 



 Edge attribute names: 

    nominations 
vcount(network_igraph)


[1] 18
ecount(network_igraph)


[1] 88

Both the igraph and statnet datasets are showing the same number of nodes and edges. 18 nodes and 88 edges.

is_bipartite(network_igraph)


[1] FALSE
is_directed(network_igraph)


[1] TRUE
is_weighted(network_igraph)


[1] FALSE
V(network_igraph)$color = "yellow"





plot(

  network_igraph,

  edge.arrow.mode = .9,

  vertex.label.color = "black",

  vertex.shape = "square",

  vertex.label.font = 3,

  main = "Monastery Monks"

  

)

We have a single mode, directed, and unweighted dataset.

Looking at the Attributes

igraph::vertex_attr_names(network_igraph)


[1] "cloisterville" "group"         "na"            "vertex.names" 

[5] "color"        
network::list.vertex.attributes(network_statnet)


[1] "cloisterville" "group"         "na"            "vertex.names" 
igraph::edge_attr_names(network_igraph)


[1] "na"          "nominations"
network::list.edge.attributes(network_statnet)


[1] "na"          "nominations"

Both statnet and igraph are showing the same results. The vertex attribute names are cloisterville, group and vertex.names. There are three types of groups, Loyal, Outcasts and Turks. Cloisterville is indicated by true or false and it represents whether the monk was in the seminary of Cloisterville before coming the the present monestary.

Looking into the attribute data

V(network_igraph)$vertex.names %>% head()


[1] "John Bosco"  "Gregory"     "Basil"       "Peter"      

[5] "Bonaventure" "Berthold"   
network_statnet %v% "vertex.names" %>% head()


[1] "John Bosco"  "Gregory"     "Basil"       "Peter"      

[5] "Bonaventure" "Berthold"   
V(network_igraph)$cloisterville %>% head()


[1]  TRUE  TRUE  TRUE  TRUE  TRUE FALSE
V(network_igraph)$group %>% head()


[1] "Turks"    "Turks"    "Outcasts" "Loyal"    "Loyal"    "Loyal"   
V(network_igraph)$vertex.names %>% length()


[1] 18

We are able to retrieve all 18 of the monks names.

E(network_igraph)$nominations %>% head()


[1] 1 1 1 1 3 3
network_statnet %e% "nominations" %>% head()


[1] 1 1 1 1 3 3
E(network_igraph)$nominations %>% unique() %>% sort()


[1] 1 2 3

The edge attributes seem to be numbers ranging form 1 to 3.

Summarizing Network Attriubtes

summary(E(network_igraph)$nominations)


   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 

  1.000   1.000   2.000   1.909   3.000   3.000

Dyad Census

igraph::dyad.census(network_igraph)


$mut

[1] 28



$asym

[1] 32



$null

[1] 93
sna::dyad.census(network_statnet)


     Mut Asym Null

[1,]  28   32   93

Both network and igraph are getting the same results. Since each monk was each recommending the top three of each, I’m surprised by how many mutual ties there are.

Triad Census

igraph::triad_census(network_igraph)


 [1] 167 205 190  12  24  24  68  34   5   0  35  15   6   5  18   8
sna::triad.census(network_statnet)


     003 012 102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U

[1,] 167 205 190   12   24   24   68   34    5    0  35   15    6

     120C 210 300

[1,]    5  18   8

Transitivity

transitivity(network_igraph, type = "global")


[1] 0.4646739
transitivity(network_igraph, type = "average")


[1] 0.4925926

The global transivity is much lower than the average transivity. This means that we have multiple small groups of well connected monks with in their respective groups.

Geodesic Paths

average.path.length(network_igraph)


[1] 1.996732

This is to be expected with such a small network.

Component Structure

names(igraph::components(network_igraph))


[1] "membership" "csize"      "no"        
igraph::components(network_igraph)$no


[1] 1
igraph::components(network_igraph)$csize


[1] 18
igraph::components(network_igraph)$membership


 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

Isolates

isolates(network_statnet)


integer(0)

There are no isolates. This means there are no monks that don’t like any monks or are liked by other monks.

Density

graph.density(network_igraph)


[1] 0.2875817
network.density(network_statnet)


[1] 0.2875817

Both Network densitys are the same for both igraph and statnet. The denisty is low, but this is to be expected, since each monk could only pick 3 other monks.

Degrees

x <- data.frame(

  Name = network_statnet %v% "vertex.names",

  Total_Degrees = sna::degree(network_statnet),

  Out_Degrees = sna::degree(network_statnet, cmode = "indegree"),

  in_Degrees = sna::degree(network_statnet, cmode = "outdegree")

  

)



x %>% arrange(desc(Total_Degrees)) %>% head()


         Name Total_Degrees Out_Degrees in_Degrees

1  John Bosco            17          11          6

2     Gregory            15          10          5

3 Bonaventure            13           8          5

4        Mark            11           6          5

5      Victor            11           5          6

6     Winfrid            11           7          4
x %>% arrange(Total_Degrees) %>% head()


      Name Total_Degrees Out_Degrees in_Degrees

1 Berthold             6           2          4

2    Elias             6           2          4

3    Basil             8           3          5

4  Ambrose             8           4          4

5  Romauld             8           2          6

6    Louis             8           3          5
x %>% arrange(in_Degrees)


          Name Total_Degrees Out_Degrees in_Degrees

1        Amand             8           5          3

2        Peter             9           5          4

3     Berthold             6           2          4

4      Ambrose             8           4          4

5      Winfrid            11           7          4

6        Elias             6           2          4

7      Gregory            15          10          5

8        Basil             8           3          5

9  Bonaventure            13           8          5

10        Mark            11           6          5

11       Louis             8           3          5

12        Hugh            11           6          5

13      Albert             8           3          5

14  John Bosco            17          11          6

15      Victor            11           5          6

16     Romauld             8           2          6

17    Boniface             9           3          6

18  Simplicius             9           3          6
x %>% arrange(Out_Degrees)


          Name Total_Degrees Out_Degrees in_Degrees

1     Berthold             6           2          4

2      Romauld             8           2          6

3        Elias             6           2          4

4        Basil             8           3          5

5        Louis             8           3          5

6     Boniface             9           3          6

7       Albert             8           3          5

8   Simplicius             9           3          6

9      Ambrose             8           4          4

10       Peter             9           5          4

11      Victor            11           5          6

12       Amand             8           5          3

13        Mark            11           6          5

14        Hugh            11           6          5

15     Winfrid            11           7          4

16 Bonaventure            13           8          5

17     Gregory            15          10          5

18  John Bosco            17          11          6

Everybody must love John Bosco. Berthold and Elias were very much disliked. Berthold, Elias and Basil were apart of the 4 monks that were expelled from the monestary. It seems that those with the smallest out degrees were the ones to expelled.

summary(x %>% select(-Name))


 Total_Degrees     Out_Degrees       in_Degrees   

 Min.   : 6.000   Min.   : 2.000   Min.   :3.000  

 1st Qu.: 8.000   1st Qu.: 3.000   1st Qu.:4.000  

 Median : 9.000   Median : 4.500   Median :5.000  

 Mean   : 9.778   Mean   : 4.889   Mean   :4.889  

 3rd Qu.:11.000   3rd Qu.: 6.000   3rd Qu.:5.750  

 Max.   :17.000   Max.   :11.000   Max.   :6.000

The lowest degrees were 6, while on average, each monk had ~5 out and indegrees.

Degree Distribution

hist(x$Total_Degrees, main = "Total Degree Distribution",

     xlab = "Number of Likes")


hist(x$Out_Degrees, main = "Out Degree Distribution",

     xlab = "Number of Likes")


hist(x$in_Degrees, main = "In Degree Distribution",

     xlab = "Number of Likes")

Degree Centralization

centr_degree(network_igraph, loops = FALSE, mode ="in")


$res

 [1] 11 10  3  5  8  2  6  5  4  2  3  7  5  6  3  3  2  3



$centralization

[1] 0.3806228



$theoretical_max

[1] 289
centr_degree(network_igraph, loops = FALSE, mode = "out")


$res

 [1] 6 5 5 4 5 4 5 6 4 6 5 4 3 5 6 5 4 6



$centralization

[1] 0.06920415



$theoretical_max

[1] 289

The indegree centralization is at 38 % while the out degree is at 7%.

Eigenvector Centrality

x$eigen <- sna::evcent(network_statnet)



x %>% arrange(eigen)


          Name Total_Degrees Out_Degrees in_Degrees     eigen

1        Amand             8           5          3 0.1479037

2     Berthold             6           2          4 0.1711191

3        Peter             9           5          4 0.1717189

4        Elias             6           2          4 0.1833911

5      Ambrose             8           4          4 0.1900849

6  Bonaventure            13           8          5 0.2061513

7      Winfrid            11           7          4 0.2138861

8        Basil             8           3          5 0.2313738

9        Louis             8           3          5 0.2334813

10     Romauld             8           2          6 0.2481996

11        Mark            11           6          5 0.2591275

12        Hugh            11           6          5 0.2592391

13     Gregory            15          10          5 0.2635120

14      Albert             8           3          5 0.2643663

15      Victor            11           5          6 0.2664155

16  Simplicius             9           3          6 0.2745468

17  John Bosco            17          11          6 0.2879960

18    Boniface             9           3          6 0.2978587

Bonacich Power Centrality

library(DT)

x$Bonach_Power <- power_centrality(network_igraph)

x$Bon_pow <- sna::bonpow(network_statnet)



x %>% DT::datatable()

Creating Derived and Centrality Scores

MatSamson <- as.matrix(as_adjacency_matrix(network_igraph, attr = "nominations"))



MatSamsonsq<- t(MatSamson) %*% MatSamson

x$rc <- diag(MatSamsonsq)/rowSums(MatSamsonsq)

x$rc <- ifelse(is.nan(x$rc),0,x$rc)

x$eigen.rc <- x$eigen*x$rc



x$dc <- 1 - diag(MatSamsonsq)/rowSums(MatSamsonsq)

x$dc <- ifelse(is.nan(x$dc),1,x$dc)

x$eigen.dc <- x$eigen*x$dc





x%>% arrange(Total_Degrees)


          Name Total_Degrees Out_Degrees in_Degrees     eigen

1     Berthold             6           2          4 0.1711191

2        Elias             6           2          4 0.1833911

3        Basil             8           3          5 0.2313738

4      Ambrose             8           4          4 0.1900849

5      Romauld             8           2          6 0.2481996

6        Louis             8           3          5 0.2334813

7        Amand             8           5          3 0.1479037

8       Albert             8           3          5 0.2643663

9        Peter             9           5          4 0.1717189

10    Boniface             9           3          6 0.2978587

11  Simplicius             9           3          6 0.2745468

12        Mark            11           6          5 0.2591275

13      Victor            11           5          6 0.2664155

14     Winfrid            11           7          4 0.2138861

15        Hugh            11           6          5 0.2592391

16 Bonaventure            13           8          5 0.2061513

17     Gregory            15          10          5 0.2635120

18  John Bosco            17          11          6 0.2879960

   Bonach_Power    Bon_pow        rc   eigen.rc        dc  eigen.dc

1    -1.0567919 -1.0567919 0.2888889 0.04943442 0.7111111 0.1216847

2    -1.0452580 -1.0452580 0.2708333 0.04966842 0.7291667 0.1337227

3    -1.3782989 -1.3782989 0.2592593 0.05998581 0.7407407 0.1713880

4    -0.3215070 -0.3215070 0.2343750 0.04455114 0.7656250 0.1455337

5    -1.0048894 -1.0048894 0.1111111 0.02757773 0.8888889 0.2206219

6    -1.1447378 -1.1447378 0.2500000 0.05837031 0.7500000 0.1751109

7    -0.7050085 -0.7050085 0.1403509 0.02075841 0.8596491 0.1271453

8    -0.4108945 -0.4108945 0.2444444 0.06462287 0.7555556 0.1997434

9    -1.2600766 -1.2600766 0.2882883 0.04950456 0.7117117 0.1222144

10   -0.8448568 -0.8448568 0.2115385 0.06300857 0.7884615 0.2348501

11   -1.2990034 -1.2990034 0.2972973 0.08162202 0.7027027 0.1929248

12   -0.5968784 -0.5968784 0.2678571 0.06940916 0.7321429 0.1897184

13   -1.2168245 -1.2168245 0.2191781 0.05839243 0.7808219 0.2080230

14   -0.6401304 -0.6401304 0.1944444 0.04158896 0.8055556 0.1722971

15   -0.9587539 -0.9587539 0.1914894 0.04964154 0.8085106 0.2095976

16   -1.0755345 -1.0755345 0.2787879 0.05747249 0.7212121 0.1486788

17   -0.6848242 -0.6848242 0.2717949 0.07162122 0.7282051 0.1918908

18   -1.4215509 -1.4215509 0.2413793 0.06951627 0.7586207 0.2184797

Centrality Score Distributions

library(ggplot2)

x %>% select(-Name)%>%

  gather()%>% ggplot(aes(value))+

  geom_histogram()+

  facet_wrap(~key, scales = "free")+

  ggtitle("Centrality Distributions")

Centrality Measure Correlations

library(corrplot)

temp <- x %>% select(Total_Degrees,in_Degrees,Out_Degrees, eigen, eigen.rc, eigen.dc, Bonach_Power) %>% cor() 



temp


              Total_Degrees  in_Degrees  Out_Degrees      eigen

Total_Degrees     1.0000000  0.39262202  0.951760560  0.4898144

in_Degrees        0.3926220  1.00000000  0.091479857  0.8976743

Out_Degrees       0.9517606  0.09147986  1.000000000  0.2308543

eigen             0.4898144  0.89767426  0.230854298  1.0000000

eigen.rc          0.4138993  0.57257367  0.257121131  0.6628988

eigen.dc          0.4276075  0.86168397  0.175507168  0.9493956

Bonach_Power     -0.1269956 -0.38933451 -0.007610095 -0.1159809

                eigen.rc    eigen.dc Bonach_Power

Total_Degrees  0.4138993  0.42760750 -0.126995572

in_Degrees     0.5725737  0.86168397 -0.389334506

Out_Degrees    0.2571211  0.17550717 -0.007610095

eigen          0.6628988  0.94939557 -0.115980915

eigen.rc       1.0000000  0.39419648 -0.228543837

eigen.dc       0.3941965  1.00000000 -0.046490413

Bonach_Power  -0.2285438 -0.04649041  1.000000000
corrplot(temp)

Citation

For attribution, please cite this work as

Sullivan (2022, Feb. 17). Project List: Monk Monastery Network. Retrieved from https://pjsulliv34.github.io/Blog/posts/monk-monastery-network/

BibTeX citation

@misc{sullivan2022monk,
  author = {Sullivan, Peter},
  title = {Project List: Monk Monastery Network},
  url = {https://pjsulliv34.github.io/Blog/posts/monk-monastery-network/},
  year = {2022}
}