library(readr)
library(igraph)
Bimodal (bipartite) networks
Part 1. Create a toy bimodal network
bi_data = read_csv("/Users/macbook/Desktop/NETWORKS/Seminar6/imbd_bidata.csv")
bi_matrix = as.matrix(table(bi_data))
# Convert the matrix to a bipartitie network using graph.incidence() command
bi_gr = graph.incidence(bi_matrix)
#V(bi_gr)$type
shape = ifelse(V(bi_gr)$type, "circle", "square") # assign shape by node type
col = ifelse(V(bi_gr)$type, "lightcoral", "lightblue") # assign color by node type
Bipartite graph
plot(bi_gr,
vertex.shape = shape,
vertex.color = col,
vertex.label.size = 0.5,
vertex.size = 5,
edge.arrow.size = 1)

plot(bi_gr,
vertex.shape = shape,
layout = layout_as_bipartite(bi_gr),
vertex.color = col,
vertex.label = "",
vertex.size = 5,
edge.arrow.size = 1)

plot(bi_gr,
vertex.shape = shape,
layout = layout_with_kk(bi_gr),
vertex.color = col,
vertex.label.size = degree(bi_gr),
vertex.size = 5,
edge.arrow.size = 1)

Projections
matrix_row <- bi_matrix %*% t(bi_matrix) #creates adjacency matrix of rows
matrix_column <- t(bi_matrix) %*% bi_matrix #creates adjacency matrix of columns
# Projection for raws -> directors of films
bi_graph_row <- graph_from_adjacency_matrix(matrix_row,
mode = "undirected",
diag = FALSE,
weighted=TRUE)
e<-E(bi_graph_row)$weight
Graph for directors
plot(bi_graph_row,
layout = layout_with_kk(bi_graph_row),
vertex.shape = shape,
vertex.color = col,
vertex.size = 5,
vertex.label.size = 0.4,
edge.width = e)

There are several connections between directors that means they
work with the same production companies. The weight between nodes means
that some directors more often work with the similar particular
companies.
# Projection for columns -> production companies of films
bi_graph_column <- graph_from_adjacency_matrix(matrix_column,
mode = "undirected",
diag = FALSE,
weighted=TRUE)
e1<-E(bi_graph_column)$weight
Graph for production companies
plot(bi_graph_column,
layout = layout_with_kk(bi_graph_column),
vertex.shape = 'circle',
vertex.color = "lightcoral",
vertex.size = degree(bi_graph_column),
vertex.label.size = 0.4,
edge.width = e1)

