R Markdown for Social Network Analysis

by Daniel G. Lopes - danielgoncalveslopes@gmail.com

This is a R Markdown for Social Network Analysis.

In this document we will: 1) create a small network 2) covert it as a two-mode network to a one-mode network 3) calculate network and centrality measures 4) build a larger network

Let’s run igraph

library(igraph)

After run it using the commands library(igraph) and library(readr), let’s bring our data. This data is about contracts between physicians and hospitals in a small brazilian city called Jacupiranga.

It is diveded in two tables. The first table has 2 columns: one with physicians names and another with hospitals where they work. Let’s rename our columns and take a look at its first ten rows. This is what we call an edge list, i.e., a list of relations between nodes.

E_jacup <- read.csv2("C:/Users/Daniel/Desktop/Projetos/network/E_jacupiranga.csv")
colnames(E_jacup) <- c("physician", "hospital")
head(E_jacup, n=10)

The second tables is a node list, i.e., a list of every node in the network. Its first column register nodes’ names and the second column says if it is a physician or a hospital.

V_jacup <- read.csv2("C:/Users/Daniel/Desktop/Projetos/network/V_jacupiranga.csv")
colnames(V_jacup) <- c("name", "type")
head(V_jacup, n=10)

Let’s run out the network using the command graph_from_data_frame.

net_jacup <- graph_from_data_frame(d = E_jacup, vertices = V_jacup, directed = FALSE)
net_jacup

IGRAPH c450b59 UN-B 24 17 -- 
+ attr: name (v/c), type (v/c)
+ edges from c450b59 (vertex names):
[1] ANDRE LUIZ MARTINS MOREIRA                --UBS III DE JACUPIRANGA                     
[2] MAURICIO APARECIDO MARCOLINO              --PRONTO ATENDIMENTO MUNICIPAL DE JACUPIRANGA
[3] STEFANIE NORMANTON SOMBRIO                --PRONTO ATENDIMENTO MUNICIPAL DE JACUPIRANGA
[4] DANIELLE CRISTINA BONFIM DE OLIVEIRA SILVA--ESF LENCOL JACUPIRANGA                     
[5] ELIANE DE BRITO FIEDLER                   --UBS III DE JACUPIRANGA                     
[6] MICHEL CAMPS GIL                          --ESF GUARAU JACUPIRANGA                     
[7] ALBERTO CORREIA NETO                      --PRONTO ATENDIMENTO MUNICIPAL DE JACUPIRANGA
[8] TALLES COSTA NEIVA                        --PRONTO ATENDIMENTO MUNICIPAL DE JACUPIRANGA
+ ... omitted several edges

We don’t feel like a network unless we plot it:

plot(net_jacup)

Awful! Let’s try again without labels, with a small vertex size, and chosing a different color for physicians and hospitals.

V(net_jacup)$color <- ifelse(V(net_jacup)$type == "physician", "skyblue", "purple")
plot(net_jacup, vertex.label=NA, vertex.size=10)

Let’s transform this two-mode network to an one-mode network where nodes are physicians and ties are hospitals (physicians shared a tie if they work at the same hospital).

V(net_jacup)$type <- bipartite_mapping(net_jacup)$type 
net_jacup_matrix <- as_incidence_matrix(net_jacup)
net_jacup_matrix2 <- net_jacup_matrix %*% t(net_jacup_matrix)
diag(net_jacup_matrix2) <- 0
net_jacup_hosp <- graph_from_adjacency_matrix(net_jacup_matrix2, mode = "undirected", weighted = TRUE)

Let’s plot this one-mode network with a new layout and color.

newLayout <- layout_in_circle(net_jacup_hosp)
plot(net_jacup_hosp, vertex.label=NA, vertex.size=10, vertex.color="darkgreen", layout=newLayout)

After building our network now we can calculate a set of measures. First let’s take a look at measures at nodes’ level.

