Network Analysis: Monk Data Set

Investigate the Network

plot(network_igraph)

plot(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

We have 18 nodes with 88 edges, and a directed network.

Weighted, Directed, and Bipartile?

is_bipartite(network_igraph)

[1] FALSE

is_directed(network_igraph)

[1] TRUE

is_weighted(network_igraph)

[1] FALSE

Looking at Igraph and Statnet, I have confirmed that this is a single mode, directed, and unweighted dataset.

Dyads, Triads, and Component Structure

Dyads and Triads

sna::dyad.census(network_statnet)

     Mut Asym Null
[1,]  28   32   93

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 average transitivity is slightly higher than the global transitivity. This could be do to certain small clusters with high transitivity.

Component Structure

igraph::components(network_igraph)$no

[1] 1

igraph::components(network_igraph)$csize

[1] 18

isolates(network_statnet)

integer(0)

From the componenet structure and after verifying with the plot of the network, we have no isolates in the network.

Dataframe of Centrality Scores

network::list.vertex.attributes(network_statnet)

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

network.nodes <- data.frame(name = network_statnet%v%"vertex.names",
                            totdegree = sna::degree(network_statnet),
                            in.degree = sna::degree(network_statnet, cmode = "indegree"),
                            out.degree = sna::degree(network_statnet, cmode = "outdegree"),
                            eigen = round(sna::evcent(network_statnet),3),
                            Bonacich.Power = round(sna::bonpow(network_statnet),3))

rownames(network.nodes)<- NULL
network.nodes %>% arrange(desc(eigen)) %>% head() %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power
Boniface	9	3	6	0.298	-0.845
John Bosco	17	11	6	0.288	-1.422
Simplicius	9	3	6	0.275	-1.299
Victor	11	5	6	0.266	-1.217
Gregory	15	10	5	0.264	-0.685
Albert	8	3	5	0.264	-0.411

network.nodes %>% arrange(desc(Bonacich.Power)) %>% head() %>%knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power
Ambrose	8	4	4	0.190	-0.322
Albert	8	3	5	0.264	-0.411
Mark	11	6	5	0.259	-0.597
Winfrid	11	7	4	0.214	-0.640
Gregory	15	10	5	0.264	-0.685
Amand	8	5	3	0.148	-0.705

Boniface and John Bosco have the highest eigen centrality. Even though Boniface only has 9 total degress while john bosco has 17 degrees. When looking at Bonacich Power, Ambrose and Alber seem to have the highest at -.3 and -.411.

Derived and Reflected Centrality

## Reflected Centrality
mat_flor <- as.matrix(as_adjacency_matrix(network_igraph))
mat_flor.sq <- t(mat_flor) %*% mat_flor

network.nodes$rc <- round(diag(mat_flor.sq)/rowSums(mat_flor.sq),3)

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

network.nodes$eigen.rc <- round(network.nodes$eigen*network.nodes$rc,3)

## Derived Centrality


network.nodes$dc <- round(1 - diag(mat_flor.sq)/rowSums(mat_flor.sq),3)

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

network.nodes$eigen.dc <- round(network.nodes$eigen*network.nodes$dc,3)


network.nodes%>%arrange(desc(eigen.dc)) %>% head() %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc
Boniface	9	3	6	0.298	-0.845	0.200	0.060	0.800	0.238
John Bosco	17	11	6	0.288	-1.422	0.196	0.056	0.804	0.232
Victor	11	5	6	0.266	-1.217	0.192	0.051	0.808	0.215
Gregory	15	10	5	0.264	-0.685	0.192	0.051	0.808	0.213
Hugh	11	6	5	0.259	-0.959	0.188	0.049	0.812	0.210
Albert	8	3	5	0.264	-0.411	0.214	0.056	0.786	0.208

network.nodes%>%arrange(desc(eigen.rc)) %>% head() %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc
Simplicius	9	3	6	0.275	-1.299	0.250	0.069	0.750	0.206
Boniface	9	3	6	0.298	-0.845	0.200	0.060	0.800	0.238
John Bosco	17	11	6	0.288	-1.422	0.196	0.056	0.804	0.232
Albert	8	3	5	0.264	-0.411	0.214	0.056	0.786	0.208
Mark	11	6	5	0.259	-0.597	0.207	0.054	0.793	0.205
Gregory	15	10	5	0.264	-0.685	0.192	0.051	0.808	0.213

For derived centrality the highest are Boniface and John Bosco. For received centrality, Samplicuius, Boniface and JOhn Bosco are at the top. John Bosco and Boniface must have some real pull in this monk group.

Calculate Closeness Centrality

network.nodes$closeness<-round(sna::closeness(network_statnet, gmode = "graph", cmode = "suminvundir"),3)

network.nodes %>% arrange(desc(closeness)) %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc	closeness
John Bosco	17	11	6	0.288	-1.422	0.196	0.056	0.804	0.232	0.824
Gregory	15	10	5	0.264	-0.685	0.192	0.051	0.808	0.213	0.794
Bonaventure	13	8	5	0.206	-1.076	0.211	0.043	0.789	0.163	0.735
Mark	11	6	5	0.259	-0.597	0.207	0.054	0.793	0.205	0.735
Victor	11	5	6	0.266	-1.217	0.192	0.051	0.808	0.215	0.735
Boniface	9	3	6	0.298	-0.845	0.200	0.060	0.800	0.238	0.706
Albert	8	3	5	0.264	-0.411	0.214	0.056	0.786	0.208	0.706
Winfrid	11	7	4	0.214	-0.640	0.194	0.042	0.806	0.172	0.696
Romauld	8	2	6	0.248	-1.005	0.200	0.050	0.800	0.198	0.676
Amand	8	5	3	0.148	-0.705	0.192	0.028	0.808	0.120	0.676
Hugh	11	6	5	0.259	-0.959	0.188	0.049	0.812	0.210	0.676
Ambrose	8	4	4	0.190	-0.322	0.190	0.036	0.810	0.154	0.647
Simplicius	9	3	6	0.275	-1.299	0.250	0.069	0.750	0.206	0.647
Berthold	6	2	4	0.171	-1.057	0.200	0.034	0.800	0.137	0.637
Basil	8	3	5	0.231	-1.378	0.188	0.043	0.812	0.188	0.618
Louis	8	3	5	0.233	-1.145	0.214	0.050	0.786	0.183	0.618
Peter	9	5	4	0.172	-1.260	0.192	0.033	0.808	0.139	0.608
Elias	6	2	4	0.183	-1.045	0.182	0.033	0.818	0.150	0.578

summary(network.nodes$closeness)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.5780  0.6395  0.6760  0.6840  0.7278  0.8240

John Bosco is at the higest closeness centrality. This would be expected with such high received and derived centrality. Surpirsingly Boniface is not as close to the other nodes as John bosco.

Closeness Centralization

centr_clo(network_igraph)$centralization

[1] 0.0919023

I’m a bit confused why the closeness centraliztion is so much lower then average closeness seen above.

Betweenness Centrality

#igraph::betweenness(network_igraph, directed = FALSE)
network.nodes$betweenness <-round(sna::betweenness(network_statnet, gmode = "graph"),3)
network.nodes %>% arrange(desc(betweenness)) %>% head() %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc	closeness	betweenness
John Bosco	17	11	6	0.288	-1.422	0.196	0.056	0.804	0.232	0.824	34.477
Bonaventure	13	8	5	0.206	-1.076	0.211	0.043	0.789	0.163	0.735	19.374
Victor	11	5	6	0.266	-1.217	0.192	0.051	0.808	0.215	0.735	18.075
Mark	11	6	5	0.259	-0.597	0.207	0.054	0.793	0.205	0.735	11.576
Basil	8	3	5	0.231	-1.378	0.188	0.043	0.812	0.188	0.618	11.068
Amand	8	5	3	0.148	-0.705	0.192	0.028	0.808	0.120	0.676	10.127

John Bosco has the highest closeness and the highest betweeness. This means that the John is receiving information the fastest out of all the familys and is also relied upon most in the network for for information.

Betweenness Centralization

centr_betw(network_igraph, directed = F)$centralization

[1] 0.1177914

Network Constraint

network.nodes$Constraint <- round(constraint(network_igraph),3)

network.nodes %>% arrange(desc(Constraint)) %>% head() %>% knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc	closeness	betweenness	Constraint
Elias	6	2	4	0.183	-1.045	0.182	0.033	0.818	0.150	0.578	0.000	0.553
Basil	8	3	5	0.231	-1.378	0.188	0.043	0.812	0.188	0.618	11.068	0.445
Simplicius	9	3	6	0.275	-1.299	0.250	0.069	0.750	0.206	0.647	4.337	0.411
Berthold	6	2	4	0.171	-1.057	0.200	0.034	0.800	0.137	0.637	1.088	0.401
Boniface	9	3	6	0.298	-0.845	0.200	0.060	0.800	0.238	0.706	2.158	0.381
Peter	9	5	4	0.172	-1.260	0.192	0.033	0.808	0.139	0.608	4.676	0.372

network.nodes %>% arrange(Constraint) %>% head() %>%knitr::kable()

name	totdegree	in.degree	out.degree	eigen	Bonacich.Power	rc	eigen.rc	dc	eigen.dc	closeness	betweenness	Constraint
John Bosco	17	11	6	0.288	-1.422	0.196	0.056	0.804	0.232	0.824	34.477	0.227
Bonaventure	13	8	5	0.206	-1.076	0.211	0.043	0.789	0.163	0.735	19.374	0.229
Victor	11	5	6	0.266	-1.217	0.192	0.051	0.808	0.215	0.735	18.075	0.245
Ambrose	8	4	4	0.190	-0.322	0.190	0.036	0.810	0.154	0.647	4.004	0.276
Louis	8	3	5	0.233	-1.145	0.214	0.050	0.786	0.183	0.618	5.577	0.285
Hugh	11	6	5	0.259	-0.959	0.188	0.049	0.812	0.210	0.676	7.135	0.301

The highest network constraint is elias and basil. The lowes in network constraint is John Bosco, which is expected. He seems able to receive info the easiest.

Gould-Fernandez Brokerage

get.brokerage<-function(net, attr="cloisterville"){
  temp<-data.frame( brokerage(net, cl = net%v%attr)$z.nli)
  temp$name=net%v%"vertex.names"
  mutate(temp, broker.tot = temp$t,
         broker.coord = temp$w_I,
         broker.itin = temp$w_O,
         broker.rep = temp$b_IO,
         broker.gate = temp$b_OI,
         broker.lia = temp$b_O)%>%
    select(contains("broker"))
}

get.brokerage(network_statnet) %>% rownames_to_column("name")

          name broker.tot broker.coord broker.itin  broker.rep
1   John Bosco  2.5964290    3.9787056   0.9531624  1.34213764
2      Gregory  0.7552935    0.5615213   0.5881516  0.74093491
3        Basil -1.3024462   -0.8053524  -1.4194080 -0.16086918
4        Peter -0.6526337   -0.8053524  -0.1418701 -0.46147054
5  Bonaventure  1.0801998    0.5615213   0.7706570  0.44033355
6     Berthold -1.4107483   -1.3476951  -0.3975765 -0.82792897
7         Mark -0.1111232   -0.8053524   0.5881516 -0.46147054
8       Victor  0.5386893   -0.1000454   0.1203852  0.89174396
9      Ambrose -0.5443316    0.1078962  -0.9155381 -0.82792897
10     Romauld -0.9775400   -0.9318119  -0.9155381 -0.82792897
11       Louis -0.6526337   -0.9318119  -0.9155381 -0.54131681
12     Winfrid -0.8692379   -0.9318119  -0.3975765  0.03190749
13       Amand -0.7609358   -1.1397535   0.6383469  0.03190749
14        Hugh -0.1111232    0.3158378  -0.9155381  0.03190749
15    Boniface -1.1941441   -1.1397535  -0.3975765 -0.25470466
16      Albert -0.6526337   -0.7238703  -0.9155381  0.60513180
17       Elias -1.7356546   -1.3476951  -0.9155381 -1.11454112
18  Simplicius -0.9775400   -1.1397535  -0.3975765  0.31851965
   broker.gate broker.lia
1   2.54454309        NaN
2   0.13973219        NaN
3  -0.76207190        NaN
4  -0.76207190        NaN
5   1.04153628        NaN
6  -0.82792897        NaN
7  -0.46147054        NaN
8   0.60513180        NaN
9  -0.25470466        NaN
10  0.03190749        NaN
11  0.60513180        NaN
12 -0.82792897        NaN
13 -0.82792897        NaN
14 -0.25470466        NaN
15 -1.11454112        NaN
16 -0.82792897        NaN
17 -1.11454112        NaN
18 -1.11454112        NaN

network.nodes

          name totdegree in.degree out.degree eigen Bonacich.Power
1   John Bosco        17        11          6 0.288         -1.422
2      Gregory        15        10          5 0.264         -0.685
3        Basil         8         3          5 0.231         -1.378
4        Peter         9         5          4 0.172         -1.260
5  Bonaventure        13         8          5 0.206         -1.076
6     Berthold         6         2          4 0.171         -1.057
7         Mark        11         6          5 0.259         -0.597
8       Victor        11         5          6 0.266         -1.217
9      Ambrose         8         4          4 0.190         -0.322
10     Romauld         8         2          6 0.248         -1.005
11       Louis         8         3          5 0.233         -1.145
12     Winfrid        11         7          4 0.214         -0.640
13       Amand         8         5          3 0.148         -0.705
14        Hugh        11         6          5 0.259         -0.959
15    Boniface         9         3          6 0.298         -0.845
16      Albert         8         3          5 0.264         -0.411
17       Elias         6         2          4 0.183         -1.045
18  Simplicius         9         3          6 0.275         -1.299
      rc eigen.rc    dc eigen.dc closeness betweenness Constraint
1  0.196    0.056 0.804    0.232     0.824      34.477      0.227
2  0.192    0.051 0.808    0.213     0.794       9.104      0.302
3  0.188    0.043 0.812    0.188     0.618      11.068      0.445
4  0.192    0.033 0.808    0.139     0.608       4.676      0.372
5  0.211    0.043 0.789    0.163     0.735      19.374      0.229
6  0.200    0.034 0.800    0.137     0.637       1.088      0.401
7  0.207    0.054 0.793    0.205     0.735      11.576      0.307
8  0.192    0.051 0.808    0.215     0.735      18.075      0.245
9  0.190    0.036 0.810    0.154     0.647       4.004      0.276
10 0.200    0.050 0.800    0.198     0.676       3.076      0.312
11 0.214    0.050 0.786    0.183     0.618       5.577      0.285
12 0.194    0.042 0.806    0.172     0.696       2.513      0.365
13 0.192    0.028 0.808    0.120     0.676      10.127      0.321
14 0.188    0.049 0.812    0.210     0.676       7.135      0.301
15 0.200    0.060 0.800    0.238     0.706       2.158      0.381
16 0.214    0.056 0.786    0.208     0.706       4.134      0.314
17 0.182    0.033 0.818    0.150     0.578       0.000      0.553
18 0.250    0.069 0.750    0.206     0.647       4.337      0.411

network.nodes<-full_join(network.nodes,get.brokerage(network_statnet)%>% rownames_to_column("name"), by ="name")

Calculate Structural Equivalence**

network.se<-equiv.clust(network_statnet, equiv.fun="sedist", method="hamming",mode="graph")
network.se

Position Clustering:

    Equivalence function: sedist 
    Equivalence metric: hamming 
    Cluster method: complete 
    Graph order: 18

summary(network.se)

               Length Class  Mode     
cluster         7     hclust list     
metric          1     -none- character
equiv.fun       1     -none- character
cluster.method  1     -none- character
glabels        18     -none- character
plabels        18     -none- character

plot(network.se)

Equivalence Clustering

plot(network.se,labels=network.se$glabels)

Average Cluster Method

#with average cluster.method
netork.avg.se<-equiv.clust(network_statnet, equiv.fun="sedist", cluster.method="average", method="hamming",mode="graph")

#plot:
plot(netork.avg.se,labels=network.se$glabels)

Single Cluster Method

#with single cluster.method
network.sing.se<-equiv.clust(network_statnet, equiv.fun="sedist", cluster.method="single", method="hamming",mode="graph")

#plot:
plot(network.sing.se,labels=network.se$glabels)

Ward D cluster

#with ward.D cluster.method
network.wrd.se<-equiv.clust(network_statnet, equiv.fun="sedist", cluster.method="ward.D", method="hamming",mode="graph")

#plot:
plot(network.wrd.se,labels=network.se$glabels)

Partition a Matrix Using Clustering**

#plot equivalence clustering
plot(network.se,labels=network.se$glabels)
#partition the clusters
rect.hclust(network.se$cluster,h=15)

Alternatively, we could set the height at 10, and identify 4 distinct clusters or roles.

#plot equivalence clustering
plot(network.se,labels=network.se$glabels)
#partition the clusters
rect.hclust(network.se$cluster,h=10)

Block Models

blk_mod <- blockmodel(network_statnet, network.se, k =2)
blk_mod


Network Blockmodel:

Block membership:

 John Bosco     Gregory       Basil       Peter Bonaventure 
          1           1           1           2           2 
   Berthold        Mark      Victor     Ambrose     Romauld 
          2           1           2           2           2 
      Louis     Winfrid       Amand        Hugh    Boniface 
          2           1           1           1           1 
     Albert       Elias  Simplicius 
          1           1           1 

Reduced form blockmodel:

     John Bosco Gregory Basil Peter Bonaventure Berthold Mark Victor Ambrose Romauld Louis Winfrid Amand Hugh Boniface Albert Elias Simplicius 
          Block 1    Block 2
Block 1 0.4363636 0.07792208
Block 2 0.1428571 0.54761905

plot(blk_mod)

plot.block<-function(x=blk_mod, main=NULL, cex.lab=1){
  plot.sociomatrix(x$blocked.data, labels=list(x$plabels,x$plabels),
                   main=main, drawlines = FALSE, cex.lab=cex.lab)
  for (j in 2:length(x$plabels)) if (x$block.membership[j] !=
                                     x$block.membership[j-1]) 
    abline(v = j - 0.5, h = j - 0.5, lty = 3, xpd=FALSE)
}



plot.block(blk_mod, main ="Monk Data Set: 2 Partitions", cex.lab = .5)

Network Roles

#assign block membership to vertex attribute
blk_mod<-blockmodel(network_statnet,network.se,k=5)
V(network_igraph)$role<-blk_mod$block.membership[match(V(network_igraph)$name,blk_mod$plabels)]
network_statnet%v%"role"<-blk_mod$block.membership[match(network_statnet%v%"vertex.names", blk_mod$glabels)]



GGally::ggnet2(network_statnet,
               node.color="role", 
               node.size=degree(network_igraph),
               node.label = "vertex.names",
               node.alpha = .5)

plot.igraph(network_igraph, 
            vertex.color=V(network_igraph)$role,
            vertex.size=8+(igraph::degree(network_igraph)*4))

Comparing Network Role and Centrality

network.nodes$role <- V(network_igraph)$role
network.nodes$role

NULL

Structural Equivalence: Weighted

library(blockmodeling)
monks.mat <- as.matrix(as_adj(network_igraph, attr = "nominations"))
monks.mat %>% head()

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,]    0    1    2    0    2    0    0    1    0     0     0     1
[2,]    3    0    0    0    0    0    3    0    0     0     0     2
[3,]    3    1    0    0    0    0    0    0    0     0     0     0
[4,]    0    0    0    0    3    3    0    0    0     1     2     0
[5,]    1    0    0    3    0    0    0    0    1     0     3     0
[6,]    2    0    0    3    1    0    0    0    3     0     0     0
     [,13] [,14] [,15] [,16] [,17] [,18]
