为桑基图构建二进制数据

structuring binary data for sankey plot

我无法弄清楚如何为有多个成功机会 (1) 或失败机会 (0) 的数据制作桑基图。您可以使用以下代码生成我的示例:

# example
library(networkD3)
library(tidyverse)
library(tidyr)

set.seed(900)
n=1000
example.data<-data.frame("A" = rep(1,n),
                         "B" = sample(c(0,1),n,replace = T),
                         "C" = rep(NA,n),
                         "D" = rep(NA,n),
                         "E" = rep(NA,n),
                         "F" = rep(NA,n),
                         "G" = rep(NA,n))

for (i in 1:n){
  example.data$C[i]<- ifelse(example.data$B[i]==1,
                                   sample(c(0,1),1,prob = c(0.3,0.7),replace = F),
                                   sample(c(0,1),1,prob = c(0.55,0.45),replace = F))
  example.data$D[i]<-ifelse(example.data$C[i]==1,
                                              sample(c(0,1),1,prob = c(0.95,0.05),replace = F),
                                              sample(c(0,1),1,prob = c(0.65,0.35),replace = F))
  example.data$E[i]<-ifelse(example.data$C[i]==0 & example.data$D[i]==0,
                                    sample(c(0,1),1,prob = c(.9,.1),replace = F),
                                    ifelse(example.data$C[i]==0 & example.data$D[i]==1,
                                           sample(c(0,1),1,prob = c(.3,.7),replace = F),
                                           ifelse(example.data$C[i]==1 & example.data$D[i]==0,
                                                  sample(c(0,1),1,prob = c(.9,.1),replace = F),
                                                  sample(c(0,1),1,prob = c(.1,.9),replace = F))))
  example.data$F[i]<-ifelse(example.data$E==1,
                                         sample(c(1,0),1,prob=c(.85,.15),replace = F),
                                         sample(c(1,0),1,prob = c(.01,.99),replace = F))
  example.data$G[i]<-sample(c(1,0),1,prob = c(.78,.22),replace = F)
}


example.data.1<-example.data%>%
  gather()%>%
  mutate(ORDER = c(rep(0,n),rep(1,n),rep(2,n),rep(3,n),rep(4,n),rep(5,n),rep(6,n)))%>%
  dplyr::select("Event" = key,
                "Success" = value,
                ORDER)%>%
  group_by(ORDER)%>%
  summarise("YES" = sum(Success==1),
            "NO" = sum(Success==0))

对我来说棘手的部分是如何生成链接数据而无需手动指定源目标和值。

我使用了 this website 中的 sankey 示例,并以最不优雅的方式继续使用我自己的示例数据:

links<-data.frame("source" = sort(rep(seq(0,10,1),2)),
           "target" = c(1,2,3,4,3,4,5,6,5,6,7,8,7,8,9,10,9,10,11,12,11,12),
           "value" = c(sum(example.data$A==1 &example.data$B==1), #1
                       sum(example.data$A==1 & example.data$B==0),#2
                       sum(example.data$B==1 & example.data$C==1),#3
                       sum(example.data$B==1 & example.data$C==0),#4
                       sum(example.data$B==0 & example.data$C==1),#5
                       sum(example.data$B==0 & example.data$C==0),#6
                       sum(example.data$C==1 & example.data$D==1),#7
                       sum(example.data$C==1 & example.data$D==0),#8
                       sum(example.data$C==0 & example.data$D==1),#9
                       sum(example.data$C==0 & example.data$D==0),#10
                       sum(example.data$D==1 & example.data$E==1),#11
                       sum(example.data$D==1 & example.data$E==0),#12
                       sum(example.data$D==0 & example.data$E==1),#13
                       sum(example.data$D==0 & example.data$E==0),#14
                       sum(example.data$E==1 & example.data$F==1),#15
                       sum(example.data$E==1 & example.data$F==0),#16
                       sum(example.data$E==0 & example.data$F==1),#17
                       sum(example.data$E==0 & example.data$F==0),#18
                       sum(example.data$F==1 & example.data$G==1),#19
                       sum(example.data$F==1 & example.data$G==0),#20
                       sum(example.data$F==0 & example.data$G==1),#21
                       sum(example.data$F==0 & example.data$G==0)))#22

nodes<-data.frame("name" = names(example.data))


example.list<-list(nodes,links)

names(example.list)<-c("nodes","links")

我的问题是这样的。 1) 尝试在 sankeyNetwork 函数中使用这些数据实际上根本不会产生绘图,并且 2) 显然这种方法容易出错,尤其是当每个节点有超过 2 个目标时。

我在堆栈上找到了一个示例,其中有人在 dplyr::mutate 函数中使用了 match 调用,看起来很有希望实现我想要完成的目标,但数据结构略有不同,我做到了'我真的不知道如何让匹配调用与我自己的数据一起工作。

