Introduction

Bipartite networks are a particular class of complex networks, whose nodes are divided into two sets X and Y, and only connections between two nodes in different sets are allowed. For the convenience of directly showing the relation structure among a particular set of nodes, bipartite networks are usually compressed by one-mode projection. This means that the ensuing network contains nodes of only either of the two sets, and two X (or, alternatively, Y) nodes are connected only if when they have at least one common neighboring Y (or, alternatively, X) node. (Wikipedia)

There is a lot of algorithms to create one-mode projection. One of them is shared nearest neighbor in case of weighted and unweighted graphs as well. Connection number between xi and xj nodes are equal with common links with all yk in a graph G = (X, Y, E), where every xi ∈ X and every yj ∈ Y as different set of nodes connected with E: edges.

Let see how can it done in R.

Setup

library(igraph)

Create a bipartite graph from adjacency matrix

A <- matrix(c(2,0,0,0,0,2,
              0,0,0,0,2,2,
              0,0,0,0,3,2,
              0,0,0,0,0,6,
              2,2,3,5,4,2,
              6,4,3,0,0,0,
              0,0,3,1,0,0,
              0,0,0,2,2,1,
              0,0,2,3,0,0,
              0,2,2,0,0,0), 
            nrow=10, ncol=6, byrow = T)
rownames(A) <- paste("x", 1:10, sep="")
colnames(A) <- paste("y", 1:6, sep="")
g <- graph.incidence(A, weighted = T)
V(g)$color <- V(g)$type
V(g)$color=gsub("FALSE","#00cc00",V(g)$color) #color of x
V(g)$color=gsub("TRUE","#ff9900",V(g)$color) #color of y
plot(g, edge.color="gray80", edge.width=E(g)$weight, vertex.size=20, vertex.label.cex=0.9, layout=layout_as_bipartite, margin=0, asp=0.8)

SNN projection of “X” side

Q <- A

snn.proj <- matrix(0, nrow=nrow(Q), ncol=nrow(Q))
rownames(snn.proj) <- rownames(Q)
colnames(snn.proj) <- rownames(Q)

pairs <- t(combn(1:nrow(Q), 2))

for (i in 1:nrow(pairs)){
  num <- sum(sapply(1:ncol(Q), function(x)(min(Q[pairs[i,1],x],Q[pairs[i,2],x]))))
  snn.proj[pairs[i,1],pairs[i,2]] <- num
  snn.proj[pairs[i,2],pairs[i,1]] <- num  
}

HL.proj <- snn.proj
rm(snn.proj)

Adjacency matrix of “X” side

HL.proj
##     x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
## x1   0  2  2  2  4  2  0  1  0   0
## x2   2  0  4  2  4  0  0  3  0   0
## x3   2  4  0  2  5  0  0  3  0   0
## x4   2  2  2  0  2  0  0  1  0   0
## x5   4  4  5  2  0  7  4  5  5   4
## x6   2  0  0  0  7  0  3  0  2   4
## x7   0  0  0  0  4  3  0  1  3   2
## x8   1  3  3  1  5  0  1  0  2   0
## x9   0  0  0  0  5  2  3  2  0   2
## x10  0  0  0  0  4  4  2  0  2   0

Projected graph

g.HL.proj <- graph.adjacency(HL.proj, weighted = T, mode="undirected")
V(g.HL.proj)$color <- "#00cc00"
plot(g.HL.proj, edge.color="gray80", edge.width=E(g.HL.proj)$weight, vertex.size=20, vertex.label.cex=0.9)

SNN projection of “Y” side

Q <- t(A)

snn.proj <- matrix(0, nrow=nrow(Q), ncol=nrow(Q))
rownames(snn.proj) <- rownames(Q)
colnames(snn.proj) <- rownames(Q)

pairs <- t(combn(1:nrow(Q), 2))

for (i in 1:nrow(pairs)){
  num <- sum(sapply(1:ncol(Q), function(x)(min(Q[pairs[i,1],x],Q[pairs[i,2],x]))))
  snn.proj[pairs[i,1],pairs[i,2]] <- num
  snn.proj[pairs[i,2],pairs[i,1]] <- num  
}

LL.proj <- snn.proj
rm(snn.proj)

Adjacency matrix of “Y” side

LL.proj
##    y1 y2 y3 y4 y5 y6
## y1  0  6  5  2  2  4
## y2  6  0  7  2  2  2
## y3  5  7  0  6  3  2
## y4  2  2  6  0  6  3
## y5  2  2  3  6  0  7
## y6  4  2  2  3  7  0

Projected graph

g.LL.proj <- graph.adjacency(LL.proj, weighted = T, mode="undirected")
V(g.LL.proj)$color <- "#ff9900"
plot(g.LL.proj, edge.color="gray80", edge.width=E(g.LL.proj)$weight, vertex.size=20, vertex.label.cex=0.9)

See also: Network visualizations

Be happyR! :)