不幸的是，您的数据集不太适合您想到的那种情节。虽然绘图本身很容易，但要实现所需的绘图涉及“一些”数据整理和准备步骤。
一般问题是您的数据集没有显示从一方到另一方的投票流。它仅显示政党在每次计票中失去或获得的总票数。
但是，在每一步中，只有一方退出，可以从您的数据中提取此缺失信息。基本思想是根据选民的次要政党偏好为每个政党或更准确地说是每个在后来的一项计数中退出的政党划分 obs。
不确定每个步骤是否清楚，但我添加了一些解释作为注释，并添加了数据集最终结构的图，希望可以更清楚地说明所有步骤的最终结果是什么：
library(tidyverse)
library(magrittr)
library(ggalluvial)
# Load Data
house_of_reps <- read_csv("https://results.aec.gov.au/24310/Website/Downloads/HouseDopByDivisionDownload-24310.csv", skip = 1)
house_of_reps$BallotPosition %<>% as.factor()
house_of_reps$CountNumber %<>% as.factor()
cooper <- house_of_reps %>%
filter(DivisionNm == "Cooper") %>%
spread(CalculationType, CalculationValue) %>%
select(count = CountNumber, party = PartyAb, pref = `Preference Count`, trans = `Transfer Count`)
# Helper function to
make_rows <- function(x) {
# Name of party which gets dropped in this period
dropped <- filter(x, trans < 0) %>% pull(party)
if (length(dropped) > 0) {
x <- filter(x, trans >= 0)
# Replacements are added two times. Once for the period where the party drops out,
# and also for the previous period
xdrop <- mutate(x, party = dropped, pref = trans, trans = 0, is_drop = FALSE)
xdrop1 <- mutate(xdrop, count = count - 1, to = party, is_drop = FALSE)
# For the parties to keep or which receive transfered votes have to adjust the number of votes
xkeep <- mutate(x, pref = pref - trans, trans = 0)
bind_rows(xdrop1, xdrop, xkeep)
} else {
x
}
}
cooper1 <- cooper %>%
# First: Convert count to a numeric. Add a "to" variable for second
# party preference or the party where votes are transferred to. This variable
# will later on be mapped on the "fill" aes
mutate(to = party, count = as.numeric(as.character(count))) %>%
group_by(party) %>%
# Add identifier of obs. to drop. Obs. to drop are obs. of parties which
# drop out in the following count
mutate(is_drop = lead(trans, default = 0) < 0) %>%
ungroup() %>%
# Split obs. to be dropped by secondary party preference, i.e. in count 0 the
# obs for party "IND" is replaced by seven obs. reflecting the secondary preference
# for one of the other seven parties
split(.$count) %>%
map(make_rows) %>%
bind_rows() %>%
# Now drop original obs.
filter(!is_drop, pref > 0) %>%
# Add a unique identifier
group_by(count, party) %>%
mutate(id = paste0(party, row_number())) %>%
ungroup() %>%
# To make the flow chart work we have make the dataset complete, i.e. add
# "empty" obs for each type of voter and each count
complete(count, id, fill = list(pref = 0, trans = 0, is_drop = FALSE)) %>%
# Fill up party and "to" columns
mutate(across(c(party, to), ~ if_else(is.na(.), str_extract(id, "[^\\d]+"), .))) %>%
# Filling up the "to" column with last observed value for "to" if any
group_by(id) %>%
mutate(last_id = last(which(party != to)),
to = if_else(count >= last_id & !is.na(last_id), to[last_id], to)) %>%
ungroup()
数据集的最终结构可以通过瓦片图来说明：
cooper1 %>%
add_count(count, party) %>%
ggplot(aes(count, reorder(id, n), fill = to)) +
geom_tile(color = "white")
正如我所说，在所有繁琐的数据争论之后，制作流程图本身是最简单的任务，可以这样实现：
cooper1 %>%
ggplot(aes(x = count, alluvium = id, stratum = to, y = pref, fill = to)) +
geom_flow(decreasing = TRUE) +
geom_stratum(decreasing = TRUE) +
scale_fill_viridis_d() +
theme_minimal()
