默认情况下,对于geom_boxplot
中的较低,中位数和较高位数,将考虑25%,50%和75%的分位数。这些值是根据y
计算出来的,但可以通过美学参数lower
,upper
,middle
手动设置(也提供x
,ymin
和ymax
并设置stat="identity"
)。
但是,这样做会产生一些不良影响(请参见示例代码中的版本1):
group
被忽略,因此在计算中会考虑列的所有值(例如,在计算每个组的最低分位数时)x
分组,并在组中重复出现的次数与数据中出现的特定组值相同(而不是将框合并为更宽的框)通过预先计算所需的值并将其存储在新的数据帧中,可以处理前两点(请参见示例代码中的版本2),而通过识别异常值并将它们相加来固定第三点通过geom_point
分别与图表相对应。
是否有更直接的方法来更改分位数而不产生这些不良影响?
示例代码:
set.seed(12)
# Random data in B, grouped by values 1 to 4 in A
u <- data.frame(A = sample.int(4, 100, replace = TRUE), B = rnorm(100))
# Desired arguments
qymax <- 0.9
qymin <- 0.1
qmiddle <- 0.5
qupper <- 0.8
qlower <- 0.2
版本1:对A中的每个值重复进行框线图绘制,并按A分组
ggplot(u, aes(x = A, y = B)) +
geom_boxplot(aes(group=A,
lower = quantile(B, qlower),
upper = quantile(B, qupper),
middle = quantile(B, qmiddle),
ymin = quantile(B, qymin),
ymax = quantile(B, qymax) ),
stat="identity")
版本2:首先为每个组计算参数。 Base R解决方案
Bgrouped <- lapply(unique(u$A), function(a) u$B[u$A == a])
.lower <- sapply(Bgrouped, function(x) quantile(x, qlower))
.upper <- sapply(Bgrouped, function(x) quantile(x, qupper))
.middle <- sapply(Bgrouped, function(x) quantile(x, qmiddle))
.ymin <- sapply(Bgrouped, function(x) quantile(x, qymin))
.ymax <- sapply(Bgrouped, function(x) quantile(x, qymax))
u <- data.frame(A = unique(u$A),
lower = .lower,
upper = .upper,
middle = .middle,
ymin = .ymin,
ymax = .ymax)
ggplot(u, aes(x = A)) +
geom_boxplot(aes(lower = lower, upper = upper,
middle = middle, ymin = ymin, ymax = ymax ),
stat="identity")
答案 0 :(得分:1)
没有很多的证明,这并不是我真正要做的事情,因为人们通常希望盒图的最小/最大/盒值与相同的分位数位置相对应,但是可以做到。
使用的数据(添加了极端值以显示异常值):
set.seed(12)
u <- data.frame(A = sample.int(4, 100, replace = TRUE), B = rnorm(100))
u$B[c(30, 70, 76)] <- c(4, -4, -5)
解决方案1 :您可以预先计算值,而无需遵循基本R路线,并且可以在同一步骤中包含离群值的计算。我会在Hadley的tidyverse库中完全做到这一点,我发现它更整洁:
library(dplyr)
library(tidyr)
u %>%
group_by(A) %>%
summarise(lower = quantile(B, qlower),
upper = quantile(B, qupper),
middle = quantile(B, qmiddle),
IQR = diff(c(lower, upper)),
ymin = max(quantile(B, qymin), lower - 1.5 * IQR),
ymax = min(quantile(B, qymax), upper + 1.5 * IQR),
outliers = list(B[which(B > upper + 1.5 * IQR |
B < lower - 1.5 * IQR)])) %>%
ungroup() %>%
ggplot(aes(x = A)) +
geom_boxplot(aes(lower = lower, upper = upper,
middle = middle, ymin = ymin, ymax = ymax ),
stat="identity") +
geom_point(data = . %>%
filter(sapply(outliers, length) > 0) %>%
select(A, outliers) %>%
unnest(),
aes(y = unlist(outliers)))
解决方案2 :您可以覆盖ggplot使用的实际分位数规格。 geom_boxplot()
分位数的计算实际上是在here的StatBoxplot
的{{1}}函数中进行的:
compute_group()
compute_group = function(data, scales, width = NULL, na.rm = FALSE, coef = 1.5) {
qs <- c(0, 0.25, 0.5, 0.75, 1)
if (!is.null(data$weight)) {
mod <- quantreg::rq(y ~ 1, weights = weight, data = data, tau = qs)
stats <- as.numeric(stats::coef(mod))
} else {
stats <- as.numeric(stats::quantile(data$y, qs))
}
... (omitted for space)
向量定义分位数位置。它不受传递给qs
的参数的影响,因此更改的唯一方法是更改compute_group()
本身的定义:
compute_group()
结果:
# save a copy of the original function, in case you need to revert
original.function <- environment(ggplot2::StatBoxplot$compute_group)$f
# define new function (only the first line for qs is changed, but you'll have to
# copy & paste the whole thing)
new.function <- function (data, scales, width = NULL, na.rm = FALSE, coef = 1.5) {
qs <- c(0.1, 0.2, 0.5, 0.8, 0.9)
if (!is.null(data$weight)) {
mod <- quantreg::rq(y ~ 1, weights = weight, data = data,
tau = qs)
stats <- as.numeric(stats::coef(mod))
}
else {
stats <- as.numeric(stats::quantile(data$y, qs))
}
names(stats) <- c("ymin", "lower", "middle", "upper", "ymax")
iqr <- diff(stats[c(2, 4)])
outliers <- data$y < (stats[2] - coef * iqr) | data$y > (stats[4] +
coef * iqr)
if (any(outliers)) {
stats[c(1, 5)] <- range(c(stats[2:4], data$y[!outliers]),
na.rm = TRUE)
}
if (length(unique(data$x)) > 1)
width <- diff(range(data$x)) * 0.9
df <- as.data.frame(as.list(stats))
df$outliers <- list(data$y[outliers])
if (is.null(data$weight)) {
n <- sum(!is.na(data$y))
}
else {
n <- sum(data$weight[!is.na(data$y) & !is.na(data$weight)])
}
df$notchupper <- df$middle + 1.58 * iqr/sqrt(n)
df$notchlower <- df$middle - 1.58 * iqr/sqrt(n)
df$x <- if (is.factor(data$x))
data$x[1]
else mean(range(data$x))
df$width <- width
df$relvarwidth <- sqrt(n)
df
}
请注意,更改定义时,它会影响环境中的每个ggplot对象。因此,如果在定义更改之前 创建了ggplot箱线图对象,并在之后将其打印出来,则箱线图将遵循新的定义。 (对于上面的并排比较,我必须立即将每个ggplot转换为grob对象,以保持差异。)