簡體   English   中英

R中的網絡和弦圖/分層邊束

[英]Network chord diagram / hierarchical edge bundle in R

我嘗試使用 package“edgebundleR”來創建分層邊緣束 plot。 我可以使用 edgebundleR 的示例代碼成功生產plot

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
# igraph static plot
# plot(g, layout = layout.circle, vertex.label=NA)

eb<-edgebundle( g )

但是,我想要我的 plot 像這樣 當鼠標 hover 指向節點時,所有邊都用灰色着色,出邊用紅色着色,入邊用藍色着色。 (我仍然希望我的節點用 LOC 着色。)

基於R 中的網絡和弦圖問題 我添加了代碼

eb <- htmlwidgets::onRender(
  eb,
'
function(el,x){
  x.edges.map(function(edge){
    var source = edge.from.split(".")[1];
    var target = edge.to.split(".")[1];
    d3.select(el).select(".link.source-" + source )
      .style("stroke","#f00");
    d3.select(el).select(".target-" + target)
      .style("stroke","#00f");
  })
}
'
)
eb

但它不起作用,我對 java 腳本一無所知。 我想知道我還應該修改代碼以使其工作。

自發布該答案以來,package 可能已經發生了一些變化。 我將提供另一種使用 javascript 完成結果的方法,因為在這種情況下,純 R 的選項似乎受到限制。

我們可以 select 我們的 onRender javascript 中的鏈接和節點:

  // select all the links:
  var links = d3.select(el).selectAll(".link");
  
  // select all the nodes:
  var nodes = d3.select(el).selectAll(".node")

然后,我們為節點分配一個事件偵聽器,該事件偵聽器將為連接到它的鏈接着色:

  // set up an event listener on the nodes:
  nodes.on("mouseover", function(d) {
    // color matching links:
    d3.select(el).selectAll(".source-"+d.key)
      .style("stroke","steelblue")
      
    d3.select(el).d3.selectAll(".target-"+d.key)
      .style("stroke","crimson");
  })

我不需要先 select el ,但如果同一頁面上有多個圖表,我會防止選擇錯誤的圖表。

現在我還需要添加一個事件監聽器來恢復鼠標移出的顏色:

nodes.on("mouseout", function() { links.style("stroke","#555"); })

我一起擁有:

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")
levels(clr) <- c("#555","#555","#555")
V(g)$color <- as.character(clr)
V(g)$size = degree(g)*5
# igraph static plot
# plot(g, layout = layout.circle, vertex.label=NA)

eb<-edgebundle( g )

eb <- htmlwidgets::onRender(
  eb,
  '
function(el,x){

  // select all the links:
  var links = d3.select(el).selectAll(".link");
  
  // select all the nodes:
  var nodes = d3.select(el).selectAll(".node")
  
  // set up an event listener on the nodes:
  nodes.on("mouseover", function(d) {
    // color matching links:
    d3.selectAll(".source-"+d.key)
      .style("stroke","steelblue")
      
    d3.selectAll(".target-"+d.key)
      .style("stroke","crimson");
  })
  
  nodes.on("mouseout", function() {
    links.style("stroke","#555");
  })
  
}
'
)
eb

產生:

在此處輸入圖像描述

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM