使用R中的ggplot2在堆积条形图上叠加线条

Question

我试图使用 <div class="counter"><p>2017</p></div> <div class="counter"><p>1971</p></div> 中的ggplot2 Tuominen-Soini et al. (2012)来制作类似以下内容的数字：

我有一个R，data.frame，有四个变量（数据在问题的最后）：

bars_df

使用> str(bars_df) 'data.frame': 18 obs. of 4 variables: $ key : chr "time_2" "time_2" "time_2" "time_2" ... $ val : Factor w/ 6 levels "0","1","2","3",..: 1 2 3 4 5 6 1 2 3 4 ... $ sum : num 0 147 144 63 512 30 0 100 302 168 ... $ prop: num 0 0.164 0.161 0.07 0.571 0.033 0 0.098 0.297 0.165 ... ，我使用以下内容制作了条形图：

bars_df

另外，通过为个人创建频率表＆＃39; 将从library(ggplot2) ggplot(bars_df, aes(x = key, y = prop, fill = val)) + geom_col(position = 'stack') 和time_1之间以及time_2和time_2之间的一个代码转移到另一个代码（或同一代码），并评估哪些转变（time_3：shift_1至time_1; time_2：shift_2至time_1）的可能性高于预期（以{{1表示） }}）并且不太可能（用time_2表示），＆＃34;我做了以下+（数据再次在最后）：

-

在第一行中，例如＆＃34; 0-0＆＃34;代表从data.frame到> str(lines_df) 'data.frame': 72 obs. of 3 variables: $ code : chr "0-0" "0-1" "0-2" "0-3" ... $ shift: chr "shift_1" "shift_1" "shift_1" "shift_1" ... $ sig : chr "+" NA NA NA ... 0 time_1 0 time_2 from code 0 to code time_1 . So, individuals with a 0 {{}的转变（实际上不是转变） 1}} time_2 code at线型are likely to remain with a + at - `移位，如上图第一图。

虽然有questions demonstrating how to overlay a line on a bar chart的例子，但在这种情况下，我看不出如何将这两个. I'd like to add lines two different组合起来。考虑到条形和线条的这种特定配置，似乎很难。

, one each for数据：

and

data.frame数据：

bars_df

Answer 1

当没有人在观看时，我喜欢写丑陋的代码。

library(dplyr)
library(ggplot2)

d <- arrange(bars_df, key, val) %>%
  group_by(key) %>%
  mutate(prop_start = lag(cumsum(prop)), prop_end = prop_start + prop,
         midpoint = (prop_start + prop_end) / 2,
         next_key = paste("time", 1 + gsub("\\D", "", key) %>%
                            as.integer, sep = "_")) %>%
  mutate(next_key = ifelse(next_key %in% unique(d$key), next_key, NA))

e <- select(d, key, midpoint) %>%
  ungroup %>%
  mutate(key = paste("time", -1 + gsub("\\D", "", key) %>%
                 as.integer, sep = "_")) %>%
  rename(midpoint_end = midpoint) %>%
  filter(key %in% unique(d$key))

e <- full_join(d, e) %>%
  filter(!is.na(midpoint_end)) %>%
  group_by(key, val) %>%
  mutate(next_val = 1:n(),
         code = paste(val, next_val, sep = "-")) %>%
  left_join(lines_df) %>%
  filter(!is.na(sig))

ggplot(d,
       aes(x = key, xend = key, y = prop_start, yend = prop_end)) +
  geom_segment(aes(color = val), size = 10) +
  geom_segment(data = e,
               aes(x = key, xend = next_key,
                   y = midpoint, yend = midpoint_end,
                   lty = sig),
              arrow = arrow(length = unit(6, "pt")))