如何控制 `facet_wrap()` 中的轴刻度数?
How can one control the number of axis ticks within `facet_wrap()`?
我有一个用 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-axes 上只允许两个刻度。有办法实现吗?
根据建议编辑:
添加 + scale_x_continuous(n.breaks = 2)
看起来应该完全符合我的要求,但实际上并没有:
根据建议问题 中的答案,我得到了两个轴刻度,但不希望有很多小数点:
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))
您可以将if(seq[2]-seq[1] < 10^(-r)) seq else round(seq, r)
添加到开发的功能equal_breaks
中。
这样,只有当标签之间的差异高于阈值 10^(-r)
。
时,您才会在 x 轴上舍入标签
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))
正如您正确指出的那样,这个答案只给出了位数的两个备选方案;所以另一种可能性是 return 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))
实现您想要的结果的一个选择是使用自定义中断 和 限制功能,它建立在 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")
非常感谢您提供这么多有用的建议和很好的答案!通过修改@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))
很抱歉回答我自己的问题...但如果没有社区的大力帮助,那是不可能的:-)
我有一个用 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-axes 上只允许两个刻度。有办法实现吗?
根据建议编辑:
添加 + scale_x_continuous(n.breaks = 2)
看起来应该完全符合我的要求,但实际上并没有:
根据建议问题
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))
您可以将if(seq[2]-seq[1] < 10^(-r)) seq else round(seq, r)
添加到开发的功能equal_breaks
中
这样,只有当标签之间的差异高于阈值 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))
正如您正确指出的那样,这个答案只给出了位数的两个备选方案;所以另一种可能性是 return 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))
实现您想要的结果的一个选择是使用自定义中断 和 限制功能,它建立在 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")
非常感谢您提供这么多有用的建议和很好的答案!通过修改@Maël 的方法并从
在某些情况下,四舍五入到第一个有效小数点会导致高度不对称的刻度,因此我四舍五入到第二个有效小数点。
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))
很抱歉回答我自己的问题...但如果没有社区的大力帮助,那是不可能的:-)