连续x轴ggplot boxplot的方框宽度不正确?

当我们按组创建方框图时,每个方框的宽度硬编码为组数据范围的90%。我们可以从 compute_group() 在功能 StatBoxplot :

# reproducing lines 87-88 of stat-boxplot.r
if (length(unique(data$x)) > 1)
  width <- diff(range(data$x)) * 0.9

我们可以通过定义 计算组() 函数基于 StatBoxplot$compute_group :

modified.function <- 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))
  }
  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)) * 1 # instead of 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}

创建一个基于 StatBoxplot ,以及基于 stat_boxplot :

StatBoxplot2 <- ggproto(`_class` = "StatBoxplot2",          # class name
                        `_inherit` = StatBoxplot,           # inherit from StatBoxplot
                        compute_group = modified.function)  # override its compute_group function

stat_boxplot2 <- function(mapping = NULL, data = NULL, geom = "boxplot", position = "dodge2", ...,
                           coef = 1.5, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE){
  layer(data = data, mapping = mapping, 
        stat = StatBoxplot2,                           # use StatBoxplot2 rather than StatBoxplot
        geom = geom, position = position, 
        show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(na.rm = na.rm, coef = coef, ...))
}

比较使用默认 stat = "boxplot" ,其中一个使用 stat = "boxplot2" :

# Base plot with vertical dashed lines to indicate each point's position, & theme_classic for a
# less cluttered background. I also changed the palette as Spectral's yellow was really hard to see.
p <- ggplot(data = binnedX, 
            aes(x = elements, y =  divergence, fill = Size))+
  geom_point(aes(color = Size), size = 3) +
  geom_vline(aes(xintercept = elements), linetype = "dashed") +
  scale_fill_brewer(palette = "Set1") +
  scale_color_brewer(palette = "Set1", guide = FALSE) +
  theme_classic()

gridExtra::grid.arrange(p + ggtitle("original") + geom_boxplot(alpha = 0.5),
                        p + ggtitle("modified") + geom_boxplot(alpha = 0.5, stat = "boxplot2"))