我想要的输出是桑基图,显示每个 events/outcomes [A:F] 之间移动的观测值数量。因此,假设每一列都代表一个成功或不成功的事件。 sakey 图将说明每个事件的总成功和失败的总结。因此,从 A 开始的所有 1000 个观测值,其中 493 个进入 B = 1 的节点,其余 507 个进入指示 B = 0 的节点。在 B = 1 的 493 个中,345 个进入指示 C = 1 的节点,并且148 转到节点 C = 0。在 B = 0 中的 507 中,263 转到 C = 1,244 转到 C = 0,对于事件 A 到 F 的其余部分依此类推。我希望我已经做到了够清楚了。如有任何帮助,我们将不胜感激。

桑基图不起作用,因为您引用 targetsource 列中的节点,这些节点在 nodes 数据框中不存在。

演示...

sort(unique(c(links$source, links$target)))
# [1]  0  1  2  3  4  5  6  7  8  9 10 11 12

nrow(nodes)
# [1] 7

要将您的原始数据重塑为正确的格式...

您的原始数据难以使用的原因是因为您要使用的重要信息隐式编码在数据的形状中,但未明确包含在数据中。给定行中的每个数据点都具有隐式关系,即它们是由同一实体选择的,但该信息并不明确存在于您的数据中。同样,每一列都隐含地表示一个连续的动作链。对这种情况的一个很好的测试是问问自己,如果你重塑数据,或按列排序,或重新排序列,你是否仍然拥有相同的信息?如果您将 B 列换成 D 列,您仍然拥有所有相同的信息吗?忽略这样一个事实,即人们可以隐含地假设列的预期顺序,因为它们是按字母顺序命名的,答案是否定的......所以这就是你需要开始的地方,通过将该信息编码到你的数据中。

将行号添加为variable/column,然后将所有列聚集成长格式,并添加列号...

events <- 
  example.data %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  gather(column, choice, -row) %>% 
  mutate(column_num = match(column, names(example.data))) %>% 
  arrange(row, column_num) %>% 
  select(row, column_num, everything())

events
# # A tibble: 7,000 x 4
#      row column_num column choice
#    <int>      <int> <chr>   <dbl>
#  1     1          1 A           1
#  2     1          2 B           1
#  3     1          3 C           1
#  4     1          4 D           0
#  5     1          5 E           1
#  6     1          6 F           1
#  7     1          7 G           0
#  8     2          1 A           1
#  9     2          2 B           0
# 10     2          3 C           1
# # ... with 6,990 more rows

现在数据代表每行一个 event/choice,包含您需要的所有关键信息。在您想要的输出中,每个 "node" 都由列定义,并在该阶段做出选择...因此 A_1、B_0、B_1、C_0 、C_1 等。对于重塑数据中的每个事件,您想知道 choice/event 发生在哪个节点 ("target"),以及它来自哪个节点 ("source").目标节点是列名称和该事件的选择。源节点是同一行 (person/entity/observation) 中在它之前的事件 (-1 column_num) 的列名称和选择。

links <-
  events %>% 
  mutate(target = paste0(column, "_", choice)) %>% 
  group_by(row) %>% 
  mutate(source = lag(target)) %>% 
  filter(!is.na(source) & !is.na(target))

links
# # A tibble: 6,000 x 6
# # Groups:   row [1,000]
#      row column_num column choice target source
#    <int>      <int> <chr>   <dbl> <chr>  <chr> 
#  1     1          2 B           1 B_1    A_1   
#  2     1          3 C           1 C_1    B_1   
#  3     1          4 D           0 D_0    C_1   
#  4     1          5 E           1 E_1    D_0   
#  5     1          6 F           1 F_1    E_1   
#  6     1          7 G           0 G_0    F_1   
#  7     2          2 B           0 B_0    A_1   
#  8     2          3 C           1 C_1    B_0   
#  9     2          4 D           0 D_0    C_1   
# 10     2          5 E           1 E_1    D_0   
# # ... with 5,990 more rows

现在您想汇总该数据。您想要计算每个唯一 link/path.

的数量
links <- 
  links %>% 
  select(source, target) %>% 
  group_by(source, target) %>% 
  summarise(value = n()) %>% 
  ungroup()

links
# # A tibble: 22 x 3
#    source target value
#    <chr>  <chr>  <int>
#  1 A_1    B_0      507
#  2 A_1    B_1      493
#  3 B_0    C_0      244
#  4 B_0    C_1      263
#  5 B_1    C_0      148
#  6 B_1    C_1      345
#  7 C_0    D_0      267
#  8 C_0    D_1      125
#  9 C_1    D_0      579
# 10 C_1    D_1       29
# # ... with 12 more rows

有了它,您只需要按照 sankeyNetwork 要求的格式...一个节点数据框,每个唯一节点一行,以及一个链接数据框,其中源和目标列是数字,指的是节点数据框中节点的索引(从 0 开始)(它们出现的行号 - 1)。

nodes <- data.frame(name = unique(c(links$source, links$target)))

links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
              Target = "target", Value = "value", NodeID = "name")