使用 igraph 基于边缘属性添加多个边缘

Question

我想知道，使用igraph，是否可以根据不同边属性的值将边添加到图形中。

我有一个data.frame，dput 如下：

df <- structure(list(nodeA = c("CFTR", "CFTR", "CFTR", "CFTR", "CFTR", 
"CFTR"), nodeB = c("CYP7A1", "KRT16", "ABCA3", "SLC22A11", 
"PBK", "ACSM1"), score = c(0.239, 0.24, 0.292, 0.269, 
0.233, 0.168), text = c(129L, 0L, 287L, 246L, 
161L, 155L), mining = c(163L, 241L, 413L, 71L, 92L, 56L), 
experiments = c(0L, 0L, 101L, 0L, 75L, 0L), homologs =c(0L, 
0L, 609L, 0L, 0L, 0L)), .Names = c("nodeA", "nodeB", 
"score", "text", "mining","experiments", 
"homologs"), class = "data.frame", row.names = c(NA, 6L))

如果边属性的值不为0，我想在图形中添加新边（g <- graph.data.frame(df, directed=FALSE），例如对于边CFTR--CYP7A1，我想添加一对额外的边（一个用于text，另一个用于mining 属性），我对score 不感兴趣（这是我图表的权重）

Answer 1

这里有几种方法。

首先，重新排列原始数据似乎更容易一些。将数据放入长格式并根据列名分配颜色。

library(reshape2)
# Data in long format 
# Create graph, with edges add when attributes / columns are greater than zero
m <- melt(df, id=1:2)
m <- m[m$value != 0, ] # keep non-zero values
g <- graph.data.frame(m, directed=FALSE)

# Add colours to the edges
cols = c(score="black", text="blue", mining="green", 
                                  experiments="red", homologs="yellow")
plot(g, edge.color=cols[E(g)$variable])

---

如果您想拥有原始图形，然后为每个图形添加彩色边 属性大于零，可以循环遍历属性 (edge_attr)，并在满足条件时添加边 (add_edges)。

我们可以一次添加一个附加边（如text 属性所示）

g <- graph.data.frame(df, directed=FALSE)    
names(edge_attr(g)) # attributes

# Which edges should be added conditioned on text attribute being greater than zero
edge_attr(g, "text")
ats <- edge_attr(g, "text") > 0

#Set edges in graph already to black
E(g)$color <- "black"

# Get head and tail of all edges
ed <- get.edgelist(g)

# subset these by the attribute condition
# combine head and tail nodes in correct format for add_edges
# should be c(tail1, head1, tail2, head2, ..., tailn, headn)
ed <- t(ed[ats, 2:1])

# Add the additional edges
g  <- add_edges(g, ed,  color="blue")
plot(g)

或者一次性添加额外的边

g <- graph.data.frame(df, directed=FALSE)    

# Indicator of attribute > 0
ats <- unlist(edge_attr(g)) > 0

# Repeat the head & tail of each edge
# subset so the same length as relevant attributes
ed <- do.call(rbind, replicate(length(edge_attr(g)), get.edgelist(g), simplify=FALSE))
ed <- t(ed[ats, 2:1])
cols <- rep(c("black", "blue", "green", "red", "yellow"), each=length(E(g)))[ats]

g  <- add_edges(g, ed,  color=cols)
plot(g)

Answer 2

我认为这会让你得到你想要的，只需一点熔化和铸造：

library(data.table)

setDT(df)

#get list of potential edges
tmp <- melt(df, id.vars = c("nodeA","nodeB","score"), measure.vars = c("text","mining","experiments","homologs"))

#Filter out zeros, create unique group for each edge
tmp <- tmp[value != 0, ][, ind := .I]

#Recast
tmp <- dcast(tmp, ind + nodeA + nodeB + score ~ variable, value.var = "value", fill = 0)

#get rid of index
tmp[, ind := NULL]

#join back to initial edge list
df <- rbindlist(list(df, tmp))
df
    nodeA    nodeB score text mining experiments homologs
 1:  CFTR   CYP7A1 0.239  129    163           0        0
 2:  CFTR    KRT16 0.240    0    241           0        0
 3:  CFTR    ABCA3 0.292  287    413         101      609
 4:  CFTR SLC22A11 0.269  246     71           0        0
 5:  CFTR      PBK 0.233  161     92          75        0
 6:  CFTR    ACSM1 0.168  155     56           0        0
 7:  CFTR   CYP7A1 0.239  129      0           0        0
 8:  CFTR    ABCA3 0.292  287      0           0        0
 9:  CFTR SLC22A11 0.269  246      0           0        0
10:  CFTR      PBK 0.233  161      0           0        0
11:  CFTR    ACSM1 0.168  155      0           0        0
12:  CFTR   CYP7A1 0.239    0    163           0        0
13:  CFTR    KRT16 0.240    0    241           0        0
14:  CFTR    ABCA3 0.292    0    413           0        0
15:  CFTR SLC22A11 0.269    0     71           0        0
16:  CFTR      PBK 0.233    0     92           0        0
17:  CFTR    ACSM1 0.168    0     56           0        0
18:  CFTR    ABCA3 0.292    0      0         101        0
19:  CFTR      PBK 0.233    0      0          75        0
20:  CFTR    ABCA3 0.292    0      0           0      609