R中的网络和弦图很难过
我有一些类似于data.frame d的数据，如下所示。
d <- structure(list(ID = c("KP1009", "GP3040", "KP1757", "GP2243",
"KP682", "KP1789", "KP1933", "KP1662", "KP1718", "GP3339", "GP4007",
"GP3398", "GP6720", "KP808", "KP1154", "KP748", "GP4263", "GP1132",
"GP5881", "GP6291", "KP1004", "KP1998", "GP4123", "GP5930", "KP1070",
"KP905", "KP579", "KP1100", "KP587", "GP913", "GP4864", "KP1513",
"GP5979", "KP730", "KP1412", "KP615", "KP1315", "KP993", "GP1521",
"KP1034", "KP651", "GP2876", "GP4715", "GP5056", "GP555", "GP408",
"GP4217", "GP641"),
Type = c("B", "A", "B", "A", "B", "B", "B",
"B", "B", "A", "A", "A", "A", "B", "B", "B", "A", "A", "A", "A",
"B", "B", "A", "A", "B", "B", "B", "B", "B", "A", "A", "B", "A",
"B", "B", "B", "B", "B", "A", "B", "B", "A", "A", "A", "A", "A",
"A", "A"),
Set = c(15L, 1L, 10L, 21L, 5L, 9L, 12L, 15L, 16L,
19L, 22L, 3L, 12L, 22L, 15L, 25L, 10L, 25L, 12L, 3L, 10L, 8L,
8L, 20L, 20L, 19L, 25L, 15L, 6L, 21L, 9L, 5L, 24L, 9L, 20L, 5L,
2L, 2L, 11L, 9L, 16L, 10L, 21L, 4L, 1L, 8L, 5L, 11L), Loc = c(3L,
2L, 3L, 1L, 3L, 3L, 3L, 1L, 2L, 1L, 3L, 1L, 1L, 2L, 2L, 1L, 3L,
2L, 2L, 2L, 3L, 2L, 3L, 2L, 1L, 3L, 3L, 3L, 2L, 3L, 1L, 3L, 3L,
1L, 3L, 2L, 3L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 2L, 2L, 3L, 3L)),
.Names = c("ID", "Type", "Set", "Loc"), class = "data.frame",
row.names = c(NA, -48L))
我想使用类似下面的和弦图来探索d$ID成员之间的关系。
在R中可以看到有几个选项。 （Chord diagram in R）。
在我的数据中，关系符合d$Set（非定向），分组符合d$Loc。以下是我尝试将这些关系映射为和弦图。
尝试1：使用igraph
我已根据度数尝试了igraph节点大小。
# Get vertex relationships
sets <- unique(d$Set[duplicated(d$Set)])
rel <- vector("list", length(sets))
for (i in 1:length(sets)) {
rel[[i]] <- as.data.frame(t(combn(subset(d, d$Set ==sets[i])$ID, 2)))
}
library(data.table)
rel <- rbindlist(rel)
# Get the graph
g <- graph.data.frame(rel, directed=F, vertices=d)
clr <- as.factor(V(g)$Loc)
levels(clr) <- c("salmon", "wheat", "lightskyblue")
V(g)$color <- as.character(clr)
# Plot
plot(g, layout = layout.circle, vertex.size=degree(g)*5, vertex.label=NA)
如何修改情节看起来像第一个数字？似乎没有选项可以修改igraph layout.circle。
尝试2：使用Circlize
在R包circlize中，似乎可以实现更平滑的贝塞尔曲线和分组。但在这里，我无法对节点进行分组，也无法根据度数调整节点大小，因为它们被绘制为扇区。
par(mar = c(1, 1, 1, 1), lwd = 0.1, cex = 0.7)
circos.initialize(factors = as.factor(d$ID), xlim = c(0, 10))
circos.trackPlotRegion(factors = as.factor(d$ID), ylim = c(0, 0.5), bg.col = V(g)$color,
bg.border = NA, track.height = 0.05)
for(i in 1:nrow(rel)) {
circos.link(rel[i,1], 0, rel[i,2],0, h = 0.4)
}
但是，这里没有修改节点的选项。实际上它们只能作为扇区绘制？在这种情况下，有没有办法根据程度将扇区修改为大小的圆形节点？
尝试3：使用edgebundleR（https://github.com/garthtarr/edgebundleR）
require(edgebundleR)
edgebundle(g,tension = 0.1,cutoff = 0.5, fontsize = 18,padding=40)
在这里看来，修改美学的选择有限。
2 个答案:
答案 0 :(得分：21)
我对edgebundleR进行了一系列更改。这些现在是主要的回购。以下代码可以让您接近所需的结果。 live example
# devtools::install_github("garthtarr/edgebundleR")
library(edgebundleR)
library(igraph)
library(data.table)
d <- structure(list(ID = c("KP1009", "GP3040", "KP1757", "GP2243",
"KP682", "KP1789", "KP1933", "KP1662", "KP1718", "GP3339", "GP4007",
"GP3398", "GP6720", "KP808", "KP1154", "KP748", "GP4263", "GP1132",
"GP5881", "GP6291", "KP1004", "KP1998", "GP4123", "GP5930", "KP1070",
"KP905", "KP579", "KP1100", "KP587", "GP913", "GP4864", "KP1513",
"GP5979", "KP730", "KP1412", "KP615", "KP1315", "KP993", "GP1521",
"KP1034", "KP651", "GP2876", "GP4715", "GP5056", "GP555", "GP408",
"GP4217", "GP641"),
Type = c("B", "A", "B", "A", "B", "B", "B",
"B", "B", "A", "A", "A", "A", "B", "B", "B", "A", "A", "A", "A",
"B", "B", "A", "A", "B", "B", "B", "B", "B", "A", "A", "B", "A",
"B", "B", "B", "B", "B", "A", "B", "B", "A", "A", "A", "A", "A",
"A", "A"),
Set = c(15L, 1L, 10L, 21L, 5L, 9L, 12L, 15L, 16L,
19L, 22L, 3L, 12L, 22L, 15L, 25L, 10L, 25L, 12L, 3L, 10L, 8L,
8L, 20L, 20L, 19L, 25L, 15L, 6L, 21L, 9L, 5L, 24L, 9L, 20L, 5L,
2L, 2L, 11L, 9L, 16L, 10L, 21L, 4L, 1L, 8L, 5L, 11L), Loc = c(3L,
2L, 3L, 1L, 3L, 3L, 3L, 1L, 2L, 1L, 3L, 1L, 1L, 2L, 2L, 1L, 3L,
2L, 2L, 2L, 3L, 2L, 3L, 2L, 1L, 3L, 3L, 3L, 2L, 3L, 1L, 3L, 3L,
1L, 3L, 2L, 3L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 2L, 2L, 3L, 3L)),
.Names = c("ID", "Type", "Set", "Loc"), class = "data.frame",
row.names = c(NA, -48L))
# let's add Loc to our ID
d$key <- d$ID
d$ID <- paste0(d$Loc,".",d$ID)
# Get vertex relationships
sets <- unique(d$Set[duplicated(d$Set)])
rel <- vector("list", length(sets))
for (i in 1:length(sets)) {
rel[[i]] <- as.data.frame(t(combn(subset(d, d$Set ==sets[i])$ID, 2)))
}
rel <- rbindlist(rel)
# Get the graph
g <- graph.data.frame(rel, directed=F, vertices=d)
clr <- as.factor(V(g)$Loc)
levels(clr) <- c("salmon", "wheat", "lightskyblue")
V(g)$color <- as.character(clr)
V(g)$size = degree(g)*5
# Plot
plot(g, layout = layout.circle, vertex.label=NA)
edgebundle( g )->eb
eb
答案 1 :(得分：5)
我不想为另一个问题添加另一个答案，但我不知道如何处理评论中提出的其他问题。评论询问我们如何为边缘着色。一般来说，响应很简单，但在这种情况下，答案需要重写edgebundleR中的大部分代码或需要黑客攻击。我会选择下面的黑客。
library(edgebundleR)
library(igraph)
library(data.table)
d <- structure(list(ID = c("KP1009", "GP3040", "KP1757", "GP2243",
"KP682", "KP1789", "KP1933", "KP1662", "KP1718", "GP3339", "GP4007",
"GP3398", "GP6720", "KP808", "KP1154", "KP748", "GP4263", "GP1132",
"GP5881", "GP6291", "KP1004", "KP1998", "GP4123", "GP5930", "KP1070",
"KP905", "KP579", "KP1100", "KP587", "GP913", "GP4864", "KP1513",
"GP5979", "KP730", "KP1412", "KP615", "KP1315", "KP993", "GP1521",
"KP1034", "KP651", "GP2876", "GP4715", "GP5056", "GP555", "GP408",
"GP4217", "GP641"),
Type = c("B", "A", "B", "A", "B", "B", "B",
"B", "B", "A", "A", "A", "A", "B", "B", "B", "A", "A", "A", "A",
"B", "B", "A", "A", "B", "B", "B", "B", "B", "A", "A", "B", "A",
"B", "B", "B", "B", "B", "A", "B", "B", "A", "A", "A", "A", "A",
"A", "A"),
Set = c(15L, 1L, 10L, 21L, 5L, 9L, 12L, 15L, 16L,
19L, 22L, 3L, 12L, 22L, 15L, 25L, 10L, 25L, 12L, 3L, 10L, 8L,
8L, 20L, 20L, 19L, 25L, 15L, 6L, 21L, 9L, 5L, 24L, 9L, 20L, 5L,
2L, 2L, 11L, 9L, 16L, 10L, 21L, 4L, 1L, 8L, 5L, 11L), Loc = c(3L,
2L, 3L, 1L, 3L, 3L, 3L, 1L, 2L, 1L, 3L, 1L, 1L, 2L, 2L, 1L, 3L,
2L, 2L, 2L, 3L, 2L, 3L, 2L, 1L, 3L, 3L, 3L, 2L, 3L, 1L, 3L, 3L,
1L, 3L, 2L, 3L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 2L, 2L, 3L, 3L)),
.Names = c("ID", "Type", "Set", "Loc"), class = "data.frame",
row.names = c(NA, -48L))
# let's add Loc to our ID
d$key <- d$ID
d$ID <- paste0(d$Loc,".",d$ID)
# Get vertex relationships
sets <- unique(d$Set[duplicated(d$Set)])
rel <- vector("list", length(sets))
for (i in 1:length(sets)) {
rel[[i]] <- as.data.frame(t(combn(subset(d, d$Set ==sets[i])$ID, 2)))
}
rel <- rbindlist(rel)
# Get the graph
g <- graph.data.frame(rel, directed=F, vertices=d)
clr <- as.factor(V(g)$Loc)
levels(clr) <- c("salmon", "wheat", "lightskyblue")
V(g)$color <- as.character(clr)
# Plot
plot(g, layout = layout.circle, vertex.size=degree(g)*5, vertex.label=NA)
edgebundle( g )->eb
eb
# temporary hack to accomplish edge coloring
# requires newest Github version of htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
# add some imaginary colors
E(g)$color <- c("purple","green","black")[floor(runif(length(E(g)),1,4))]
# now append these edge attributes to our htmlwidget x
eb$x$edges <- jsonlite::toJSON(get.data.frame(g,what="edges"))
eb <- htmlwidgets::onRender(
eb,
'
function(el,x){
// loop through each of our edges supplied
// and change the color
x.edges.map(function(edge){
var source = edge.from.split(".")[1];
var target = edge.to.split(".")[1];
d3.select(el).select(".link.source-" + source + ".target-" + target)
.style("stroke",edge.color);
})
}
'
)
eb
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？