We see that Paramount Pictures, Warner Bros. have the biggest
degree that means it is the most popular companies among directors. The
weight between nodes means that some companies more often work with the
same directors.
LS0tCnRpdGxlOiAiUHJhY3RpY2UgNiIKYXV0aG9yOiAiQW5hc3Rhc2lhIE11cmFjaCIKZGF0ZTogIjUvMjEvMjAyMiIKb3V0cHV0OgogIGh0bWxfbm90ZWJvb2sKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQprbml0cjo6b3B0c19jaHVuayRzZXQobWVzc2FnZT1GQUxTRSkKa25pdHI6Om9wdHNfY2h1bmskc2V0KHdhcm5pbmc9RkFMU0UpCmBgYAoKYGBge3J9CmxpYnJhcnkocmVhZHIpCmxpYnJhcnkoaWdyYXBoKQpgYGAKCiMjIyBCaW1vZGFsIChiaXBhcnRpdGUpIG5ldHdvcmtzICMjIwoKUGFydCAxLiBDcmVhdGUgYSB0b3kgYmltb2RhbCBuZXR3b3JrCmBgYHtyfQpiaV9kYXRhID0gcmVhZF9jc3YoIi9Vc2Vycy9tYWNib29rL0Rlc2t0b3AvTkVUV09SS1MvU2VtaW5hcjYvaW1iZF9iaWRhdGEuY3N2IikKYmlfbWF0cml4ID0gYXMubWF0cml4KHRhYmxlKGJpX2RhdGEpKSAKYGBgCgpgYGB7cn0KIyBDb252ZXJ0IHRoZSBtYXRyaXggdG8gYSBiaXBhcnRpdGllIG5ldHdvcmsgdXNpbmcgZ3JhcGguaW5jaWRlbmNlKCkgY29tbWFuZApiaV9nciA9IGdyYXBoLmluY2lkZW5jZShiaV9tYXRyaXgpCmBgYAogCmBgYHtyfQojVihiaV9ncikkdHlwZSAgCnNoYXBlID0gaWZlbHNlKFYoYmlfZ3IpJHR5cGUsICJjaXJjbGUiLCAic3F1YXJlIikgIyBhc3NpZ24gc2hhcGUgYnkgbm9kZSB0eXBlCmNvbCA9IGlmZWxzZShWKGJpX2dyKSR0eXBlLCAibGlnaHRjb3JhbCIsICJsaWdodGJsdWUiKSAjIGFzc2lnbiBjb2xvciBieSBub2RlIHR5cGUKYGBgCgojIyMgQmlwYXJ0aXRlIGdyYXBoCmBgYHtyLCBmaWcud2lkdGg9MTAsIGZpZy5oZWlnaHQ9MTB9CnBsb3QoYmlfZ3IsIAogICAgIHZlcnRleC5zaGFwZSA9IHNoYXBlLCAgCiAgICAgdmVydGV4LmNvbG9yID0gY29sLCAKICAgICB2ZXJ0ZXgubGFiZWwuc2l6ZSA9IDAuNSwKICAgICB2ZXJ0ZXguc2l6ZSA9IDUsCiAgICAgZWRnZS5hcnJvdy5zaXplID0gMSkKYGBgCgpgYGB7ciwgZmlnLndpZHRoPTUsIGZpZy5oZWlnaHQ9NX0KcGxvdChiaV9nciwgCiAgICAgdmVydGV4LnNoYXBlID0gc2hhcGUsIAogICAgIGxheW91dCA9IGxheW91dF9hc19iaXBhcnRpdGUoYmlfZ3IpLAogICAgIHZlcnRleC5jb2xvciA9IGNvbCwgCiAgICAgdmVydGV4LmxhYmVsID0gIiIsCiAgICAgdmVydGV4LnNpemUgPSA1LAogICAgIGVkZ2UuYXJyb3cuc2l6ZSA9IDEpCmBgYAoKYGBge3IsIGZpZy53aWR0aD01LCBmaWcuaGVpZ2h0PTV9CnBsb3QoYmlfZ3IsIAogICAgIHZlcnRleC5zaGFwZSA9IHNoYXBlLCAKICAgICBsYXlvdXQgPSBsYXlvdXRfd2l0aF9rayhiaV9nciksCiAgICAgdmVydGV4LmNvbG9yID0gY29sLCAKICAgICB2ZXJ0ZXgubGFiZWwuc2l6ZSA9IGRlZ3JlZShiaV9nciksCiAgICAgdmVydGV4LnNpemUgPSA1LAogICAgIGVkZ2UuYXJyb3cuc2l6ZSA9IDEpCmBgYAoKIyMjIFByb2plY3Rpb25zCmBgYHtyfQptYXRyaXhfcm93IDwtIGJpX21hdHJpeCAlKiUgdChiaV9tYXRyaXgpICNjcmVhdGVzIGFkamFjZW5jeSBtYXRyaXggb2Ygcm93cwptYXRyaXhfY29sdW1uIDwtIHQoYmlfbWF0cml4KSAlKiUgYmlfbWF0cml4ICNjcmVhdGVzIGFkamFjZW5jeSBtYXRyaXggb2YgY29sdW1ucwpgYGAKCmBgYHtyfQojIFByb2plY3Rpb24gZm9yIHJhd3MgLT4gZGlyZWN0b3JzIG9mIGZpbG1zCmJpX2dyYXBoX3JvdyA8LSBncmFwaF9mcm9tX2FkamFjZW5jeV9tYXRyaXgobWF0cml4X3JvdywgICAKICAgICAgICAgICAgICAgICAgICAgICAgICBtb2RlID0gInVuZGlyZWN0ZWQiLAogICAgICAgICAgICAgICAgICAgICAgICAgIGRpYWcgPSBGQUxTRSwKICAgICAgICAgICAgICAgICAgICAgICAgICB3ZWlnaHRlZD1UUlVFKQpgYGAKCmBgYHtyfQplPC1FKGJpX2dyYXBoX3Jvdykkd2VpZ2h0CmBgYAoKIyMgR3JhcGggZm9yIGRpcmVjdG9ycwpgYGB7ciwgZmlnLndpZHRoPTgsIGZpZy5oZWlnaHQ9OH0KcGxvdChiaV9ncmFwaF9yb3csIAogICAgIGxheW91dCA9IGxheW91dF93aXRoX2trKGJpX2dyYXBoX3JvdyksCiAgICAgdmVydGV4LnNoYXBlID0gc2hhcGUsIAogICAgIHZlcnRleC5jb2xvciA9IGNvbCwgCiAgICAgdmVydGV4LnNpemUgPSA1LAogICAgIHZlcnRleC5sYWJlbC5zaXplID0gMC40LAogICAgIGVkZ2Uud2lkdGggPSBlKQpgYGAKCipUaGVyZSBhcmUgc2V2ZXJhbCBjb25uZWN0aW9ucyBiZXR3ZWVuIGRpcmVjdG9ycyB0aGF0IG1lYW5zIHRoZXkgd29yayB3aXRoIHRoZSBzYW1lIHByb2R1Y3Rpb24gY29tcGFuaWVzLiBUaGUgd2VpZ2h0IGJldHdlZW4gbm9kZXMgbWVhbnMgdGhhdCBzb21lIGRpcmVjdG9ycyBtb3JlIG9mdGVuIHdvcmsgd2l0aCB0aGUgc2ltaWxhciBwYXJ0aWN1bGFyIGNvbXBhbmllcy4qCgpgYGB7cn0KIyBQcm9qZWN0aW9uIGZvciBjb2x1bW5zIC0+IHByb2R1Y3Rpb24gY29tcGFuaWVzIG9mIGZpbG1zCmJpX2dyYXBoX2NvbHVtbiA8LSBncmFwaF9mcm9tX2FkamFjZW5jeV9tYXRyaXgobWF0cml4X2NvbHVtbiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1vZGUgPSAidW5kaXJlY3RlZCIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZGlhZyA9IEZBTFNFLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHdlaWdodGVkPVRSVUUpCmBgYAoKYGBge3J9CmUxPC1FKGJpX2dyYXBoX2NvbHVtbikkd2VpZ2h0CmBgYAoKIyMgR3JhcGggZm9yIHByb2R1Y3Rpb24gY29tcGFuaWVzCmBgYHtyLCBmaWcud2lkdGg9OCwgZmlnLmhlaWdodD04fQpwbG90KGJpX2dyYXBoX2NvbHVtbiwgCiAgICAgbGF5b3V0ID0gbGF5b3V0X3dpdGhfa2soYmlfZ3JhcGhfY29sdW1uKSwKICAgICB2ZXJ0ZXguc2hhcGUgPSAnY2lyY2xlJywgCiAgICAgdmVydGV4LmNvbG9yID0gImxpZ2h0Y29yYWwiLCAKICAgICB2ZXJ0ZXguc2l6ZSA9IGRlZ3JlZShiaV9ncmFwaF9jb2x1bW4pLAogICAgIHZlcnRleC5sYWJlbC5zaXplID0gMC40LAogICAgIGVkZ2Uud2lkdGggPSBlMSkKYGBgCgoqV2Ugc2VlIHRoYXQgUGFyYW1vdW50IFBpY3R1cmVzLCBXYXJuZXIgQnJvcy4gaGF2ZSB0aGUgYmlnZ2VzdCBkZWdyZWUgdGhhdCBtZWFucyBpdCBpcyB0aGUgbW9zdCBwb3B1bGFyIGNvbXBhbmllcyBhbW9uZyBkaXJlY3RvcnMuIFRoZSB3ZWlnaHQgYmV0d2VlbiBub2RlcyBtZWFucyB0aGF0IHNvbWUgY29tcGFuaWVzIG1vcmUgb2Z0ZW4gd29yayB3aXRoIHRoZSBzYW1lIGRpcmVjdG9ycy4qCg==