R/ggplot2：从散点图中折叠或删除 y 轴段

Question

我正在尝试使用 ggplot2 在 R 中制作散点图，其中 y 轴的中间被折叠或移除，因为那里没有数据。我在下面的 Photoshop 中做到了，但有没有办法用 ggplot 创建类似的情节？ 这是连续尺度的数据：

但我正在尝试做这样的事情：

代码如下：

ggplot(data=distance_data) +
    geom_point(
        aes(
            x = mdistance,
            y = maxZ,
            shape = factor(subj),
            color = factor(side),
            size = (cSA)
        )
    ) +
    scale_size_continuous(range = c(4, 10)) +
    theme(
        axis.text.x = element_text(colour = "black", size = 15),
        axis.text.y = element_text(colour = "black", size = 15),
        axis.title.x = element_text(colour = "black", size= 20, vjust = 0),
        axis.title.y = element_text(colour = "black", size= 20),
        legend.position = "none"
    ) +
    ylab("Z-score") +
    xlab("Distance")

Answer 1

您可以通过定义坐标变换来做到这一点。一个标准的例子是对数坐标，可以在ggplot中使用scale_y_log10()来实现。

但您也可以通过将trans 参数提供给scale_y_continuous() 来定义自定义转换函数（scale_x_continuous() 也是如此）。为此，您使用 scales 包中的函数 trans_new()。它将变换函数及其逆函数作为参数。

我首先讨论了 OP 示例的特殊解决方案，然后还展示了如何推广它。

OP 的例子

OP 想要缩小 -2 和 2 之间的间隔。下面定义了一个函数（及其逆函数），该函数将这个间隔缩小了 4 倍：

library(scales)
trans <- function(x) {
  ifelse(x > 2, x - 1.5, ifelse(x < -2, x + 1.5, x/4))
}
inv <- function(x) {
  ifelse(x > 0.5, x + 1.5, ifelse(x < -0.5, x - 1.5, x*4))
}
my_trans <- trans_new("my_trans", trans, inv)

这定义了转换。为了查看它的实际效果，我定义了一些示例数据：

x_val <- 0:250
y_val <- c(-6:-2, 2:6)
set.seed(1234)
data <- data.frame(x = sample(x_val, 30, replace = TRUE),
                   y = sample(y_val, 30, replace = TRUE))

我首先绘制它而不进行转换：

p <- ggplot(data, aes(x, y)) + geom_point()
p + scale_y_continuous(breaks = seq(-6, 6, by = 2))

现在我使用scale_y_continuous() 进行转换：

p + scale_y_continuous(trans = my_trans,
                       breaks = seq(-6, 6, by = 2))

如果你想要另一个转换，你必须改变trans()和inv()的定义并再次运行trans_new()。您必须确保inv() 确实是inv() 的倒数。我检查了如下：

x <- runif(100, -100, 100)
identical(x, trans(inv(x)))
## [1] TRUE

一般解决方案

下面的函数定义了一个转换，您可以在其中选择要压扁的区域的下端和上端，以及要使用的因子。直接返回trans对象，可以在scale_y_continuous内部使用：

library(scales)
squish_trans <- function(from, to, factor) {
  
  trans <- function(x) {
    
    if (any(is.na(x))) return(x)

    # get indices for the relevant regions
    isq <- x > from & x < to
    ito <- x >= to
    
    # apply transformation
    x[isq] <- from + (x[isq] - from)/factor
    x[ito] <- from + (to - from)/factor + (x[ito] - to)
    
    return(x)
  }

  inv <- function(x) {
    
    if (any(is.na(x))) return(x)

    # get indices for the relevant regions
    isq <- x > from & x < from + (to - from)/factor
    ito <- x >= from + (to - from)/factor
    
    # apply transformation
    x[isq] <- from + (x[isq] - from) * factor
    x[ito] <- to + (x[ito] - (from + (to - from)/factor))
    
    return(x)
  }
  
  # return the transformation
  return(trans_new("squished", trans, inv))
}

trans() 和inv() 中的第一行处理使用x = c(NA, NA) 调用转换的情况。 （在我最初写这个问题时，ggplot2 的版本似乎没有发生这种情况。不幸的是，我不知道这个 startet 是哪个版本的。）

现在可以使用此函数方便地重做第一部分的绘图：

p + scale_y_continuous(trans = squish_trans(-2, 2, 4),
                       breaks = seq(-6, 6, by = 2))

以下示例显示您可以在任意位置压缩刻度，并且这也适用于点以外的其他几何：

df <- data.frame(class = LETTERS[1:4],
                 val = c(1, 2, 101, 102))
ggplot(df, aes(x = class, y = val)) + geom_bar(stat = "identity") +
  scale_y_continuous(trans = squish_trans(3, 100, 50),
                     breaks = c(0, 1, 2, 3, 50, 100, 101, 102))

最后让我强调一下 cmets 中已经提到的其他内容：这种情节可能会产生误导，应谨慎使用！