R中的网络和弦图问题答案

【问题标题】：Network chord diagram woes in RR中的网络和弦图问题
【发布时间】：2015-08-22 21:24:05
【问题描述】：

我有一些类似于data.framed的数据如下。

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)

如何修改绘图看起来像第一个图？好像没有修改igraphlayout.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)

似乎这里有有限的选项来修改美学。

【问题讨论】：

christophergandrud.github.io/d3Network 呢？
您可以通过对邻接矩阵进行排序来对变量进行分组，并使用 edge.curve 参数向边缘添加一些曲线。道歉代码转储：m <- tcrossprod(table(d[c(1,3)])) ; grp <- d[order(d$ID), "Loc"] ; m2 <- m[order(grp), order(grp) ] ; diag(m2) <- 0 ; g <- graph.adjacency(m2, mode="undirected"); clr <- as.factor(sort(grp)); levels(clr) <- c("salmon", "wheat", "lightskyblue"); V(g)$color <- as.character(clr); par(mar=rep(0,4)); plot(g, layout = layout.circle, vertex.size=degree(g)*5, vertex.label=NA, edge.curved=seq(-0.5, 0.5, length = ecount(g)))
喜作物；是的，几乎在那里，但不完全是。我无法发布答案，因为该问题已作为 dup 关闭（因此上面的代码转储）。
@RomanLuštrik networkD3 (christophergandrud.github.io/networkD3) 看起来很棒。但目前这个R 接口只支持Forcedirected networks、Sankey diagrams和Reingold-Tilford Tree graphs。非圆形布局
我知道您正在使用 R，但为什么不试试 circos (circos.ca)？使用 R + circos 想法的一种替代方法是bioconductor.org/packages/release/bioc/html/OmicCircos.html。

标签： r data-visualization igraph graph-visualization circos

【解决方案1】：

我对@987654325@ 做了很多更改。这些现在在主仓库中。以下代码应该让您接近所需的结果。 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

【讨论】：

如何改变边缘的颜色？
这三行 clr V(g)$color <- "red" 会使所有东西都变红。
如果您想根据其他参数为每条边上色，这将不起作用。例如，在 igraph 中，您可以通过 E(g)$color 为边缘着色，但 edgebundleR 包仅使用源节点的颜色为边缘着色。所以所有的出边都必须相同。
我明白了什么应该是显而易见的。对不起，我花了一段时间才明白。这些行github.com/garthtarr/edgebundleR/blob/master/inst/htmlwidgets/… 演示了您提到的问题。让我玩一会儿，试着想出一个答案。
在重新熟悉代码后，我意识到这将需要重写大部分代码或需要修改。我将在下面的答案中发布黑客攻击。

【解决方案2】：

我讨厌为不同的问题添加另一个答案，但我不知道有什么方法可以处理评论中提出的其他问题。该评论询问我们如何为边缘着色。一般来说，响应会很容易，但在这种情况下，答案需要重写edgebundleR 中的大部分代码或需要破解。我将使用下面的 hack。

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

【讨论】：

由于某种原因这不起作用。我可以更新边缘并查看 "color":"green" 例如在大 JSON goblty-gook 中，但是当我从 onRender 运行代码时，图表下方最终看起来相同。
有什么方法可以使用saveWidget 并发布到要点？你从 Github 安装了最新的 htmlwidgets 吗？
我也试过了——在安装了最新的htmlwidgets 和edgebundler 之后。这是错误消息：Error: 'onRender' is not an exported object from 'namespace:htmlwidgets'
这里介绍了这个功能github.com/ramnathv/htmlwidgets/pull/172。如果您从 Github 安装，想知道为什么会出现该错误。 hmmmmmm....我可以添加 tasks 功能，但这应该消除对这个的需要。
@timelyportfolio 它大部分都在工作。事实证明，您的节点名称/ID 中不能有空格。但颜色看起来不正确。几乎就像新颜色与原始边缘颜色混合一样。

尝试1：使用igraph

尝试 2：使用Circlize

尝试 3：使用edgebundleR(https://github.com/garthtarr/edgebundleR)

尝试1：使用`igraph`

尝试 2：使用`Circlize`

尝试 3：使用`edgebundleR`(https://github.com/garthtarr/edgebundleR)