Question

我一直试图以与此帖相似的方式整理网络/和弦图： Network chord diagram woes in R

我想扩展@timelyportfolio给出的解决方案作为上一个问题的解决方案，我的代码与下面的代码没有什么不同，但是，我想做的是重量（我不是说重量为一个属性，我不想根据关系矩阵（g）中定义的色谱来改变边缘的厚度，只是颜色深度。根据关系水平，权重基于1-5的等级。

颜色将由RColorBrewer调色板定义，即。 col.blue <- brewer.pal(5, "Blues")我将使用每个边缘组的第5级色谱替换下面代码中“集合”的颜色级别。

我花了最后24小时试图在R中解决这个问题，这在iGraph中比较简单，但是一旦我应用了edgebundleR，我就会失去加权线。我假设它需要对edgebundleR进行某种破解，但我对Java一无所知。有人能帮忙吗？

@roastbeeef

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

R - Chord / Network图，EdgebundleR - 加权边缘颜色

0 个答案: