如何控制 `facet_wrap()` 中的坐标轴刻度数量？

Question

我有一个使用facet_wrap创建的图形，用于可视化许多组的估计密度。其中一些组的方差要小得多。这导致某些面板的x轴不可读。最小可重现示例：

library(tidyverse)
x1 <- rnorm(1e4)
x2 <- rnorm(1e4,mean=2,sd=0.00001)

data.frame(x=c(x1,x2),group=c(rep("1",length(x1)),rep("2",length(x2)))) %>%
  ggplot(.) + geom_density(aes(x=x)) + facet_wrap(~group,scales="free")

显而易见的解决问题的方法是增加图形大小，这样一切都变得可读。但是，由于有太多的面板，这并不是一个有用的解决方案。我最喜欢的解决方案是控制轴标记的数量，例如，在所有x轴上只允许两个标记。有没有办法实现这个？

---

建议后编辑：

添加+ scale_x_continuous(n.breaks = 2)看起来应该正好符合我的要求，但实际上并不是：

在建议问题使用ggplot2中的facet_grid更改间断数的答案后，我最终得到了两个轴刻度，但不希望有太多的小数点：

equal_breaks <- function(n = 3, s = 0.5, ...){
  function(x){
    # rescaling
    d <- s * diff(range(x)) / (1+2*s)
    seq(min(x)+d, max(x)-d, length=n)
  }
}

data.frame(x=c(x1,x2),group=c(rep("1",length(x1)),rep("2",length(x2)))) %>%
  ggplot(.) + geom_density(aes(x=x)) + facet_wrap(~group,scales="free")  + scale_x_continuous(breaks=equal_breaks(n=3, s=0.05), expand = c(0.05, 0))

- LuckyPal

---

你是否在寻找 ... + scale_x_continuous(n.breaks = 2)？ - nniloc

我认为它们是相同的，尽管 3 可能更好看！ - caldwellst

@nniloc 从第二个图表中删除刻度。 - neuron

这个回答解决了你的问题吗？在ggplot2中使用facet_grid改变breaks的数量 - Maël

@caldwellst 在发布这个问题之前，我确实阅读了这篇文章，但不幸的是它并没有帮助到我。感谢您的建议！ - LuckyPal

Answer 1

您可以将if(seq[2]-seq[1] < 10^(-r)) seq else round(seq, r)添加到这里开发的equal_breaks函数中。

这样做，您只会在 x 轴标签之间的差异超过阈值 10^(-r) 时才对其进行四舍五入。

equal_breaks <- function(n = 3, s = 0.05, r = 0,...){
  function(x){
    d <- s * diff(range(x)) / (1+2*s)
    seq = seq(min(x)+d, max(x)-d, length=n)
    if(seq[2]-seq[1] < 10^(-r)) seq else round(seq, r)
  }
}

data.frame(x=c(x1,x2),group=c(rep("1",length(x1)),rep("2",length(x2)))) %>%
  ggplot(.) + geom_density(aes(x=x)) + facet_wrap(~group, scales="free") +
  scale_x_continuous(breaks=equal_breaks(n=3, s=0.05, r=0)) 

正如您所指出的，这个答案只给出了两个数字位数的选择，因此另一个可能性是返回round(seq, -floor(log10(abs(seq[2]-seq[1]))))，它可以为每个方面获取“最佳”的数字位数。

equal_breaks <- function(n = 3, s = 0.1,...){
  function(x){
    d <- s * diff(range(x)) / (1+2*s)
    seq = seq(min(x)+d, max(x)-d, length=n)
    round(seq, -floor(log10(abs(seq[2]-seq[1]))))
  }
}

data.frame(x=c(x1,x2,x3),group=c(rep("1",length(x1)),rep("2",length(x2)),rep("3",length(x3)))) %>%
  ggplot(.) + geom_density(aes(x=x)) + facet_wrap(~group, scales="free") +
  scale_x_continuous(breaks=equal_breaks(n=3, s=0.1)) 

- Maël

---

+1 很棒的回答，谢谢！对于示例数据集，它完美地运行。然而，对于我的实际数据，它仍然产生了太多的小数点。我不明白为什么...（当然，你也无法知道，因为你不知道我的数据）。 - LuckyPal

