为sankey图构造二进制数据

时间：2018-10-19 15:00:28

标签： r dplyr sankey-diagram htmlwidgets networkd3

我很难弄清楚如何为成功（1）或失败（0）的机会很多的数据绘制sankey图。您可以使用以下代码生成示例：

# 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）显然，此方法容易出错，特别是在每个节点有两个以上目标的情况下。

我在堆栈上找到了一个示例，该人员在dplyr :: mutate函数中使用match调用，该函数对于我尝试完成的工作看起来很有希望，但是数据的结构略有不同，我并不十分了解如何获得匹配调用以处理我自己的数据。

我要输出的结果是一个sankey图，它显示了每个事件/结果[A：F]之间移动的观察值的数量。因此，想象每个列代表一个成功事件或不成功事件。清点图将说明每个事件的总成功和失败的摘要。因此，所有1000个观测值都从A开始，其中493个到达B = 1的节点，其余的507个到达该节点的B =0。在B = 1的493个观测值中，有345个到达该节点的C = 1， 148转到节点C =0。在B = 0的507中，去C = 1，在244中去C = 0，以此类推，直到事件A到F的其余部分。我希望我已经做到了足够清楚。任何帮助，将不胜感激。

1 个答案:

答案 0 :(得分：4)

sankey图无法正常工作，因为您引用了target数据框中不存在的source和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列，您是否还会拥有所有相同的信息？忽略这样一个事实，即由于列是按字母顺序命名的，因此可以隐含地假定列的预期顺序，答案是否定的……因此，您需要通过将该信息编码为数据来开始。

将行号添加为变量/列，然后将所有列收集为长格式，然后添加列号... 

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

现在，数据代表每行一个事件/选择，其中包含您需要的所有关键信息。在所需的输出中，每个“节点”都由该列定义，并在该阶段进行选择...因此，A_1，B_0，B_1，C_0，C_1等。对于重塑数据中的每个事件，您都想知道选择/事件发生在哪个节点（“目标”），以及来自哪个节点（“源”）。目标节点是列名称和该事件的选择。源节点是列名和在同一行（人员/实体/观察）中它之前的事件的选择（-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

现在您要汇总该数据。您要计算每个唯一链接/路径的数量。

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")

enter image description here

相关问题
最新问题