操作和编辑network_betaplot函数

时间:2018-07-25 03:26:36

标签: r igraph

以下代码用于制作一个由igraph组成的网络,其中包括节点和两个图的交互作用。在此图中,节点表示在要比较的两个图中任一图中发现的物种。如果物种对于某个图而言是唯一的,则这些节点为蓝色,而对于其他图而言,则为绿色。共有的物种为灰色。类似地,边缘用颜色编码,因此蓝色代表一个图的唯一交互,绿色代表另一图的唯一交互。灰色的边缘表示两个地块之间共享的交互作用(意味着这些物种在两个地块中的交互作用类似)。

我想更改network_betaplot函数的规范,以便输出提供3个单独的图:一个图所独有的那些边和节点的网络,一个图所独有的节点和边的图另一个图和共享的节点和边的第三张图。

下面的代码有效,但是当我的地块具有极高的种类和相互作用时,就会遇到问题。输出图太忙,因此对于图形显示没有太大帮助。将网络的这些组件分为三个独立的网络将产生对我的目的更有帮助的网络。

这是一个示例数据框,以及我用来为network_betaplot函数设置格式的代码:

  df<- data.frame(network= c("n1", "n1", "n2", "n2", "n2"), plantsp= c( 
 "p1","p2", "p1", "p1", "p2"), lepsp= c('l1',"l2","l2","l1", "l1"))

  sublist=NA
 for (i in unique(df[,1])){ 
   sublist[i]<-list(subset(df, df[,1] == i)) 
  print(i)
  }

 matrix_list = list()

 for (i in 1: length(unique(sublist))){ 

 if (length(sublist[[i]]) > 1 & length(sublist[[i]]) > 1 ){

  rows<-unique(sublist[[i]][[3]]) #lep sp (Esp_lagarta) =rows
  cols<-unique(sublist[[i]][[2]]) #plant (Spp_de_planta) =columns
  matrix1<- matrix(nrow = length(rows), ncol = length(cols))

  df = data.frame(sublist[[i]])

  for (k in 1: length(rows)){
   sub_rows<- subset(df, lepsp== rows[k]) 
   for (j in 1:length(cols)){ 
     sub_cols<-subset(sub_rows, plantsp == cols[j]) 
      matrix1[k,j]<-length(sub_cols[,2])
   }
 }
 colnames(matrix1) <- cols
 rownames(matrix1) <- rows
 matrix_list[[i]] = matrix1
  }else{next}
 }

 matrix_list[[1]]<-NULL

 igraph_list<-prepare_networks(matrix_list, directed=FALSE)
 network_betaplot(igraph_list$network_1,igraph_list$network_2)

我尝试删除了将蓝色边缘着色的论点,但它们仍然是灰色,而不是从网络中删除。

network_betaplot<-function (n1, n2, na = "#2ca02c", nb = "#1f77b4", ns = "grey", nw=clr,
                          ...) 
{
M <- metaweb(list(n1, n2))
s1 <- igraph::V(n1)$name
s2 <- igraph::V(n2)$name
vert_color <- rep(ns, length(igraph::V(M)))
names(vert_color) <- igraph::V(M)$name
for (v in igraph::V(M)$name) {
 if ((v %in% s1) && !(v %in% s2)) 
   vert_color[v] = na
 if (!(v %in% s1) && (v %in% s2)) 
   vert_color[v] = nb
}
make_readable_edgelist = function(x) {
 X = igraph::get.edgelist(x)
 return(paste(X[, 1], X[, 2]))
} 
edge_color <- rep(clr, length(igraph::E(M)))
em = make_readable_edgelist(M)
names(edge_color) <- em
e1 = make_readable_edgelist(n1)
e2 = make_readable_edgelist(n2)
for (ee in em) {
 if (!(ee %in% e1) && (ee %in% e2)) 
   edge_color[ee] = nb
}
igraph::plot.igraph(M, vertex.color = vert_color, edge.color = 
edge_color, layout=1,
                  vertex.size=3, vertex.label.cex=0.5,...)
} 

我也尝试过使边缘和节点透明,但是布局保持不变,因此输出网络看起来很俗气。

makeTransparent = function(..., alpha=0.01) {

 if(alpha<0 | alpha>1) stop("alpha must be between 0 and 1")

 alpha = floor(255*alpha)  
 newColor = col2rgb(col=unlist(list(...)), alpha=FALSE)

  .makeTransparent = function(col, alpha) {
  rgb(red=col[1], green=col[2], blue=col[3], alpha=alpha, 
maxColorValue=255)
}

newColor = apply(newColor, 2, .makeTransparent, alpha=alpha)

return(newColor)

}

clr<- makeTransparent(2)

network_betaplot<-function (n1, n2, na = "#2ca02c", nb = "#1f77b4", ns 
= "grey", nw= clr,
      ...) 
{
  M <- metaweb(list(n1, n2))
 s1 <- igraph::V(n1)$name
 s2 <- igraph::V(n2)$name
 vert_color <- rep(ns, length(igraph::V(M)))
 names(vert_color) <- igraph::V(M)$name
 for (v in igraph::V(M)$name) {
  if ((v %in% s1) && !(v %in% s2)) 
    vert_color[v] = na
  if (!(v %in% s1) && (v %in% s2)) 
   vert_color[v] = nb
 }
 make_readable_edgelist = function(x) {
  X = igraph::get.edgelist(x)
  return(paste(X[, 1], X[, 2]))
 }
edge_color <- rep(ns, length(igraph::E(M)))
em = make_readable_edgelist(M)
names(edge_color) <- em
e1 = make_readable_edgelist(n1)
e2 = make_readable_edgelist(n2)
 for (ee in em) {
  if ((ee %in% e1) && !(ee %in% e2)) 
   edge_color[ee] = na
  if (!(ee %in% e1) && (ee %in% e2)) 
    edge_color[ee] = nw
 }
igraph::plot.igraph(M, vertex.color = vert_color, edge.color = 
edge_color, layout=layout_in_circle,
                  vertex.size=6, ...)
 }

 network_betaplot(igraph_list$network_1,igraph_list$network_2)

0 个答案:

没有答案