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)