[1,]     0     2     0     0     0     0
[2,]     0     1     1     0     0     0
[3,]     1     0     0     0     3     2
[4,]     0     0     0     0     0     0
[5,]     1     0     0     0     0     0
[6,]     0     0     0     0     0     0

monks.sedist <- sedist(monks.mat)
monks.se <- equiv.clust(network_statnet, equiv.dist =  monks.sedist)
monks.se

Position Clustering:

    Equivalence function: sedist 
    Equivalence metric: hamming 
    Cluster method: complete 
    Graph order: 18

Optimized Based Partitions

blks <- blockmodeling::optRandomParC(monks.mat, k = 5, rep =10, approaches = "ss", blocks = "com")



Starting optimization of the partiton 1 of 10 partitions.
Starting partition: 5 5 1 4 5 5 3 5 5 5 5 5 5 5 5 5 2 5 
Final error: 173.0167 
Final partition:    4 4 1 5 5 5 3 5 5 5 5 4 2 4 4 3 1 1 


Starting optimization of the partiton 2 of 10 partitions.
Starting partition: 1 2 4 4 2 4 5 2 4 1 5 5 5 3 3 1 4 2 
Final error: 161.1333 
Final partition:    1 1 4 5 5 2 3 2 2 2 2 3 2 3 3 3 4 4 


Starting optimization of the partiton 3 of 10 partitions.
Starting partition: 1 2 5 5 3 1 3 5 3 5 4 1 4 2 3 2 1 4 
Final error: 167.1806 
Final partition:    2 2 4 5 5 3 2 5 3 3 3 1 4 1 1 1 4 4 


Starting optimization of the partiton 4 of 10 partitions.
Starting partition: 4 3 4 2 4 3 5 3 3 5 1 5 1 1 4 2 2 1 
Final error: 184.9653 
Final partition:    5 5 4 1 1 4 2 4 4 4 1 3 4 3 3 2 4 4 


Starting optimization of the partiton 5 of 10 partitions.
Starting partition: 1 1 4 4 5 1 2 4 3 4 2 5 3 3 5 1 5 2 
Final error: 164.3375 
Final partition:    4 4 3 2 5 5 1 5 2 5 2 1 2 1 1 1 3 3 


Starting optimization of the partiton 6 of 10 partitions.
Starting partition: 4 3 4 4 4 4 4 4 4 5 2 4 4 1 4 4 4 4 
Final error: 182.0952 
Final partition:    2 2 4 1 1 3 4 5 5 3 3 4 3 4 4 4 4 4 


Starting optimization of the partiton 7 of 10 partitions.
Starting partition: 4 4 4 4 4 4 4 4 5 4 3 4 4 4 2 4 1 4 
Final error: 203.1722 
Final partition:    4 4 4 1 1 2 4 5 5 3 2 4 3 4 4 4 4 4 


Starting optimization of the partiton 8 of 10 partitions.
Starting partition: 2 5 2 3 5 1 1 1 1 1 4 3 1 4 4 4 4 2 
Final error: 161.1333 
Final partition:    5 5 2 4 4 3 1 3 3 3 3 1 3 1 1 1 2 2 


Starting optimization of the partiton 9 of 10 partitions.
Starting partition: 5 1 1 4 3 4 3 3 5 2 2 4 1 3 2 4 5 1 
Final error: 161.1333 
Final partition:    5 5 1 3 3 4 2 4 4 4 4 2 4 2 2 2 1 1 


Starting optimization of the partiton 10 of 10 partitions.
Starting partition: 5 1 1 1 1 1 1 4 1 1 1 1 3 1 1 1 1 2 
Final error: 164.3375 
Final partition:    5 5 3 2 4 4 1 4 2 4 2 1 2 1 1 1 3 3 


Optimization of all partitions completed
1 solution(s) with minimal error = 161.1333 found.

blk_mod <- blockmodel(network_statnet, blks$best$best1$clu, plabels = rownames(monks.mat))

blk_mod$block.model

           Block 1    Block 2 Block 3    Block 4   Block 5
Block 1 1.00000000 0.06666667    0.00 0.16666667 0.8333333
Block 2 0.00000000 0.60000000    0.10 0.06666667 1.0000000
Block 3 0.00000000 0.00000000    1.00 0.50000000 0.2500000
Block 4 0.05555556 0.20000000    0.75 0.30000000 0.2500000
Block 5 0.16666667 0.60000000    0.25 0.08333333 1.0000000

plot.block(blk_mod, main = "Monks, Optimized 5 Partitions", cex.lab = .5)

network_statnet%v%"role"<-blk_mod$block.membership[match(network_statnet%v%"vertex.names",blk_mod$plabels)]
#plot network using "role" to color nodes
GGally::ggnet2(network_statnet,
               node.color="role", 
                node.size = sna::degree(network_statnet, gmode = "graph"),
               node.label = "vertex.names",
               node.alpha = .5)

Regular Equivalence

#calculate equivalence from specified distance marix
network.re<-equiv.clust(network_statnet, equiv.fun="redist", method="catrege", mode="graph")
#plot equivalence clustering
plot(network.re,labels=network.se$glabels)