2017-08-15 22 views
2

棒がお互いに異なる幅で積み重ねられた逆ピラミッドグラフを作りたいと思います。ggplot2 - 異なる幅の積み重なった棒

1、私は、彼らがまだ上に積層されつつ下部w値の一方が小さくなるaesに幅を追加

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()) 
そして

enter image description here

コードサンプル以下のように積み重ね棒グラフを有しますお互い。しかし、バーは警告とともに積み重ねられませんでした。

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

enter image description here

Warning: Ignoring unknown aesthetics: width 
Warning message: 
position_stack requires non-overlapping x intervals 

どれを積み重ねまたは類似の概念をカバーすることができますさまざまなプロットタイプのアイデアが高く評価されるだろうメイクバープロットに役立ちます。ありがとう!

答えて

6

ハックのビットです。

実際の列の代わりに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)) 

結果のプロット:リボン付き enter image description here

3

かなり長いバージョン

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) 

enter image description here

関連する問題