谢谢。你有哪些序列存在问题？ - Maël

你的回答只定义了两种舍入方式，即小数位的最大值和最小值。尝试使用另一个组进行测试：x3 <- rnorm(1e4,mean=2,sd=0.01)。 - LuckyPal

没错！我进行了编辑以获得一些“最佳”四舍五入的值。如果你觉得它运行良好，请告诉我 ;) - Maël

floor(log10()) 是一个巧妙的技巧！为了自己的使用，我在四舍五入时添加了 +1，以避免不对称的轴刻度（在您的图中，您可以看到这种情况发生在第二个密度上，但在我的实际数据中，有更极端的情况）。现在它运作得非常好！ - LuckyPal

Answer 2

非常感谢提供如此多有用的建议和出色的答案！我通过修改@Maël的方法并借用RHertel在“计算小数点和第一个非零数字之间的前导零数”中提供的优秀函数，找到了适用于任意复杂数据集的解决方案（至少我希望如此）。

将四舍五入到第一个有效小数位会导致某些情况下高度不对称的刻度，因此我选择将其四舍五入到第二个有效小数位。

library(tidyverse)
x1 <- rnorm(1e4)
x2 <- rnorm(1e4,mean=2,sd=0.000001)
x3 <- rnorm(1e4,mean=2,sd=0.01)

zeros_after_period <- function(x) {
  if (isTRUE(all.equal(round(x),x))) return (0) # y would be -Inf for integer values
  y <- log10(abs(x)-floor(abs(x)))   
  ifelse(isTRUE(all.equal(round(y),y)), -y-1, -ceiling(y))} # corrects case ending with ..01

equal_breaks <- function(n,s){
  function(x){
    x=x*10000
    d <- s * diff(range(x)) / (1+2*s)
    seq = seq(min(x)+d, max(x)-d, length=n) / 10000
    round(seq,zeros_after_period(seq[2]-seq[1])+2)
  }
}

data.frame(x=c(x1,x2,x3),group=c(rep("1",length(x1)),rep("2",length(x2)),rep("3",length(x3)))) %>%
  ggplot(.) + geom_density(aes(x=x)) + facet_wrap(~group, scales="free") +
  scale_x_continuous(breaks=equal_breaks(n=2, s=0.1)) 
 

抱歉自己回答自己的问题...但没有社区的大力帮助是不可能做到的 :-)

- LuckyPal

Answer 3

实现您所需的结果的一种方法是使用自定义断点和限制函数，该函数建立在scales::breaks_extended基础上，首先获取范围的漂亮的断点，然后利用seq获取所需数量的断点。然而，根据所需的断点数，这种简单的方法不能确保我们最终得到漂亮的断点。

library(ggplot2)

set.seed(123)
x1 <- rnorm(1e4)
x2 <- rnorm(1e4,mean=2,sd=0.00001)

mylimits <- function(x) range(scales::breaks_extended()(x))

mybreaks <- function(n = 3) {
  function(x) {
    breaks <- mylimits(x)
    seq(breaks[1], breaks[2], length.out = n)  
  }
}

d <- data.frame(x=c(x1,x2),group=c(rep("1",length(x1)),rep("2",length(x2))))
ggplot(d) + 
  geom_density(aes(x=x)) + 
  scale_x_continuous(breaks = mybreaks(n = 3), limits = mylimits) +
  facet_wrap(~group,scales="free")

- stefan

---

到目前为止，这是最好的建议！它确实很有效，但并不完美。对于某些面板，出现的刻度比其他面板少。这也在breaks_extended()的帮助中提到：“您可能会获得比请求的稍微多或稍微少的间断点。” - LuckyPal

没错。但我只是利用scales::breaks_extended来获取范围内的漂亮断点。应该提到，我的答案并不是通用的设置断点或刻度线的方法。只是一种实现你所需结果的方法，即每个面板有两个刻度线。这就是我的方法所做的，它将为您的范围提供两个漂亮的断点，并在需要时提供中点。但这个想法可能可以扩展到处理更一般的情况。 - stefan