使用 sankeyNetwork 时如何设置一些自定义颜色来链接？

Question

我使用

sankeyNetwork

R包中的

networkD3

函数绘制了桑基图，旨在显示不同级别的细胞类型数量的变化，但我的自定义颜色与我设置的细胞类型不匹配。

我用过

library(networkD3)

source <- c("Epithelial", "Epithelial", "Endothelial", "Stroma", "Endothelial", "Immune", 
            "Immune", "Proliferating", "Stroma", "Fibroblast lineage", "Fibroblast lineage", 
            "Alveolar epithelium", "Alveolar epithelium", "Lymphoid", "Airway epithelium", 
            "CEC1", "Airway epithelium", "Airway epithelium", "LEC1", "Myeloid1", "Myeloid1", 
            "Myeloid1", "Myeloid1", "Proliferating2", "SM1", "Lymphoid")
target <- c("Airway epithelium", "Alveolar epithelium", "CEC1", "Fibroblast lineage", 
            "LEC1", "Lymphoid", "Myeloid1", "Proliferating2", "SM1", "Alf1", "Alf2", "AT1", 
            "AT2", "B", "Basal", "CEC2", "Ciliated", "Club", "LEC2", "Macrophages", "MAST", 
            "Monocytes", "Myeloid2", "Proliferating3", "SM2", "T_cell")
value <- c(14612, 18191, 15878, 21459, 4131, 30553, 38800, 743, 10607, 9946, 11513, 11568, 
           6623, 2436, 390, 15878, 11449, 2773, 4131, 11989, 2802, 13628, 10381, 743, 10607, 28117)
source2 <- c(0, 0, 1, 2, 1, 3, 3, 4, 2, 5, 5, 6, 6, 7, 8, 9, 8, 8, 10, 11, 11, 11, 11, 12, 13, 7)
target2 <- c(8, 6, 9, 5, 10, 7, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30)
group <- c("Epithelial", "Epithelial", "Endothelial", "Stroma", "Endothelial", "Immune", 
           "Immune", "Proliferating", "Stroma", "Fibroblast lineage", "Fibroblast lineage", 
           "Alveolar epithelium", "Alveolar epithelium", "Lymphoid", "Airway epithelium", 
           "CEC1", "Airway epithelium", "Airway epithelium", "LEC1", "Myeloid1", "Myeloid1", 
           "Myeloid1", "Myeloid1", "Proliferating2", "SM1", "Lymphoid")


flows <- data.frame(source, target, value, source2, target2, group)
nodes <- data.frame(name = unique(c(flows$source, flows$target)))

colourScale <- JS(
'd3.scaleOrdinal()
    .domain(["Epithelial", "Endothelial", "Stroma", "Immune", 
             "Alveolar epithelium", "Airway epithelium",
             "AT1", "AT2", "Basal", "Ciliated",
             "Fibroblast lineage", "SM1",
             "Alf1", "Alf2", "SM2",
             "CEC1", "LEC1",
             "CEC2", "LEC2",
             "Myeloid1", "Lymphoid",
             "B", "Macrophages", "MAST", "Monocytes", "Myeloid2", "T_cell",
             "Proliferating", "Proliferating2", "Proliferating3"])
    .range(["#3a86ff", "#ffbe0b", "#8338ec", "#d62828", 
            "#0081a7", "#0081a7",
            "#a8dadc", "#a8dadc", "#a8dadc", "#a8dadc",
            "#9d4edd", "#9d4edd",
            "#cdb4db", "#cdb4db", "#cdb4db",
            "#ffffb3", "#ffffb3",
            "#ffffb3", "#ffffb3",
            "#e76f51", "#e76f51",
            "#f7a072", "#f7a072", "#f7a072", "#f7a072", "#f7a072", "#f7a072",
            "#a98467", "#a98467", "#a98467"])'
)

sankeyNetwork(
  Links = flows, 
  Nodes = nodes,
  Source = "source2", 
  Target = "target2", 
  Value = "value", 
  NodeID = "name", 
  units = "T",
  fontSize = 12, 
  nodeWidth = 30,
  LinkGroup = "group",       # link group
  # NodeGroup = "target",       # node group
  colourScale = colourScale  # set color scale
)

剧情不如预期。

在此输入图片描述

Answer 1

问题在于底层 D3/JavaScript 仅考虑第一个空格之前的组名称，因此名称中带有空格的组（即“肺泡上皮”、“气道上皮”和“成纤维细胞谱系”）不会作为处理预计。

您可以通过将

flows

和

nodes

数据帧以及

colourScale

JS 代码中的空格交换为“_”来轻松解决这个问题（尽管我强烈建议在原始数据中修复它而不是像这样进行后处理）

flows$group <- gsub(" ", "_", flows$group)
nodes$group <- gsub(" ", "_", nodes$name)
colourScale <- gsub("([[:alpha:]]) ([[:alpha:]])", "\\1_\\2", colourScale)

sankeyNetwork(
  Links = flows, 
  Nodes = nodes,
  Source = "source2", 
  Target = "target2", 
  Value = "value", 
  NodeID = "name", 
  units = "T",
  fontSize = 12, 
  nodeWidth = 30,
  LinkGroup = "group",       # link group
  NodeGroup = "group",       # node group
  colourScale = colourScale  # set color scale
)

此外，我强烈建议将颜色数据直接添加到您的

flows

和

nodes

数据框中，然后使用简单的 JS 标识函数来访问它们，而不是像这样复杂的 JS 域和范围规范

colors <- 
  data.frame(
    group = c("Epithelial", "Endothelial", "Stroma", "Immune", 
              "Alveolar epithelium", "Airway epithelium",
              "AT1", "AT2", "Basal", "Ciliated",
              "Fibroblast lineage", "SM1",
              "Alf1", "Alf2", "SM2",
              "CEC1", "LEC1",
              "CEC2", "LEC2",
              "Myeloid1", "Lymphoid",
              "B", "Macrophages", "MAST", "Monocytes", "Myeloid2", "T_cell",
              "Proliferating", "Proliferating2", "Proliferating3"),
    color = c("#3a86ff", "#ffbe0b", "#8338ec", "#d62828", 
              "#0081a7", "#0081a7",
              "#a8dadc", "#a8dadc", "#a8dadc", "#a8dadc",
              "#9d4edd", "#9d4edd",
              "#cdb4db", "#cdb4db", "#cdb4db",
              "#ffffb3", "#ffffb3",
              "#ffffb3", "#ffffb3",
              "#e76f51", "#e76f51",
              "#f7a072", "#f7a072", "#f7a072", "#f7a072", "#f7a072", "#f7a072",
              "#a98467", "#a98467", "#a98467")
  )

flows$color <- colors$color[match(flows$group, colors$group)]
nodes$color <- colors$color[match(nodes$name, colors$group)]

sankeyNetwork(
  Links = flows, 
  Nodes = nodes,
  Source = "source2", 
  Target = "target2", 
  Value = "value", 
  NodeID = "name", 
  units = "T",
  fontSize = 12, 
  nodeWidth = 30,
  LinkGroup = "color",
  NodeGroup = "color",
  colourScale = "f => f"
)