library(tidyverse)
library(igraph)                    # This is the package to analyze the network
library(visNetwork)                # Creates visualizations of the network
library(DT)
library(plotly)

Assignment. You have a choice for this assignment. You can do an analysis of the 9/11 terrorists that is similar to what we did above. Or, if you like Game of Thrones or are tired of terrorists, you can do an analysis of the characters in one of the Game of Thrones books.

Option 1: Sept. 11 terrorists. The data are in Sept11_nodes.csv and Sept11_links.csv.

Option 2: I have a dataset from the third book in the Game of Thrones series called “Storm of Swords.” The creators of the data found characters who appeared near each other in the text of the novel. (People have often applied network analysis to fictional worlds from movies and books, like Harry Potter or the Marvel Universe. Statisticians with too much free time, I guess.) The data are in the files got_nodes.csv and got_links.csv. The data are a little different because, instead of id numbers, the id column has names, and the edge data also have names rather than numbers. That should not effect your analysis, and it’s easier to read when you look at the data. (You might also notice that I have HP_nodes and HP_links, which are from Harry Potter. If you really wanted to, you could use those data instead.)

In either case, do the following:

  1. Read the data into links and nodes, and create the network in igraph with graph_from_data_frame().
  2. Find the density of the network.
  3. Make a histogram of the distances in the network.
  4. Find the legnth of the diameter of the network.
  5. Mutate the following into the nodes data: label, title, degree, and set value = degree.
  6. Mutate betweenness into the links data, and set it to value.
  7. Create a diagram with visNetwork, with a title and options set for a menu and highlightNearest.
  8. Find the communities in the network, mutate a group column in the nodes data, and create another diagram displaying the colored groups.
got_nodes <- read_csv("got_nodes.csv")
Parsed with column specification:
cols(
  id = col_character(),
  name = col_character()
)
got_links <- read_csv("got_links.csv")
Parsed with column specification:
cols(
  from = col_character(),
  to = col_character()
)
got_nodes %>% 
  datatable(rownames = F)

terrorist_links %>% 
  datatable(rownames = F)
visNetwork(got_nodes, got_links)

part 1

got_network <- graph_from_data_frame(got_links, 
                                           vertices = got_nodes, 
                                           directed = F)
got_network
IGRAPH b284051 UN-- 104 292 -- 
+ attr: name (v/c)
+ edges from b284051 (vertex names):
 [1] Aemon  --Grenn     Aemon  --Samwell   Aerys  --Jaime     Aerys  --Robert    Aerys  --Tyrion    Aerys  --Tywin    
 [7] Alliser--Mance     Amory  --Oberyn    Arya   --Anguy     Arya   --Beric     Arya   --Bran      Arya   --Brynden  
[13] Arya   --Cersei    Arya   --Gendry    Arya   --Gregor    Jaime  --Arya      Arya   --Joffrey   Arya   --Jon      
[19] Arya   --Rickon    Arya   --Roose     Arya   --Sandor    Arya   --Thoros    Tyrion --Arya      Belwas --Barristan
[25] Belwas --Illyrio   Beric  --Thoros    Bran   --Hodor     Bran   --Jojen     Bran   --Jon       Bran   --Meera    
[31] Bran   --Nan       Bran   --Rickon    Samwell--Bran      Bran   --Theon     Brienne--Loras     Gregor --Bronn    
[37] Bronn  --Podrick   Brynden--Walder    Brienne--Catelyn   Brynden--Catelyn   Catelyn--Edmure    Catelyn--Hoster   
[43] Jaime  --Catelyn   Catelyn--Jeyne     Catelyn--Lysa      Catelyn--Petyr     Catelyn--Robb      Catelyn--Roslin   
+ ... omitted several edges

part 2

got_network %>% 
  edge_density()
[1] 0.0545183
got_network %>% 
  distances() %>% 
  datatable()

part 3

got_network %>% 
  distances() %>% 
  as.vector() %>%              # these two lines convert the distances matrix
  as_tibble() %>%              # to something plotly can graph
  plot_ly(x = ~value) %>% 
  add_histogram()

part 4

got_network %>% 
  get_diameter()
+ 7/104 vertices, named, from b284051:
[1] Amory   Oberyn  Tyrion  Robert  Jon     Craster Karl

part 5

got_nodes <- got_nodes %>%
  mutate(degree = degree(got_network))


got_nodes %>% 
  arrange(-degree) %>% 
  datatable()
got_nodes <- got_nodes %>% 
  mutate(title = name)

got_nodes
NA

part 6

got_network %>% 
  edge_betweenness()
  [1]   1.500000  19.265826  21.532035  39.007359  31.151407  11.309199   8.472821 103.000000 103.000000  44.400289
 [11]  62.788654  47.506671  29.109657  70.399725  61.966888  65.641031  43.374377 238.121087  19.909765 103.000000
 [21]  23.130070  69.703571 138.388529  91.256410 103.000000   1.915873  26.136929  57.353391  81.659848  57.353391
 [31] 103.000000  12.574152  69.629044  10.575097   7.274336  17.616667   4.377778   5.621569   9.199455  19.489733
 [41]   9.350866  55.278170  45.394601  30.215829  20.047946   4.837302  36.525360  72.593986  43.617953  95.154893
 [51]  21.024899  15.761053   7.482404  23.619300  10.435459  10.942410  13.280532  58.976219   7.473200  18.663496
 [61] 103.000000   1.666667 103.000000   8.500000 107.256410  97.690476  97.690476 100.333333  34.151220 103.000000
 [71] 103.000000 103.000000  18.939560 945.372228  52.023206 103.000000 103.000000  15.588650  38.770851  39.657787
 [81]  50.011694  17.869115  31.714128  94.120857  16.898245  27.378154  92.320970  15.047953  32.350623  16.752349
 [91]   7.083878  19.503380   6.141876   1.333333   2.000000  26.567994  11.132359   6.892609  40.315942  20.280098
[101]  13.504040  13.504040  21.841876   1.666667  33.137121  22.889827  69.257625  25.339400  16.314396  25.827184
[111]  28.644502 103.000000  26.848147 176.317997  89.002044  67.656546  43.777284  30.702691  56.048681  13.127773
[121]  30.245718  14.163178  15.056049  15.750518  95.897711  24.603184  73.625626  32.554509  31.755297   1.000000
[131]  37.755267  82.234174  67.603463 156.135014  95.166667  78.067507  97.486523  69.331676  73.400889  71.642641
[141] 103.000000  77.734174  93.833333 467.943624  61.005016 126.903106  95.666667  46.035983  95.166667  93.833333
[151]  32.475072  86.583008  29.317887   5.487179   4.309524   4.309524 103.000000   5.586830   3.181818  16.696537
[161]  28.346620  14.571068   7.571592  14.571068  85.624405   8.666667   6.833333   4.333333   4.000000   5.833333
[171]   7.333333   6.833333   5.833333  37.755267  47.047597  26.732771   2.763889   7.102289 103.000000   3.424242
[181]   2.333333   6.931424   7.013971   4.153846  46.369673  39.637120 145.704314   9.245506  42.895733  42.814394
[191]  61.898047  34.276013  38.817305  57.189194  86.645755  67.180793  72.784171  57.225632 312.159439  98.000000
[201]  32.412862 103.000000  22.001412  68.576124  43.817566 152.173694  87.072467  66.843474 202.920451 123.360219
[211]  46.951319  37.198319  86.247651  18.599159  18.765826  42.597481  26.959624  21.932493  19.078066  31.266941
[221]  88.299972  30.713889  63.227575 139.482863  21.878968  14.596181  34.743048  27.544750  65.985159  26.697240
[231]  42.195138  38.064288  88.428932  86.303463  25.779575  40.552054  32.187781 213.190505  88.428932  30.644124
[241]  46.536280  54.518308   4.343240 103.000000 255.952403  45.672186  37.236091 144.123419   9.254870  81.672222
[251] 103.000000 103.000000  87.435012  21.457218  65.484452 187.778676  71.542749  43.611897  68.329762  47.357207
[261]  39.195728 175.384898  46.512669  41.543055  70.050974  39.011244 263.897255  56.140293 154.534473  64.100974
[271]  27.048485  11.241995  12.548144  21.411735  17.787172  37.356133  31.245996  84.723402  23.492265  32.949026
[281] 126.730577  68.575989  13.888600  31.635623   1.000000  50.976794   5.000000  14.604148  10.902633 103.000000
[291]   2.333333   1.000000
got_links <- got_links %>% 
  mutate(betweenness = edge_betweenness(got_network)) %>% 
  mutate(value = betweenness)

got_links

part 7

got_nodes <- got_nodes %>% 
  mutate(group = membership(infomap.community(got_network)))

got_nodes %>% 
  datatable()



visNetwork(got_nodes, 
           got_links, 
           main = "Network of game of thrones characters") %>% 
  visIgraphLayout(layout = "layout_nicely") %>% 
  visOptions(highlightNearest = T, nodesIdSelection = T, selectedBy = "group")

NA
Ci0tLQp0aXRsZTogIkludHJvZHVjdGlvbiB0byBOZXR3b3JrIEFuYWx5c2lzIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoaWdyYXBoKSAgICAgICAgICAgICAgICAgICAgIyBUaGlzIGlzIHRoZSBwYWNrYWdlIHRvIGFuYWx5emUgdGhlIG5ldHdvcmsKbGlicmFyeSh2aXNOZXR3b3JrKSAgICAgICAgICAgICAgICAjIENyZWF0ZXMgdmlzdWFsaXphdGlvbnMgb2YgdGhlIG5ldHdvcmsKbGlicmFyeShEVCkKbGlicmFyeShwbG90bHkpCmBgYAoKQXNzaWdubWVudC4gWW91IGhhdmUgYSBjaG9pY2UgZm9yIHRoaXMgYXNzaWdubWVudC4gWW91IGNhbiBkbyBhbiBhbmFseXNpcyBvZiB0aGUgOS8xMSB0ZXJyb3Jpc3RzIHRoYXQgaXMgc2ltaWxhciB0byB3aGF0IHdlIGRpZCBhYm92ZS4gT3IsIGlmIHlvdSBsaWtlIEdhbWUgb2YgVGhyb25lcyBvciBhcmUgdGlyZWQgb2YgdGVycm9yaXN0cywgeW91IGNhbiBkbyBhbiBhbmFseXNpcyBvZiB0aGUgY2hhcmFjdGVycyBpbiBvbmUgb2YgdGhlIEdhbWUgb2YgVGhyb25lcyBib29rcy4KCgpPcHRpb24gMTogU2VwdC4gMTEgdGVycm9yaXN0cy4gVGhlIGRhdGEgYXJlIGluIFNlcHQxMV9ub2Rlcy5jc3YgYW5kIFNlcHQxMV9saW5rcy5jc3YuCgoKT3B0aW9uIDI6ICBJIGhhdmUgYSBkYXRhc2V0IGZyb20gdGhlIHRoaXJkIGJvb2sgaW4gdGhlIEdhbWUgb2YgVGhyb25lcyBzZXJpZXMgY2FsbGVkICJTdG9ybSBvZiBTd29yZHMuIiBUaGUgY3JlYXRvcnMgb2YgdGhlIGRhdGEgZm91bmQgY2hhcmFjdGVycyB3aG8gYXBwZWFyZWQgbmVhciBlYWNoIG90aGVyIGluIHRoZSB0ZXh0IG9mIHRoZSBub3ZlbC4gKFBlb3BsZSBoYXZlIG9mdGVuIGFwcGxpZWQgbmV0d29yayBhbmFseXNpcyB0byBmaWN0aW9uYWwgd29ybGRzIGZyb20gbW92aWVzIGFuZCBib29rcywgbGlrZSBIYXJyeSBQb3R0ZXIgb3IgdGhlIE1hcnZlbCBVbml2ZXJzZS4gU3RhdGlzdGljaWFucyB3aXRoIHRvbyBtdWNoIGZyZWUgdGltZSwgSSBndWVzcy4pIFRoZSBkYXRhIGFyZSBpbiB0aGUgZmlsZXMgZ290X25vZGVzLmNzdiBhbmQgZ290X2xpbmtzLmNzdi4gVGhlIGRhdGEgYXJlIGEgbGl0dGxlIGRpZmZlcmVudCBiZWNhdXNlLCBpbnN0ZWFkIG9mIGlkIG51bWJlcnMsIHRoZSBpZCBjb2x1bW4gaGFzIG5hbWVzLCBhbmQgdGhlIGVkZ2UgZGF0YSBhbHNvIGhhdmUgbmFtZXMgcmF0aGVyIHRoYW4gbnVtYmVycy4gVGhhdCBzaG91bGQgbm90IGVmZmVjdCB5b3VyIGFuYWx5c2lzLCBhbmQgaXQncyBlYXNpZXIgdG8gcmVhZCB3aGVuIHlvdSBsb29rIGF0IHRoZSBkYXRhLiAoWW91IG1pZ2h0IGFsc28gbm90aWNlIHRoYXQgSSBoYXZlIEhQX25vZGVzIGFuZCBIUF9saW5rcywgd2hpY2ggYXJlIGZyb20gSGFycnkgUG90dGVyLiBJZiB5b3UgcmVhbGx5IHdhbnRlZCB0bywgeW91IGNvdWxkIHVzZSB0aG9zZSBkYXRhIGluc3RlYWQuKQoKCkluIGVpdGhlciBjYXNlLCBkbyB0aGUgZm9sbG93aW5nOgoKMS4gUmVhZCB0aGUgZGF0YSBpbnRvIGxpbmtzIGFuZCBub2RlcywgYW5kIGNyZWF0ZSB0aGUgbmV0d29yayBpbiBpZ3JhcGggd2l0aCBncmFwaF9mcm9tX2RhdGFfZnJhbWUoKS4gIAoyLiBGaW5kIHRoZSBkZW5zaXR5IG9mIHRoZSBuZXR3b3JrLiAgCjMuIE1ha2UgYSBoaXN0b2dyYW0gb2YgdGhlIGRpc3RhbmNlcyBpbiB0aGUgbmV0d29yay4gIAo0LiBGaW5kIHRoZSBsZWdudGggb2YgdGhlIGRpYW1ldGVyIG9mIHRoZSBuZXR3b3JrLiAgCjUuIE11dGF0ZSB0aGUgZm9sbG93aW5nIGludG8gdGhlIG5vZGVzIGRhdGE6IGxhYmVsLCB0aXRsZSwgZGVncmVlLCBhbmQgc2V0IHZhbHVlID0gZGVncmVlLiAgCjYuIE11dGF0ZSBiZXR3ZWVubmVzcyBpbnRvIHRoZSBsaW5rcyBkYXRhLCBhbmQgc2V0IGl0IHRvIHZhbHVlLiAgCjcuIENyZWF0ZSBhIGRpYWdyYW0gd2l0aCB2aXNOZXR3b3JrLCB3aXRoIGEgdGl0bGUgYW5kIG9wdGlvbnMgc2V0IGZvciBhIG1lbnUgYW5kIGhpZ2hsaWdodE5lYXJlc3QuICAKOC4gRmluZCB0aGUgY29tbXVuaXRpZXMgaW4gdGhlIG5ldHdvcmssIG11dGF0ZSBhIGdyb3VwIGNvbHVtbiBpbiB0aGUgbm9kZXMgZGF0YSwgYW5kIGNyZWF0ZSBhbm90aGVyIGRpYWdyYW0gZGlzcGxheWluZyB0aGUgY29sb3JlZCBncm91cHMuCgpgYGB7cn0KZ290X25vZGVzIDwtIHJlYWRfY3N2KCJnb3Rfbm9kZXMuY3N2IikKZ290X2xpbmtzIDwtIHJlYWRfY3N2KCJnb3RfbGlua3MuY3N2IikKZ290X25vZGVzICU+JSAKICBkYXRhdGFibGUocm93bmFtZXMgPSBGKQp0ZXJyb3Jpc3RfbGlua3MgJT4lIAogIGRhdGF0YWJsZShyb3duYW1lcyA9IEYpCmBgYApgYGB7cn0KdmlzTmV0d29yayhnb3Rfbm9kZXMsIGdvdF9saW5rcykKYGBgCnBhcnQgMQpgYGB7cn0KZ290X25ldHdvcmsgPC0gZ3JhcGhfZnJvbV9kYXRhX2ZyYW1lKGdvdF9saW5rcywgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2ZXJ0aWNlcyA9IGdvdF9ub2RlcywgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBkaXJlY3RlZCA9IEYpCmdvdF9uZXR3b3JrCgpgYGAKcGFydCAyCmBgYHtyfQpnb3RfbmV0d29yayAlPiUgCiAgZWRnZV9kZW5zaXR5KCkKYGBgCgpgYGB7cn0KZ290X25ldHdvcmsgJT4lIAogIGRpc3RhbmNlcygpICU+JSAKICBkYXRhdGFibGUoKQpgYGAKcGFydCAzCmBgYHtyfQpnb3RfbmV0d29yayAlPiUgCiAgZGlzdGFuY2VzKCkgJT4lIAogIGFzLnZlY3RvcigpICU+JSAgICAgICAgICAgICAgIyB0aGVzZSB0d28gbGluZXMgY29udmVydCB0aGUgZGlzdGFuY2VzIG1hdHJpeAogIGFzX3RpYmJsZSgpICU+JSAgICAgICAgICAgICAgIyB0byBzb21ldGhpbmcgcGxvdGx5IGNhbiBncmFwaAogIHBsb3RfbHkoeCA9IH52YWx1ZSkgJT4lIAogIGFkZF9oaXN0b2dyYW0oKQpgYGAKCnBhcnQgNApgYGB7cn0KZ290X25ldHdvcmsgJT4lIAogIGdldF9kaWFtZXRlcigpCgpgYGAKCnBhcnQgNQpgYGB7cn0KZ290X25vZGVzIDwtIGdvdF9ub2RlcyAlPiUKICBtdXRhdGUoZGVncmVlID0gZGVncmVlKGdvdF9uZXR3b3JrKSkKCgpnb3Rfbm9kZXMgJT4lIAogIGFycmFuZ2UoLWRlZ3JlZSkgJT4lIAogIGRhdGF0YWJsZSgpCmBgYAoKYGBge3J9CmdvdF9ub2RlcyA8LSBnb3Rfbm9kZXMgJT4lIAogIG11dGF0ZSh0aXRsZSA9IG5hbWUpCgpnb3Rfbm9kZXMKCmBgYAoKcGFydCA2CmBgYHtyfQpnb3RfbmV0d29yayAlPiUgCiAgZWRnZV9iZXR3ZWVubmVzcygpCmdvdF9saW5rcyA8LSBnb3RfbGlua3MgJT4lIAogIG11dGF0ZShiZXR3ZWVubmVzcyA9IGVkZ2VfYmV0d2Vlbm5lc3MoZ290X25ldHdvcmspKSAlPiUgCiAgbXV0YXRlKHZhbHVlID0gYmV0d2Vlbm5lc3MpCgpnb3RfbGlua3MKYGBgCgpwYXJ0IDcKYGBge3J9CmdvdF9ub2RlcyA8LSBnb3Rfbm9kZXMgJT4lIAogIG11dGF0ZShncm91cCA9IG1lbWJlcnNoaXAoaW5mb21hcC5jb21tdW5pdHkoZ290X25ldHdvcmspKSkKCmdvdF9ub2RlcyAlPiUgCiAgZGF0YXRhYmxlKCkKCgp2aXNOZXR3b3JrKGdvdF9ub2RlcywgCiAgICAgICAgICAgZ290X2xpbmtzLCAKICAgICAgICAgICBtYWluID0gIk5ldHdvcmsgb2YgZ2FtZSBvZiB0aHJvbmVzIGNoYXJhY3RlcnMiKSAlPiUgCiAgdmlzSWdyYXBoTGF5b3V0KGxheW91dCA9ICJsYXlvdXRfbmljZWx5IikgJT4lIAogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFQsIG5vZGVzSWRTZWxlY3Rpb24gPSBULCBzZWxlY3RlZEJ5ID0gImdyb3VwIikKCmBgYA==