Load datas

nodes <- read.csv("NODES.csv", header=T, as.is=T)
links <- read.csv("EDGES.csv", header=T, as.is=T)

head(nodes)
##   id groupe  rh rate
## 1 O-      O Rh-  7.0
## 2 O+      O Rh+ 39.0
## 3 B-      B Rh-  1.5
## 4 B+      B Rh+  7.5
## 5 A-      A Rh-  6.0
## 6 A+      A Rh+ 36.0
head(links)
##   from  to    type
## 1   O- AB+ donne_a
## 2   O- AB- donne_a
## 3   O-  A+ donne_a
## 4   O-  A- donne_a
## 5   O-  B+ donne_a
## 6   O-  B- donne_a
nrow(nodes); length(unique(nodes$id))
## [1] 8
## [1] 8
nrow(links); nrow(unique(links[,c("from", "to")]))
## [1] 27
## [1] 27

Heatmap de repartition des groupes/Rh

Start networking datas

library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
colnames(links)[3] <- "type"

net <- graph_from_data_frame(d=links, vertices=nodes, directed=T) 

class(net)
## [1] "igraph"
net
## IGRAPH fadc364 DN-- 8 27 -- 
## + attr: name (v/c), groupe (v/c), rh (v/c), rate (v/n), type (e/c)
## + edges from fadc364 (vertex names):
##  [1] O- ->AB+ O- ->AB- O- ->A+  O- ->A-  O- ->B+  O- ->B-  O- ->O+ 
##  [8] O- ->O-  O+ ->AB+ O+ ->A+  O+ ->B+  O+ ->O+  B- ->AB+ B- ->AB-
## [15] B- ->B+  B- ->B-  B+ ->AB+ B+ ->B+  A- ->AB+ A- ->AB- A- ->A+ 
## [22] A- ->A-  A+ ->AB+ A+ ->A+  AB-->AB+ AB-->AB- AB+->AB+
E(net)
## + 27/27 edges from fadc364 (vertex names):
##  [1] O- ->AB+ O- ->AB- O- ->A+  O- ->A-  O- ->B+  O- ->B-  O- ->O+ 
##  [8] O- ->O-  O+ ->AB+ O+ ->A+  O+ ->B+  O+ ->O+  B- ->AB+ B- ->AB-
## [15] B- ->B+  B- ->B-  B+ ->AB+ B+ ->B+  A- ->AB+ A- ->AB- A- ->A+ 
## [22] A- ->A-  A+ ->AB+ A+ ->A+  AB-->AB+ AB-->AB- AB+->AB+
# keep loops as it is matching real life use cases
#net <- simplify(net, remove.multiple = F, remove.loops = T) 

plot(net, edge.arrow.size=.4, vertex.label.dist=3)

# base node size on rate
V(net)$rate
## [1]  7.0 39.0  1.5  7.5  6.0 36.0  0.5  2.5
degree(net, mode = "in")
##  O-  O+  B-  B+  A-  A+ AB- AB+ 
##   1   2   2   4   2   4   4   8
V(net)$size <- degree(net, mode = "in")*3
plot(net, edge.arrow.size=.4, vertex.label.dist=3, layout=layout.fruchterman.reingold)

Split (nodes shapes) by rhesus

# base node size on rate
V(net)[V(net)$rh == "Rh-"]$shape <- "square"
V(net)[V(net)$rh == "Rh+"]$shape <- "circle"
plot(net, edge.arrow.size=.4, vertex.label.dist=3, layout=layout.fruchterman.reingold)

Add color gradient

use colors from http://www.stat.columbia.edu/~tzheng/files/Rcolor.pdf

# base node color on rate
V(net)[V(net)$rate < 1]$color <- "black"
V(net)[(V(net)$rate >= 1) &  (V(net)$rate < 5)]$color <- "indianred4"
V(net)[(V(net)$rate >= 5) &  (V(net)$rate < 10)]$color <- "lightseagreen"
V(net)[V(net)$rate > 10 ]$color <- "pink"
#V(net)$color <- rainbow()
plot(net, edge.arrow.size=.4, vertex.label.dist=3,  layout=layout.fruchterman.reingold)


# Add a legend
# http://www.r-graph-gallery.com/119-add-a-legend-to-a-plot/
legend("bottomleft", 
  legend = c("Noir", "Group 2", "3", "4"), 
  col = c("pink","pink","pink","pink"), 
  pch = c(19,19, 19, 19), 
  bty = "n", 
  pt.cex = 2, 
  cex = 1.2, 
  text.col = "black", 
  horiz = F , 
  inset = c(0.1, 0.1))

legend("topright", 
  legend = c("Noir", "Group 2", "3", "4"), 
  col = c("pink","pink","pink","pink"), 
  pch = c(19,19, 19, 19), 
  bty = "n", 
  pt.cex = 2, 
  cex = 1.2, 
  text.col = "black", 
  horiz = F , 
  inset = c(0.1, 0.1))

Relations between rhesus (only)

Build two nodes : the Rh+ and the Rh-

List of nodes that are of Rh+ and can give to Rh-

# Liste des id de noeuds de rh+
#vertex_attr(net, V(net)$rh = "Rh+")
#vertex_attr(net, "rh")
nodesRhPlus = nodes[nodes$rh == "Rh+",]
nodesRhMinus = nodes[nodes$rh == "Rh-",]

# Liste des groupes rhesus+
nodesRhMinus$id
## [1] "O-"  "B-"  "A-"  "AB-"
# Liste des groupes rhesus-
nodesRhPlus$id
## [1] "O+"  "B+"  "A+"  "AB+"
# List of Rh+ go to Rh+
# function groupe->rhesus
rhesus_of_id <- function(id, nodes) {
result <- nodes[nodes$id == id,]$rh
return(result)
}

out <- rhesus_of_id("AB+", nodes)
out
## [1] "Rh+"
# Now build the matrix
nodes$id
## [1] "O-"  "O+"  "B-"  "B+"  "A-"  "A+"  "AB-" "AB+"
linksFrom <- lapply(links$from, rhesus_of_id, nodes = nodes)
linksFrom
## [[1]]
## [1] "Rh-"
## 
## [[2]]
## [1] "Rh-"
## 
## [[3]]
## [1] "Rh-"
## 
## [[4]]
## [1] "Rh-"
## 
## [[5]]
## [1] "Rh-"
## 
## [[6]]
## [1] "Rh-"
## 
## [[7]]
## [1] "Rh-"
## 
## [[8]]
## [1] "Rh-"
## 
## [[9]]
## [1] "Rh+"
## 
## [[10]]
## [1] "Rh+"
## 
## [[11]]
## [1] "Rh+"
## 
## [[12]]
## [1] "Rh+"
## 
## [[13]]
## [1] "Rh-"
## 
## [[14]]
## [1] "Rh-"
## 
## [[15]]
## [1] "Rh-"
## 
## [[16]]
## [1] "Rh-"
## 
## [[17]]
## [1] "Rh+"
## 
## [[18]]
## [1] "Rh+"
## 
## [[19]]
## [1] "Rh-"
## 
## [[20]]
## [1] "Rh-"
## 
## [[21]]
## [1] "Rh-"
## 
## [[22]]
## [1] "Rh-"
## 
## [[23]]
## [1] "Rh+"
## 
## [[24]]
## [1] "Rh+"
## 
## [[25]]
## [1] "Rh-"
## 
## [[26]]
## [1] "Rh-"
## 
## [[27]]
## [1] "Rh+"
linksTo <- lapply(links$to, rhesus_of_id, nodes = nodes)
linksTo
## [[1]]
## [1] "Rh+"
## 
## [[2]]
## [1] "Rh-"
## 
## [[3]]
## [1] "Rh+"
## 
## [[4]]
## [1] "Rh-"
## 
## [[5]]
## [1] "Rh+"
## 
## [[6]]
## [1] "Rh-"
## 
## [[7]]
## [1] "Rh+"
## 
## [[8]]
## [1] "Rh-"
## 
## [[9]]
## [1] "Rh+"
## 
## [[10]]
## [1] "Rh+"
## 
## [[11]]
## [1] "Rh+"
## 
## [[12]]
## [1] "Rh+"
## 
## [[13]]
## [1] "Rh+"
## 
## [[14]]
## [1] "Rh-"
## 
## [[15]]
## [1] "Rh+"
## 
## [[16]]
## [1] "Rh-"
## 
## [[17]]
## [1] "Rh+"
## 
## [[18]]
## [1] "Rh+"
## 
## [[19]]
## [1] "Rh+"
## 
## [[20]]
## [1] "Rh-"
## 
## [[21]]
## [1] "Rh+"
## 
## [[22]]
## [1] "Rh-"
## 
## [[23]]
## [1] "Rh+"
## 
## [[24]]
## [1] "Rh+"
## 
## [[25]]
## [1] "Rh+"
## 
## [[26]]
## [1] "Rh-"
## 
## [[27]]
## [1] "Rh+"
# We have the links, let's put them together
rhesusLinks <- cbind(linksFrom, linksTo)
rhesusLinks
##       linksFrom linksTo
##  [1,] "Rh-"     "Rh+"  
##  [2,] "Rh-"     "Rh-"  
##  [3,] "Rh-"     "Rh+"  
##  [4,] "Rh-"     "Rh-"  
##  [5,] "Rh-"     "Rh+"  
##  [6,] "Rh-"     "Rh-"  
##  [7,] "Rh-"     "Rh+"  
##  [8,] "Rh-"     "Rh-"  
##  [9,] "Rh+"     "Rh+"  
## [10,] "Rh+"     "Rh+"  
## [11,] "Rh+"     "Rh+"  
## [12,] "Rh+"     "Rh+"  
## [13,] "Rh-"     "Rh+"  
## [14,] "Rh-"     "Rh-"  
## [15,] "Rh-"     "Rh+"  
## [16,] "Rh-"     "Rh-"  
## [17,] "Rh+"     "Rh+"  
## [18,] "Rh+"     "Rh+"  
## [19,] "Rh-"     "Rh+"  
## [20,] "Rh-"     "Rh-"  
## [21,] "Rh-"     "Rh+"  
## [22,] "Rh-"     "Rh-"  
## [23,] "Rh+"     "Rh+"  
## [24,] "Rh+"     "Rh+"  
## [25,] "Rh-"     "Rh+"  
## [26,] "Rh-"     "Rh-"  
## [27,] "Rh+"     "Rh+"
rhesusNodes <- unique(nodes$rh)
rhesusNodes
## [1] "Rh-" "Rh+"
uniqueRhesusLinks <- unique(rhesusLinks)
uniqueRhesusLinks
##      linksFrom linksTo
## [1,] "Rh-"     "Rh+"  
## [2,] "Rh-"     "Rh-"  
## [3,] "Rh+"     "Rh+"
linksWeight <- rep(0, NROW(uniqueRhesusLinks))
linksWeight
## [1] 0 0 0
weightedRhesusLinks <- cbind(uniqueRhesusLinks, linksWeight)
weightedRhesusLinks
##      linksFrom linksTo linksWeight
## [1,] "Rh-"     "Rh+"   0          
## [2,] "Rh-"     "Rh-"   0          
## [3,] "Rh+"     "Rh+"   0
# now, we have to compute weights, ie. iterate and count on rhesusLinks

