R ggplot2-不同宽度的堆叠钢筋

我想制作一个反向金字塔图，其中条形图以不同的宽度相互堆叠

首先，我有一个堆叠的条形图，如下代码示例

library(dplyr)
library(ggplot2)
sample <- data_frame(x=c(1, 1, 1, 1, 2, 2, 2, 2),
                     y=c(5,10,15, 20, 10, 5, 20, 10),
                     w=c(1, 2, 3, 4, 1, 2, 3, 4),
                     group=c("a", "b", "c", "d", "a", "b", "c", "d"))

ggplot() +
    geom_bar(data=sample,
             aes(x=x,y=y,group=group, fill=group),
             stat="identity", position=position_stack())

任何帮助使条形图堆叠或不同类型的想法，可以涵盖类似的概念将不胜感激。谢谢

这有点像黑客

我将使用

geom_rect（）

而不是实列。因此，我需要为矩形边界创建带有预先计算位置的

data.frame（）

df_plot <- sample %>% 
  arrange(desc(group)) %>% # Order so lowest 'groups' firtst
  group_by(x) %>% 
  mutate(yc = cumsum(y), # Calculate position of "top" for every rectangle
         yc2 = lag(yc, default = 0) ,# And position of "bottom"
         w2 = w/5) # Small scale for width


# Plot itself

ggplot(df_plot) +
  geom_rect(
    aes(xmin = x - w2 / 2, xmax = x + w2 / 2,
        ymin = yc, ymax = yc2,
        group = group, fill=group))

df_图%
排列（描述（组））%>%#使最低的“组”排在第一位
分组依据（x）%>%
变异（yc=cumsum（y），#计算每个矩形的“顶部”位置
yc2=滞后（yc，默认值=0），#和“底部”的位置
w2=w/5）#宽度的小刻度
#自作主张
ggplot（df_图）+
几何校正(
aes（xmin=x-w2/2，xmax=x+w2/2，
ymin=yc，ymax=yc2，
组=组，填充=组）

结果图：

---

一个带有丝带的相当长的版本

library(dplyr)
library(ggplot2)
sample <- data_frame(x=c(1, 1, 1, 1, 2, 2, 2, 2),
                     y=c(5,10,15, 20, 10, 5, 20, 10),
                     w=c(1, 2, 3, 4, 1, 2, 3, 4),
                     group=c("a", "b", "c", "d", "a", "b", "c", "d"))

# make factors for non-numeic items
sample$x <- factor(sample$x)
sample$group <- factor(sample$group)

# calcualte cumulative sums
sample2 <- sample %>%
  group_by(x) %>%
  arrange(desc(group)) %>%
  mutate(ycum=cumsum(y)) %>%
  ungroup()  %>%
  select(x, group, ycum, w) 

# Ffor each point, make another row lagged  
sample2lead <- sample2 %>%
  group_by(x) %>%
  mutate(ycum = lag(ycum, default=0), w=lag(w, default=max(sample2$w))) %>%
  ungroup() %>%
  select(x, group, ycum, w) 

# combine   
combined <- bind_rows(sample2, sample2lead) %>%
  arrange(x, ycum, desc(group))


# plot a ribbon forming trapezoids
ggplot() +
  geom_ribbon(data=combined,
             aes(x=ycum, ymin=-w/2, ymax=w/2, fill=group)) +
  coord_flip() +
  facet_grid(~x)

库（dplyr）
图书馆（GG2）
样本百分比
解组（）%>%
选择（x、组、ycum、w）
#对于每一点，使另一行落后
样本2铅%
分组依据（x）%>%
突变（ycum=lag（ycum，默认值=0），w=lag（w，默认值=max（样本2$w）））%>%
解组（）%>%
选择（x、组、ycum、w）
#结合
合计%
排列（x、ycum、desc（组））
#绘制形成梯形的带状图形
ggplot（）+
geom_功能区（数据=组合，
aes（x=ycum，ymin=-w/2，ymax=w/2，fill=group））+
coord_flip（）+
平面网格（~x）

df_plot <- sample %>% 
  arrange(desc(group)) %>% # Order so lowest 'groups' firtst
  group_by(x) %>% 
  mutate(yc = cumsum(y), # Calculate position of "top" for every rectangle
         yc2 = lag(yc, default = 0) ,# And position of "bottom"
         w2 = w/5) # Small scale for width


# Plot itself

ggplot(df_plot) +
  geom_rect(
    aes(xmin = x - w2 / 2, xmax = x + w2 / 2,
        ymin = yc, ymax = yc2,
        group = group, fill=group))

library(dplyr)
library(ggplot2)
sample <- data_frame(x=c(1, 1, 1, 1, 2, 2, 2, 2),
                     y=c(5,10,15, 20, 10, 5, 20, 10),
                     w=c(1, 2, 3, 4, 1, 2, 3, 4),
                     group=c("a", "b", "c", "d", "a", "b", "c", "d"))

# make factors for non-numeic items
sample$x <- factor(sample$x)
sample$group <- factor(sample$group)

# calcualte cumulative sums
sample2 <- sample %>%
  group_by(x) %>%
  arrange(desc(group)) %>%
  mutate(ycum=cumsum(y)) %>%
  ungroup()  %>%
  select(x, group, ycum, w) 

# Ffor each point, make another row lagged  
sample2lead <- sample2 %>%
  group_by(x) %>%
  mutate(ycum = lag(ycum, default=0), w=lag(w, default=max(sample2$w))) %>%
  ungroup() %>%
  select(x, group, ycum, w) 

# combine   
combined <- bind_rows(sample2, sample2lead) %>%
  arrange(x, ycum, desc(group))


# plot a ribbon forming trapezoids
ggplot() +
  geom_ribbon(data=combined,
             aes(x=ycum, ymin=-w/2, ymax=w/2, fill=group)) +
  coord_flip() +
  facet_grid(~x)