centralities <- data.frame(degree(net_jacup_hosp), betweenness(net_jacup_hosp), alpha.centrality(net_jacup_hosp), power_centrality(net_jacup_hosp))
colnames(centralities) <- c("degree", "betweenness", "alpha centrality", "power centrality")
centralities

Then, we can do the same for the network as a whole measures.

network_measures <- data.frame(edge_density(net_jacup_hosp), diameter(net_jacup_hosp), average.path.length(net_jacup_hosp), transitivity(net_jacup_hosp), reciprocity(net_jacup_hosp))
colnames(network_measures) <- c("density", "diameter", "average path length", "transitivity", "reciprocity")
network_measures

Now, we may chose one big city to take a better look. Osasco is a big city in the state of S?o Paulo.

E_osasco <- read.csv2("C:/Users/Daniel/Desktop/Projetos/network/E_osasco.csv")
colnames(E_osasco) <- c("physician", "hospital")
V_osasco <- read.csv2("C:/Users/Daniel/Desktop/Projetos/network/V_osasco.csv")
colnames(V_osasco) <- c("name", "type")

Let’s build a network between hospitals and physicians of Osasco. The data is also in a edgelist format, so R will consider the first and the second columns as nodes and will set a tie between them.

net_osasco <- graph_from_data_frame(d = E_osasco, directed = F, vertices = V_osasco)
V(net_osasco)$color <- ifelse(V(net_osasco)$type == "physician", "orange", "green")
plot(net_osasco, vertex.label=NA, vertex.size=7)

