为河图创建边

Creating edges for a riverplot

我希望使用 riverplot 包来创建流程图。此包需要 'edges',它们是级别之间的流。我想从数据框创建边缘数据结构。例如,这里有一些代码来创建我的输入数据。

rp.df<-structure(list(ID = 1:20, X1 = structure(c(1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "A1", class = "factor"), 
X2 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A2", 
"B2"), class = "factor"), X3 = structure(c(1L, 1L, 2L, 2L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
3L), .Label = c("A3", "B3", "C3"), class = "factor")), class = "data.frame", row.names = c(NA, 
-20L))
table(rp.df$X1,rp.df$X2)
table(rp.df$X2,rp.df$X3)

使用此输出

> table(rp.df$X1,rp.df$X2)

     A2 B2
  A1 12  8
> table(rp.df$X2,rp.df$X3)

     A3 B3 C3
  A2  2  2  8
  B2  5  2  1

我需要的是一个数据框,其中包含表中标识的流,例如:

N1 N2 Value
A1 A2    12
A1 B2     8
A2 A3     2
A2 B3     2
A2 C3     8
B2 A3     5
B2 B3     2
B2 C3     1

实际上我有 10 列边和 16k 流。我试过使用 reshape2 来做到这一点,但很困难。

这是一个tidyverse解决方案。 select(rp.df, X1:X2) 用于第一个 X 列到最后一个 X 列之前的列。 select(rp.df, X2:X3) 用于第二个 X 列到最后一个 X 列。通过这样做,您可以确保解决每个列组合。 dat 是最终输出。

library(tidyverse)

dat <- map2_dfr(select(rp.df, X1:X2), 
                select(rp.df, X2:X3),
                ~as_data_frame(table(.x, .y))) %>%
  set_names(c("N1", "N2", "Value"))
dat
# # A tibble: 8 x 3
#   N1    N2    Value
#   <chr> <chr> <int>
# 1 A1    A2       12
# 2 A1    B2        8
# 3 A2    A3        2
# 4 B2    A3        5
# 5 A2    B3        2
# 6 B2    B3        2
# 7 A2    C3        8
# 8 B2    C3        1

这是一个基本的 R 解决方案,适用于您拥有的许多列。

out <- lapply(2:(ncol(rp.df) - 1), function(i) {
  as.data.frame(table(rp.df[, i], rp.df[, i + 1]))
  }
)
setNames(do.call(rbind, out), c("N1", "N2", "Value"))
#   N1 N2 Value
# 1 A1 A2    12
# 2 A1 B2     8
# 3 A2 A3     2
# 4 B2 A3     5
# 5 A2 B3     2
# 6 B2 B3     2
# 7 A2 C3     8
# 8 B2 C3     1

为了完整起见,这里有两个 data.table 解决方案。

第一种是先把节点数据绑定成一个大数据对象,最后聚合。最后,第二个聚合列的每个组合并绑定总计。

绑定节点数据然后聚合

library(data.table)
library(magrittr)
setDT(rp.df)
edges <- lapply(3:ncol(rp.df), 
       function(i) rp.df[, .SD, .SDcols = (i-1L):i]) %>% 
  rbindlist() %>% 
  .[, .(Value = .N), by = .(N1 = X1, N2 = X2 )]
edges
   N1 N2 Value
1: A1 A2    12
2: A1 B2     8
3: A2 A3     2
4: A2 B3     2
5: A2 C3     8
6: B2 A3     5
7: B2 B3     2
8: B2 C3     1

聚合节点数据然后绑定

nm <- names(rp.df) %>% stringr::str_subset("^X")
edges <- lapply(2:length(nm), 
                function(i) rp.df[, .N, by = c(nm[i-1], nm[i])]) %>%
  rbindlist() 
setnames(edges, c("N1", "N2", "Value"))
edges
   N1 N2 Value
1: A1 A2    12
2: A1 B2     8
3: A2 A3     2
4: A2 B3     2
5: A2 C3     8
6: B2 A3     5
7: B2 B3     2
8: B2 C3     1

警告

请注意,在某些边出现多次的情况下,这两种方法并不完全等效。 (对于给定的样本数据集,它们是等效的)。

让我们假设边 (A1, A2) 出现在 X1X2 中,也出现在 X2X3 中。第一种方法将在一个输出行中对此进行汇总,而第二种方法将创建两个输出行。因此,第二种方法需要额外的聚合步骤才能产生与第一种方法相同的结果。

哪种方法合适必须由 OP 决定。

如果需要,也可以记录出现边缘的阶段或级别:

nm <- names(rp.df) %>% stringr::str_subset("^X")
edges <- lapply(2:length(nm), 
                function(i) rp.df[, .N, by = c(nm[i-1], nm[i])]) %>%
  rbindlist(idcol = TRUE) 
setnames(edges, c("Level", "N1", "N2", "Value"))
edges

   Level N1 N2 Value
1:     1 A1 A2    12
2:     1 A1 B2     8
3:     2 A2 A3     2
4:     2 A2 B3     2
5:     2 A2 C3     8
6:     2 B2 A3     5
7:     2 B2 B3     2
8:     2 B2 C3     1