Project List: Network Analysis: Monk Data Set

Peter Sullivan

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)

Network Analysis: Monk Data Set