LS0tDQp0aXRsZTogIlIgTWFya2Rvd24gZm9yIFNvY2lhbCBOZXR3b3JrIEFuYWx5c2lzIg0Kb3V0cHV0Og0KICBodG1sX25vdGVib29rOiBkZWZhdWx0DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgZGZfcHJpbnQ6IHBhZ2VkDQogIHBkZl9kb2N1bWVudDogZGVmYXVsdA0KLS0tDQpieSBEYW5pZWwgRy4gTG9wZXMgLSBkYW5pZWxnb25jYWx2ZXNsb3Blc0BnbWFpbC5jb20NCg0KVGhpcyBpcyBhIFtSIE1hcmtkb3duXShodHRwOi8vcm1hcmtkb3duLnJzdHVkaW8uY29tKSBmb3IgU29jaWFsIE5ldHdvcmsgQW5hbHlzaXMuIA0KDQpJbiB0aGlzIGRvY3VtZW50IHdlIHdpbGw6DQoxKSBjcmVhdGUgYSBzbWFsbCBuZXR3b3JrDQoyKSBjb3ZlcnQgaXQgYXMgYSB0d28tbW9kZSBuZXR3b3JrIHRvIGEgb25lLW1vZGUgbmV0d29yaw0KMykgY2FsY3VsYXRlIG5ldHdvcmsgYW5kIGNlbnRyYWxpdHkgbWVhc3VyZXMNCjQpIGJ1aWxkIGEgbGFyZ2VyIG5ldHdvcmsNCg0KDQpMZXQncyBydW4gKmlncmFwaCoNCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkoaWdyYXBoKQ0KYGBgDQoNCkFmdGVyIHJ1biBpdCB1c2luZyB0aGUgY29tbWFuZHMgKmxpYnJhcnkoaWdyYXBoKSogYW5kICpsaWJyYXJ5KHJlYWRyKSosIGxldCdzIGJyaW5nIG91ciAqKmRhdGEqKi4gVGhpcyAgZGF0YSBpcyBhYm91dCBjb250cmFjdHMgYmV0d2VlbiBwaHlzaWNpYW5zIGFuZCBob3NwaXRhbHMgaW4gYSBzbWFsbCBicmF6aWxpYW4gY2l0eSBjYWxsZWQgSmFjdXBpcmFuZ2EuIA0KDQpJdCBpcyBkaXZlZGVkIGluIHR3byB0YWJsZXMuIFRoZSBmaXJzdCB0YWJsZSBoYXMgMiBjb2x1bW5zOiBvbmUgd2l0aCBwaHlzaWNpYW5zIG5hbWVzIGFuZCBhbm90aGVyIHdpdGggaG9zcGl0YWxzIHdoZXJlIHRoZXkgd29yay4gTGV0J3MgcmVuYW1lIG91ciBjb2x1bW5zIGFuZCB0YWtlIGEgbG9vayBhdCBpdHMgZmlyc3QgdGVuIHJvd3MuIFRoaXMgaXMgd2hhdCB3ZSBjYWxsIGFuICoqZWRnZSBsaXN0KiosIGkuZS4sIGEgbGlzdCBvZiByZWxhdGlvbnMgYmV0d2VlbiBub2Rlcy4NCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCkVfamFjdXAgPC0gcmVhZC5jc3YyKCJDOi9Vc2Vycy9EYW5pZWwvRGVza3RvcC9Qcm9qZXRvcy9uZXR3b3JrL0VfamFjdXBpcmFuZ2EuY3N2IikNCmNvbG5hbWVzKEVfamFjdXApIDwtIGMoInBoeXNpY2lhbiIsICJob3NwaXRhbCIpDQpoZWFkKEVfamFjdXAsIG49MTApDQpgYGANCg0KVGhlIHNlY29uZCB0YWJsZXMgaXMgYSAqKm5vZGUgbGlzdCoqLCBpLmUuLCBhIGxpc3Qgb2YgZXZlcnkgbm9kZSBpbiB0aGUgbmV0d29yay4gSXRzIGZpcnN0IGNvbHVtbiByZWdpc3RlciBub2RlcycgbmFtZXMgYW5kIHRoZSBzZWNvbmQgY29sdW1uIHNheXMgaWYgaXQgaXMgYSBwaHlzaWNpYW4gb3IgYSBob3NwaXRhbC4NCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NClZfamFjdXAgPC0gcmVhZC5jc3YyKCJDOi9Vc2Vycy9EYW5pZWwvRGVza3RvcC9Qcm9qZXRvcy9uZXR3b3JrL1ZfamFjdXBpcmFuZ2EuY3N2IikNCmNvbG5hbWVzKFZfamFjdXApIDwtIGMoIm5hbWUiLCAidHlwZSIpDQpoZWFkKFZfamFjdXAsIG49MTApDQpgYGANCg0KTGV0J3MgcnVuIG91dCB0aGUgbmV0d29yayB1c2luZyB0aGUgY29tbWFuZCAqKmdyYXBoX2Zyb21fZGF0YV9mcmFtZSoqLg0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KbmV0X2phY3VwIDwtIGdyYXBoX2Zyb21fZGF0YV9mcmFtZShkID0gRV9qYWN1cCwgdmVydGljZXMgPSBWX2phY3VwLCBkaXJlY3RlZCA9IEZBTFNFKQ0KbmV0X2phY3VwDQpgYGANCg0KV2UgZG9uJ3QgZmVlbCBsaWtlIGEgbmV0d29yayB1bmxlc3Mgd2UgcGxvdCBpdDoNCg0KYGBge3J9DQpwbG90KG5ldF9qYWN1cCkNCmBgYA0KDQpBd2Z1bCEgTGV0J3MgdHJ5IGFnYWluICoqd2l0aG91dCBsYWJlbHMqKiwgd2l0aCBhICoqc21hbGwgdmVydGV4IHNpemUqKiwgYW5kIGNob3NpbmcgYSBkaWZmZXJlbnQgY29sb3IgZm9yIHBoeXNpY2lhbnMgYW5kIGhvc3BpdGFscy4NCg0KYGBge3J9DQpWKG5ldF9qYWN1cCkkY29sb3IgPC0gaWZlbHNlKFYobmV0X2phY3VwKSR0eXBlID09ICJwaHlzaWNpYW4iLCAic2t5Ymx1ZSIsICJwdXJwbGUiKQ0KcGxvdChuZXRfamFjdXAsIHZlcnRleC5sYWJlbD1OQSwgdmVydGV4LnNpemU9MTApDQoNCmBgYA0KDQpMZXQncyB0cmFuc2Zvcm0gdGhpcyB0d28tbW9kZSBuZXR3b3JrIHRvIGFuIG9uZS1tb2RlIG5ldHdvcmsgd2hlcmUgbm9kZXMgYXJlIHBoeXNpY2lhbnMgYW5kIHRpZXMgYXJlIGhvc3BpdGFscyAocGh5c2ljaWFucyBzaGFyZWQgYSB0aWUgaWYgdGhleSB3b3JrIGF0IHRoZSBzYW1lIGhvc3BpdGFsKS4NCg0KYGBge3J9DQpWKG5ldF9qYWN1cCkkdHlwZSA8LSBiaXBhcnRpdGVfbWFwcGluZyhuZXRfamFjdXApJHR5cGUgDQpuZXRfamFjdXBfbWF0cml4IDwtIGFzX2luY2lkZW5jZV9tYXRyaXgobmV0X2phY3VwKQ0KbmV0X2phY3VwX21hdHJpeDIgPC0gbmV0X2phY3VwX21hdHJpeCAlKiUgdChuZXRfamFjdXBfbWF0cml4KQ0KZGlhZyhuZXRfamFjdXBfbWF0cml4MikgPC0gMA0KbmV0X2phY3VwX2hvc3AgPC0gZ3JhcGhfZnJvbV9hZGphY2VuY3lfbWF0cml4KG5ldF9qYWN1cF9tYXRyaXgyLCBtb2RlID0gInVuZGlyZWN0ZWQiLCB3ZWlnaHRlZCA9IFRSVUUpDQpgYGANCg0KTGV0J3MgcGxvdCB0aGlzIG9uZS1tb2RlIG5ldHdvcmsgd2l0aCBhIG5ldyBsYXlvdXQgYW5kIGNvbG9yLg0KDQpgYGB7cn0NCm5ld0xheW91dCA8LSBsYXlvdXRfaW5fY2lyY2xlKG5ldF9qYWN1cF9ob3NwKQ0KcGxvdChuZXRfamFjdXBfaG9zcCwgdmVydGV4LmxhYmVsPU5BLCB2ZXJ0ZXguc2l6ZT0xMCwgdmVydGV4LmNvbG9yPSJkYXJrZ3JlZW4iLCBsYXlvdXQ9bmV3TGF5b3V0KQ0KYGBgDQoNCkFmdGVyIGJ1aWxkaW5nIG91ciBuZXR3b3JrIG5vdyB3ZSBjYW4gY2FsY3VsYXRlIGEgc2V0IG9mIG1lYXN1cmVzLiBGaXJzdCBsZXQncyB0YWtlIGEgbG9vayBhdCBtZWFzdXJlcyBhdCBub2RlcycgbGV2ZWwuDQoNCmBgYHtyfQ0KY2VudHJhbGl0aWVzIDwtIGRhdGEuZnJhbWUoZGVncmVlKG5ldF9qYWN1cF9ob3NwKSwgYmV0d2Vlbm5lc3MobmV0X2phY3VwX2hvc3ApLCBhbHBoYS5jZW50cmFsaXR5KG5ldF9qYWN1cF9ob3NwKSwgcG93ZXJfY2VudHJhbGl0eShuZXRfamFjdXBfaG9zcCkpDQpjb2xuYW1lcyhjZW50cmFsaXRpZXMpIDwtIGMoImRlZ3JlZSIsICJiZXR3ZWVubmVzcyIsICJhbHBoYSBjZW50cmFsaXR5IiwgInBvd2VyIGNlbnRyYWxpdHkiKQ0KY2VudHJhbGl0aWVzDQpgYGANCg0KVGhlbiwgd2UgY2FuIGRvIHRoZSBzYW1lIGZvciB0aGUgbmV0d29yayBhcyBhIHdob2xlIG1lYXN1cmVzLg0KDQpgYGB7cn0NCm5ldHdvcmtfbWVhc3VyZXMgPC0gZGF0YS5mcmFtZShlZGdlX2RlbnNpdHkobmV0X2phY3VwX2hvc3ApLCBkaWFtZXRlcihuZXRfamFjdXBfaG9zcCksIGF2ZXJhZ2UucGF0aC5sZW5ndGgobmV0X2phY3VwX2hvc3ApLCB0cmFuc2l0aXZpdHkobmV0X2phY3VwX2hvc3ApLCByZWNpcHJvY2l0eShuZXRfamFjdXBfaG9zcCkpDQpjb2xuYW1lcyhuZXR3b3JrX21lYXN1cmVzKSA8LSBjKCJkZW5zaXR5IiwgImRpYW1ldGVyIiwgImF2ZXJhZ2UgcGF0aCBsZW5ndGgiLCAidHJhbnNpdGl2aXR5IiwgInJlY2lwcm9jaXR5IikNCm5ldHdvcmtfbWVhc3VyZXMNCmBgYA0KDQpOb3csIHdlIG1heSBjaG9zZSBvbmUgYmlnIGNpdHkgdG8gdGFrZSBhIGJldHRlciBsb29rLiBPc2FzY28gaXMgYSBiaWcgY2l0eSBpbiB0aGUgc3RhdGUgb2YgUz9vIFBhdWxvLg0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KRV9vc2FzY28gPC0gcmVhZC5jc3YyKCJDOi9Vc2Vycy9EYW5pZWwvRGVza3RvcC9Qcm9qZXRvcy9uZXR3b3JrL0Vfb3Nhc2NvLmNzdiIpDQpjb2xuYW1lcyhFX29zYXNjbykgPC0gYygicGh5c2ljaWFuIiwgImhvc3BpdGFsIikNClZfb3Nhc2NvIDwtIHJlYWQuY3N2MigiQzovVXNlcnMvRGFuaWVsL0Rlc2t0b3AvUHJvamV0b3MvbmV0d29yay9WX29zYXNjby5jc3YiKQ0KY29sbmFtZXMoVl9vc2FzY28pIDwtIGMoIm5hbWUiLCAidHlwZSIpDQpgYGANCg0KDQpMZXQncyBidWlsZCBhIG5ldHdvcmsgYmV0d2VlbiBob3NwaXRhbHMgYW5kIHBoeXNpY2lhbnMgb2YgT3Nhc2NvLiBUaGUgZGF0YSBpcyBhbHNvIGluIGEgZWRnZWxpc3QgZm9ybWF0LCBzbyBSIHdpbGwgY29uc2lkZXIgdGhlIGZpcnN0IGFuZCB0aGUgc2Vjb25kIGNvbHVtbnMgYXMgbm9kZXMgYW5kIHdpbGwgc2V0IGEgdGllIGJldHdlZW4gdGhlbS4NCg0KYGBge3J9DQpuZXRfb3Nhc2NvIDwtIGdyYXBoX2Zyb21fZGF0YV9mcmFtZShkID0gRV9vc2FzY28sIGRpcmVjdGVkID0gRiwgdmVydGljZXMgPSBWX29zYXNjbykNClYobmV0X29zYXNjbykkY29sb3IgPC0gaWZlbHNlKFYobmV0X29zYXNjbykkdHlwZSA9PSAicGh5c2ljaWFuIiwgIm9yYW5nZSIsICJncmVlbiIpDQpwbG90KG5ldF9vc2FzY28sIHZlcnRleC5sYWJlbD1OQSwgdmVydGV4LnNpemU9NykNCmBgYA0KDQoNCg0K