ggplot:限制个别分面的坐标轴限制/刻度值

3
我经常制作带有酒吧图的注释(geom_text)。通常,我更喜欢这些值右对齐(与将标签放在柱顶相反)。在绘制分面条形图时,我将这些值放置在每个组中的最大值上(我之前计算出),再加上一点额外的空间,通过乘以x值来添加(我不使用nudge_x,因为它的绝对值可能适用于某些方面,而不适用于其他方面)。
这种方法让我困扰的是注释下方仍然存在轴标签。请参见下面的图像(轴标签15、100和2.5)。我想将x轴标签限制为每个分面中最大的值,而不要一直延伸到注释处。
我想知道是否有更好的方法可用。
(我知道我可以使用group_split和例如patchwork来生成所需的图形。我在这里的兴趣在于是否有一种直接的方式来限制每个单独方面的轴限制/标签)。
非常感谢。
library(tidyverse)
#> Warning: package 'dplyr' was built under R version 3.6.2
#> Warning: package 'forcats' was built under R version 3.6.3

mtcars %>% 
  group_by(cyl, gear) %>% 
  summarise(n_obs=n()) %>% 
  mutate(n_obs=case_when(gear==4 ~ n_obs*100,
                         TRUE ~ as.numeric(n_obs))) %>% 
  group_by(gear) %>% 
  mutate(n_obs_max=max(n_obs, na.rm=T)) %>% 
  ggplot()+
  geom_bar(aes(y=cyl,
               x=n_obs),
           stat="identity")+
  geom_text(aes(y=cyl,
                x=n_obs_max*1.20,
                label=n_obs))+
  facet_wrap(vars(gear),
             scales="free_x")

本文创建于2020年3月8日,使用reprex包 (v0.3.0)

更新

在@stafan的有益回答后进行跟进,这里对我的问题进行了修改和部分回答。

传递给breaks参数的函数

  my_breaks <- function(x) {

    #calculates the max value on the x axis for each facet
    new_x=max(x) 

    #adjusts this max value for a) the extension of the x axis by the 
    #expand=expansion(mult=c(0, 0.3)) which was needed to have enough space 
    #for the annotation; and the factor added to the position of the 
    #annotations with   x=max_n_obs*1.10; the result is the maximum value 
    #of the bars in each facet;
    old_max <- new_x/1.3/1.1 

    #create 5 labels; the maximum is the highest bar in each facet
    my_pretty=labeling::extended(0, old_max, m=5) 

    #round these values 
    my_pretty=signif(my_pretty, digits=-2) 

    #remove the highest label(s)
    my_pretty=head(unique(my_pretty), -1) 

    #combine the remaining labels and the maximum value of the highest bar
    my_pretty=c(my_pretty, old_max) 
    my_pretty
}

应用于我的(修改后的)示例,这将产生我一直在寻找的结果(见下图)。
library(tidyverse)
#> Warning: package 'dplyr' was built under R version 3.6.2
#> Warning: package 'forcats' was built under R version 3.6.3

my_breaks <- function(x) {
  new_x=max(x)
  old_max <- new_x/1.2/1.05
  #old_max
  my_pretty=labeling::extended(0, old_max, m=5)
  my_pretty=signif(my_pretty, digits=-2)
  my_pretty=head(unique(my_pretty), -1)
  my_pretty=c(my_pretty, old_max)
  my_pretty

}  

mtcars %>% 
  group_by(cyl, gear) %>% 
  summarise(n_obs=n()) %>% 
  mutate(n_obs=case_when(gear==4 ~ n_obs*100,
                         TRUE ~ as.numeric(n_obs))) %>% 
  group_by(gear) %>% 
  mutate(n_obs_max=max(n_obs, na.rm=T)) %>% 
  ggplot()+
  geom_bar(aes(y=cyl,
               x=n_obs),
           stat="identity")+
  geom_text(aes(y=cyl,
                x=n_obs_max*1.20,
                label=n_obs))+
  scale_x_continuous(breaks=my_breaks1,
                     expand=expansion(mult=c(0, 0.05)))+
  facet_wrap(vars(gear),
             scales="free_x")

这个函数的缺点是比例扩展值(1.3)和标签定位因子(1.1)的值被硬编码到函数中。更便捷的方法是在传递给ggplot比例命令的函数中指定这些值,例如:
scale_x_continuous(breaks=my_breaks(expansion=1.3, pos.factor=1.1))

很遗憾,我还没有弄清楚这是如何工作的。

reprex package (v0.3.0)在2020-03-09创建


你提供的代码无法复现你展示的图片(代码中是普通的条形图,而图片中是横向的条形图)... - dario
@dario 我猜是因为我正在使用ggplot 3.3。 - zoowalk
我看到了(3.2.1在这里)。所以ggplot2的行为改变了?!有趣...至于你的问题...我不知道如何使用facet_来完成。也许这个so post有一些替代性的想法? - dario
@dario - 是的,ggplot 3.3引入了许多新的、不错的功能。至于链接,我正在寻找一种比patchwork更“直接”的方法。再次感谢。 - zoowalk
1个回答

1

请尝试这个。

  1. 我扩展了y轴。
  2. 我调整了间断点。我从这里借鉴了一般的思路。函数my_breaks返回pretty_breaks但去除了最后一个值。

(注意:我也交换了美学,y=nobs和x=cyl,并使用了coord_flip,因为在我的机器上运行你的代码并没有重现你的图表(ggplot 3.3.0)。)

library(tidyverse)
#> Warning: package 'forcats' was built under R version 3.6.3

my_breaks <- function(x, n = 5, drop = 2) {
  breaks <- seq(x[[1]], x[[2]], length.out = n)
  breaks <- scales::pretty_breaks()(breaks)
  breaks <- breaks[1:(length(breaks) - drop)]
  breaks
}

mtcars %>% 
  group_by(cyl, gear) %>% 
  summarise(n_obs = n()) %>% 
  mutate(n_obs = case_when(
    gear == 4 ~ n_obs * 100,
    TRUE ~ as.numeric(n_obs))) %>% 
  group_by(gear) %>% 
  mutate(n_obs_max = max(n_obs, na.rm=T)) %>% 
  ggplot(aes(x = cyl))+
  geom_bar(aes(y = n_obs), stat="identity")+
  geom_text(aes(y = n_obs_max * 1.2, label = n_obs))+
  facet_wrap(vars(gear), scales = "free_x") + 
  scale_y_continuous(breaks = function(x) my_breaks(x, 5, 2),
                     expand = expand_scale(mult = c(0.05, .2))) +
  coord_flip()
#> Warning: `expand_scale()` is deprecated; use `expansion()` instead.

此内容创建于2020年3月9日,使用reprex package(v0.3.0)


非常感谢。您展示的图表仍然带有我认为很烦人的轴标签(15、1000、2.5),位于注释值下方。但是您的回答肯定提供了一个有用的途径。我在我的问题中添加了一个修改/部分答案,这可能对其他人也有帮助。 - zoowalk
1
嗨zoowalk。是的,我也不喜欢硬编码。(: 我刚刚对我的代码进行了编辑。现在函数my_breaks有两个额外的参数n=(控制)断点数量和drop指定应该删除多少断点。可能还不是完美的解决方案。 - stefan

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接