我正在尝试创建一个桑基图,其概念与此处看到的相似。我希望创建的图表可能具有比提供的示例更多的中间节点。
我一直在尝试使用 networkd3 包,特别是sankeyNetwork
功能。我的困难是将我拥有的数据放入正确的结构中以用于sankeyNetwork
。
我的数据是调查数据,要求受访者从最重要到最不重要对指标进行排名。例如
W X Y Z
[1,] "Rank 1" "Rank 2" "Rank 3" "Rank 4"
[2,] "Rank 2" "Rank 3" "Rank 1" "Rank 4"
[3,] "Rank 1" "Rank 2" "Rank 3" "Rank 4"
[4,] "Rank 1" "Rank 2" "Rank 4" "Rank 3"
其中 W、X、Y 和 Z 是指标。
要创建桑基,我需要数据的形式为:
0 1 10
0 2 5
1 3 2
第一列表示起始节点(编号从 0 开始(。第二列是结束节点。第三列是连接节点的链路的值/权重。 还将有一个包含节点名称的向量。
我的最终目标是有一个桑基(从左到右移动(第一列节点,代表指标及其收到的"排名 1"投票比例。第 2 列将再次包含所有指标,但代表"排名 2"投票比例的链接依此类推,直到最后一列包含每个指标收到的最后一名投票的比例。
我正在寻找一种自动化数据转换的方法(因为缺少更好的词(,因为我应该拥有的数据集将有 7 个指标(因此 7 个排名位置(和来自 50-100 人的响应,因此有许多可能的排名组合。
目前我可以使用类似于
example_data %>%
filter(W == "Rank 1" && X == "Rank 2") %>%
tally()
提供计数,但这需要我写出来或循环遍历,指标和排名的每一个可能的组合。实际上,对于我建议使用的数据大小而言,这并不可行。
编辑:感谢您的反馈CJ Yetman。我已经设法解决了这个问题,因此不需要实现您的答案,但您的解决方案可能比我最终所做的要简单一些。
我创建了一个包含原始数据的sankey_data数据集,以便我可以使用数据的副本。
sankey_data[["id"]] <- seq(1, nrow(sankey_data))
sankey_data <- sankey_data %>%
select(id, everything())
sankey_data <- apply(sankey_data, 2, as.character)
# Not necessarily required but I needed to convert the data points from factors
# to characters.
# Creating new variables to store data in more helpful format
sankey_data$Rank1 <- rep(NA, nrow(sankey_data))
sankey_data$Rank2 <- rep(NA, nrow(sankey_data))
sankey_data$Rank3 <- rep(NA, nrow(sankey_data))
sankey_data$Rank4 <- rep(NA, nrow(sankey_data))
# Filling in those new variables
ranking_levels <- c("Rank 1", "Rank 2", "Rank 3", "Rank 4")
for (i in 1:nrow(sankey_data)) {
for (j in 1:length(ranking_levels)) {
hold <- colnames(sankey_data[i, grep(sankey_data[i,],
pattern = paste0("^", ranking_levels[j]), fixed = F)])
sankey_data[i, 8 + j] <- hold
}
}
# Creating the Link data
Link1 <- sankey_data %>%
plyr::count(vars = c("Rank1", "Rank2")) %>%
mutate("link" = 1)
Link2 <- sankey_data %>%
plyr::count(vars = c("Rank2", "Rank3")) %>%
mutate("link" = 2)
Link3 <- sankey_data %>%
plyr::count(vars = c("Rank3", "Rank4")) %>%
mutate("link" = 3)
# I then added prefixes to each data point within links 1 - 3 respectively.
# I just used paste0 but won't include the detail here as this is additional to
# what is strictly necessary to create the Sankey.
# Adding column names
colnames(Link1) <- c("source", "target", "value", "link")
colnames(Link2) <- colnames(Link1)
colnames(Link3) <- colnames(Link1)
# Combing into a single data set
links <- rbind(Link1, Link2, Link3)
nodes <- data.frame(name = c(as.character(links[["source"]]),
as.character(links[["target"]])) %>% unique())
# As sankeyNetwork requires the nodes to be in numeric form (starting from 0),
# this serevs to convert the node names to numbers for input into the function
links[["IDsource"]] <- match(links[["source"]], nodes[["name"]]) - 1
links[["IDtarget"]] <- match(links[["target"]], nodes[["name"]]) - 1
# The Sankey
sankeyNetwork(Links = links,
Nodes = nodes,
Source = "IDsource",
Target = "IDtarget",
Value = "value",
fontFamily = "Arial",
NodeID = "name",
sinksRight = FALSE, fontSize = 24, height = 1400, width = 3200)
这段代码对我有用。我试图调整它以处理示例数据,因为我无法发布实际数据,因此可能遗漏了一两个工件并且没有意义。如果是这种情况,请告诉我,我会尝试更新它。
我不完全确定您要查找的输出是什么,但它听起来与此解决方案非常相似。
这是适用于您的问题的解决方案...
library(dplyr)
library(tidyr)
example_data <-
tibble::tribble(
~W, ~X, ~Y, ~Z,
"Rank 1", "Rank 2", "Rank 3", "Rank 4",
"Rank 2", "Rank 3", "Rank 1", "Rank 4",
"Rank 1", "Rank 2", "Rank 3", "Rank 4",
"Rank 1", "Rank 2", "Rank 4", "Rank 3"
)
events <-
example_data %>%
mutate(row = row_number()) %>%
gather(column, choice, -row) %>%
mutate(column_num = match(column, names(example_data))) %>%
arrange(row, column_num) %>%
mutate(target = paste0(column, "_", choice)) %>%
group_by(row) %>%
mutate(source = lag(target)) %>%
filter(!is.na(source) & !is.na(target)) %>%
group_by(source, target) %>%
summarise(value = n())
# # A tibble: 8 x 3
# # Groups: source [7]
# source target value
# <chr> <chr> <int>
# 1 W_Rank 1 X_Rank 2 3
# 2 W_Rank 2 X_Rank 3 1
# 3 X_Rank 2 Y_Rank 3 2
# 4 X_Rank 2 Y_Rank 4 1
# 5 X_Rank 3 Y_Rank 1 1
# 6 Y_Rank 1 Z_Rank 4 1
# 7 Y_Rank 3 Z_Rank 4 2
# 8 Y_Rank 4 Z_Rank 3 1