## create the function that counts aggregates
rhesuscounter <- function(rhesusLinks, rhesus1, rhesus2){
  out <- 0
  for(row in 1:nrow(rhesusLinks)) {
    
        #print(rhesusLinks[row, 1])
        #print(rhesusLinks[row, 2])
        if((toString(rhesusLinks[row, 1]) == rhesus1)
           & (toString(rhesusLinks[row, 2]) == rhesus2)){
          out <- out + 1
        }
  }
  return(out)
}

# test
out <- rhesuscounter(rhesusLinks, "Rh-", "Rh+")
out
## [1] 9
out <- 0
# Loop over weightedRhesusLinks
for(row in 1:nrow(weightedRhesusLinks)) {
        #print(row)
        rh1 <- weightedRhesusLinks[row, 1]
        rh2 <- weightedRhesusLinks[row, 2]
        print(rh1)
        print(rh2)
        print(rhesuscounter(rhesusLinks, rh1, rh2))
        out <- rhesuscounter(rhesusLinks, rh1, rh2)
        #print(out)
        weightedRhesusLinks[row, 3] <- out
}
## $linksFrom
## [1] "Rh-"
## 
## $linksTo
## [1] "Rh+"
## 
## [1] 9
## $linksFrom
## [1] "Rh-"
## 
## $linksTo
## [1] "Rh-"
## 
## [1] 9
## $linksFrom
## [1] "Rh+"
## 
## $linksTo
## [1] "Rh+"
## 
## [1] 9
weightedRhesusLinks
##      linksFrom linksTo linksWeight
## [1,] "Rh-"     "Rh+"   9          
## [2,] "Rh-"     "Rh-"   9          
## [3,] "Rh+"     "Rh+"   9
# we have all the datas for the rhesus graph
head(rhesusNodes);
## [1] "Rh-" "Rh+"
head(rhesusLinks)
##      linksFrom linksTo
## [1,] "Rh-"     "Rh+"  
## [2,] "Rh-"     "Rh-"  
## [3,] "Rh-"     "Rh+"  
## [4,] "Rh-"     "Rh-"  
## [5,] "Rh-"     "Rh+"  
## [6,] "Rh-"     "Rh-"
rhesusNet <- graph_from_data_frame(d=rhesusLinks, vertices=rhesusNodes, directed=T) 

class(rhesusNet)
## [1] "igraph"
rhesusNet
## IGRAPH fc475cb DN-- 2 27 -- 
## + attr: name (v/c)
## + edges from fc475cb (vertex names):
##  [1] Rh-->Rh+ Rh-->Rh- Rh-->Rh+ Rh-->Rh- Rh-->Rh+ Rh-->Rh- Rh-->Rh+
##  [8] Rh-->Rh- Rh+->Rh+ Rh+->Rh+ Rh+->Rh+ Rh+->Rh+ Rh-->Rh+ Rh-->Rh-
## [15] Rh-->Rh+ Rh-->Rh- Rh+->Rh+ Rh+->Rh+ Rh-->Rh+ Rh-->Rh- Rh-->Rh+
## [22] Rh-->Rh- Rh+->Rh+ Rh+->Rh+ Rh-->Rh+ Rh-->Rh- Rh+->Rh+
plot(rhesusNet, edge.arrow.size=.4, vertex.label.dist=3)

Distances entre les groupes sanguins

shortest.paths(net, v=V(net), mode = c("in"),
      weights = NULL)
##     O-  O+  B-  B+  A-  A+ AB- AB+
## O-   0 Inf Inf Inf Inf Inf Inf Inf
## O+   1   0 Inf Inf Inf Inf Inf Inf
## B-   1 Inf   0 Inf Inf Inf Inf Inf
## B+   1   1   1   0 Inf Inf Inf Inf
## A-   1 Inf Inf Inf   0 Inf Inf Inf
## A+   1   1 Inf Inf   1   0 Inf Inf
## AB-  1 Inf   1 Inf   1 Inf   0 Inf
## AB+  1   1   1   1   1   1   1   0