Facet Wrap ggplot geom_col 具有不同的条形宽度

Question

我正在使用 geom_col 创建一个带有条形的图表，并使用 gem_point（线）将性能与“基准”进行比较。性能度量属于不同的域，因此我使用 facet_wrap 将域直观地分成组，以便于查看。但是，因为每个域有不同数量的度量，所以条“高度”/宽​​度是不同的。

    df = data.frame(
  measure = c("Measure A","Measure B","Measure C","Measure D","Measure E","Measure F","Measure G"),
  domain = c("Efficiency","Efficiency","Satisfaction","Satisfaction", "Satisfaction","Satisfaction","Satisfaction"),
  overall = c(56, 78, 19, 87, 45, 51, 19),
  company = c(45, 89, 18, 98, 33, 55, 4)
)

ggplot(df %>% mutate(fill = ifelse(overall > company, " Below Overall  "," Above Overall  ")), aes(measure)) + 
  geom_col(aes(y=company, fill= fill)) + geom_point(aes(y=overall, color="overall"), size=6, shape=124) + coord_flip() + 
  scale_color_manual(values=c("grey3"),labels=c("Overall")) + scale_fill_manual(values=c(" Below Overall  "="lightpink2"," Above Overall  "="lightblue2")) + facet_wrap(~domain, ncol=1, scales="free_y")

我从发布的一个较早的问题中看到有关计算每个域的条数，然后将宽度乘以一个因子。但我不知道如何做到这一点并将其应用于我的图表。

Answer 1

也许使用facet_grid 和space = "free" 会令人满意：

ggplot(df %>% mutate(fill = ifelse(overall > company, " Below Overall  "," Above Overall  ")), aes(measure)) + 
  geom_col(aes(y=company, fill= fill)) + 
  geom_point(aes(y=overall, color="overall"), size=6, shape=124) +
  scale_color_manual(values=c("grey3"),labels=c("Overall")) +
  scale_fill_manual(values=c(" Below Overall  "="lightpink2"," Above Overall  "="lightblue2")) + 
  facet_grid(domain~., scales="free", space = "free") +
  coord_flip()

Answer 2

我最终非常需要这个，并且已经切换到geom_segment() 用于许多传统的条形图。

library(hrbrthemes)
library(ggplot2)
library(dplyr)

data_frame(
  measure = c("Measure A","Measure B","Measure C","Measure D","Measure E","Measure F","Measure G"),
  domain = c("Efficiency","Efficiency","Satisfaction","Satisfaction", "Satisfaction","Satisfaction","Satisfaction"),
  overall = c(56, 78, 19, 87, 45, 51, 19),
  company = c(45, 89, 18, 98, 33, 55, 4)
) %>% 
  mutate(fill = ifelse(overall > company, " Below Overall  "," Above Overall  ")) %>% 
  ggplot() +
  geom_segment(aes(x=company, xend=0, y=measure, yend=measure, color=fill), size=4) + 
  geom_point(aes(x=overall, y=measure, color="Overall"), size=6, shape=124, show.legend = FALSE) +
  scale_x_comma() +
  scale_color_manual(name=NULL,
                     values=c(`Overall`="grey3", " Below Overall  " = "lightpink2",
                              " Above Overall  " = "lightblue2")) +
  facet_wrap(~domain, ncol=1, scales="free_y") +
  labs(x="Measure", y=NULL) +
  theme_ipsum(grid="X")

这样做的另一个好处是不需要coord_flip()。

如果您真的需要单独的Overall 指南，也有办法做到这一点。

更新

刻面排序和间距…

library(hrbrthemes)
library(ggplot2)
library(dplyr)
library(grid)
library(gridExtra)

data_frame(
  measure = c("Measure A","Measure B","Measure C","Measure D","Measure E","Measure F","Measure G"),
  domain = c("Efficiency","Efficiency","Satisfaction","Satisfaction", "Satisfaction","Satisfaction","Satisfaction"),
  overall = c(56, 78, 19, 87, 45, 51, 19),
  company = c(45, 89, 18, 98, 33, 55, 4)
) %>% 
  mutate(fill = ifelse(overall > company, " Below Overall  "," Above Overall  ")) %>% 
  arrange(desc(measure)) %>% 
  mutate(measure = factor(measure, levels=unique(measure))) %>% 
  ggplot() +
  geom_segment(aes(x=company, xend=0, y=measure, yend=measure, color=fill), size=4) + 
  geom_point(aes(x=overall, y=measure, color="Overall"), size=6, shape=124, show.legend = FALSE) +
  scale_x_comma() +
  scale_color_manual(name=NULL,
                     values=c(`Overall`="grey3", " Below Overall  " = "lightpink2",
                              " Above Overall  " = "lightblue2")) +
  facet_wrap(~domain, ncol=1, scales="free_y") +
  labs(x="Measure", y=NULL) +
  theme_ipsum(grid="X") -> gg

gb <- ggplot_build(gg)
gt <- ggplot_gtable(gb)

gt$heights[[7]] <- unit(2/5, "cm") # top panel has 2 out of 5 factors vs 5 out of 5 in the bottom one

grid.newpage() ;
grid.draw(gt)