R 中的桑基图 - 数据准备

Question

我有以下数据框，其中每个患者都是一行（我仅显示其中的一个样本）：

df = structure(list(firstY = c("N/A", "1", "3a", "3a", "3b", "1", 
"2", "1", "5", "3b"), secondY = c("N/A", "1", "2", "3a", "4", 
"1", "N/A", "1", "5", "3b"), ThirdY = c("N/A", "1", "N/A", "3b", 
"4", "1", "N/A", "1", "N/A", "3b"), FourthY = c("N/A", "1", "N/A", 
"3a", "4", "1", "N/A", "1", "N/A", "3a"), FifthY = c("N/A", "1", 
"N/A", "2", "5", "1", "N/A", "N/A", "N/A", "3b")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -10L))

我想绘制一个桑基图，它显示每个患者随时间变化的轨迹，并且我知道我必须创建节点和链接，但我在将数据转换为完成此操作所需的格式时遇到问题。具体来说，最有问题的问题是计算有多少患者属于每个轨迹，例如，第一年有多少患者从第 1 阶段到第 2 阶段，以及所有其他组合。

任何有关数据准备的帮助将不胜感激。

Alluvial 包虽然简单易懂，但在数据量很大的情况下却不能很好地应对。

Answer 1

您想要实现的目标不是很清楚，因为您没有提及您想要使用的包，但是查看您的数据，如果您可以使用

alluvial

包，这似乎会有所帮助：

library(alluvial) # sankey plots
library(dplyr)    # data manipulation

alluvial

函数可以像你一样使用宽格式的数据，但它需要一个频率列，所以我们可以创建它，然后绘制：

dats_all <- df %>%                                                   # data
            group_by( firstY, secondY, ThirdY, FourthY, FifthY) %>%  # group them
            summarise(Freq = n())                                    # add frequencies

 # now plot it
alluvial( dats_all[,1:5], freq=dats_all$Freq, border=NA )

另一方面，如果您想使用特定的包，则应该指定哪个包。

---

编辑

使用network3D有点棘手，但你也许可以从中获得一些不错的结果。您需要链接和节点，并使它们匹配，所以首先我们可以创建链接：

# put your df in two columns, and preserve the ordering in many levels (columns) with paste0
links <- data.frame(source = c(paste0(df$firstY,'_1'),paste0(df$secondY,'_2'),paste0(df$ThirdY,'_3'),paste0(df$FourthY,'_4')),
                  target   = c(paste0(df$secondY,'_2'),paste0(df$ThirdY,'_3'),paste0(df$FourthY,'_4'),paste0(df$FifthY,'_5')))

# now convert as character
links$source <- as.character(links$source)
links$target<- as.character(links$target)

现在节点是链接中的每个元素，以

unique()

的方式：

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

现在我们需要每个节点都有一个链接（反之亦然），因此我们匹配它们并进行数字转换。注意最后的-1，因为networkD3是0索引，这意味着数字（索引）从0开始。

links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1
links$value <- 1 # add also a value

现在你应该准备好绘制你的 sankey 了：

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

Answer 2

用 networkd3 tidyverse

的方式

library(tidyr)
library(dplyr)
library(networkD3)

df <- read.table(header = TRUE, stringsAsFactors = FALSE, text = "
firstY secondY ThirdY FourthY FifthY
N/A    N/A     N/A    N/A     N/A   
1      1       1      1       1     
3a     2       N/A    N/A     N/A   
3a     3a      3b     3a      2     
3b     4       4      4       5     
1      1       1      1       1     
2      N/A     N/A    N/A     N/A   
1      1       1      1       N/A   
5      5       N/A    N/A     N/A   
3b     3b      3b     3a      3b
")

links <-
  df %>% 
  mutate(row = row_number()) %>%  # add a row id
  pivot_longer(-row, names_to = "col", values_to = "source") %>%  # gather all columns
  mutate(col = match(col, names(df))) %>%  # convert col names to col ids
  mutate(source = paste0(source, '_', col)) %>%  # add col id to node names
  group_by(row) %>%
  mutate(target = lead(source, order_by = col)) %>%  # get target from following node in row
  ungroup() %>% 
  filter(!is.na(target)) %>%  # remove links from last column in original data
  group_by(source, target) %>% 
  summarise(value = n(), .groups = "drop")  # aggregate and count similar links

# create nodes data frame from unque nodes found in links data frame
nodes <- data.frame(id = unique(c(links$source, links$target)),
                    stringsAsFactors = FALSE)
# remove column id from node names
nodes$name <- sub('_[0-9]*$', '', nodes$id)

# create node ids in links data to the 0-based index of the nodes in the nodes data frame
links$source_id <- match(links$source, nodes$id) - 1
links$target_id <- match(links$target, nodes$id) - 1

sankeyNetwork(Links = links, Nodes = nodes, Source = 'source_id',
              Target = 'target_id', Value = 'value', NodeID = 'name')

Answer 3

使用ggforce：

library(ggforce)
library(dplyr)

xx <- df %>% 
  count(firstY, secondY, ThirdY, FourthY, FifthY, name = "value") %>% 
  gather_set_data(1:5) %>% 
  mutate(x = factor(x, levels = colnames(df)))


ggplot(xx, aes(x, id = id, split = y, value = value)) +
  geom_parallel_sets(alpha = 0.3, axis.width = 0.1) +
  geom_parallel_sets_axes(axis.width = 0.3) +
  geom_parallel_sets_labels(colour = "white")

Answer 4

特别感谢 CJ Yetman！非常有用的代码示例，可以帮助我们避免很多麻烦！