分组时覆盖箱图中的下部,上部等

时间:2018-12-08 16:33:26

标签: r ggplot2 boxplot

默认情况下,对于geom_boxplot中的较低,中位数和较高位数,将考虑25%,50%和75%的分位数。这些值是根据y计算出来的,但可以通过美学参数loweruppermiddle手动设置(也提供xyminymax并设置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")

1 个答案:

答案 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)))

tidyverse solution

解决方案2 :您可以覆盖ggplot使用的实际分位数规格。 geom_boxplot()分位数的计算实际上是在hereStatBoxplot的{​​{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
}

side-by-side

请注意,更改定义时,它会影响环境中的每个ggplot对象。因此,如果在定义更改之前 创建了ggplot箱线图对象,并在之后将其打印出来,则箱线图将遵循新的定义。 (对于上面的并排比较,我必须立即将每个ggplot转换为grob对象,以保持差异。)