#r #igraph
#r #igraph
Вопрос:
Я хотел бы знать, можно ли, используя 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))
Я хотел бы добавить новые ребра в график ( g <- graph.data.frame(df, directed=FALSE ), если значение атрибутов ребер отличается от 0, например, для ребра CFTR--CYP7A1 , я хотел бы добавить пару дополнительных ребер (одно для text , а другое для mining атрибутов), меня это не интересует score (этовес моего графика)
Комментарии:
1.
m <- reshape2::melt(df, id.=1:2) ; m <- m[m$value!=0, ] ; g <- graph.data.frame(m, directed=FALSE). Это ожидаемый результат?2. закрыть, но не @user20650, я хочу добавить ребра ко всему графику. Я имею в виду, я хочу построить свой полный график (27 узлов и 91 ребро), но в дополнение к этим 91 ребрам я хочу нарисовать дополнительные между узлами, где edge.attributes отличаются от 0
3. конечно. Я ожидал добавить ребра к исходному графику, скажем, в другом цвете в зависимости от атрибута, но для данных в вашем вопросе все ожидаемые ребра есть? Просто убедитесь в ожидаемом результате.
4. да, это ожидаемые ребра, которые будут добавлены @user20650
5. @user20650, внесли ли вы изменения в код добавления вычисленных вами ребер в график и изменение его цвета в зависимости от атрибута?
Ответ №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 amp; 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)
Ответ №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