我尝试从this post中提取代码，并编写一个函数，该函数生成一个变换，以沿x轴收缩任意数量的区域沿着。我得到了数据压缩我想要的，但不能找出如何得到轴标签的权利。我怀疑问题在于我实际上是如何在最终函数中组合转换的。
首先，我将原始函数分成两块：

trans_builder <- 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)
  }
  return(trans)
}

inv_builder <- function(from, to, factor){
  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(inv)
}

我还写了一个函数，以某种方式对输入边界进行排序（现在不讨论为什么，因为我认为它与这个问题无关）：

sort_bounds <- function(shrinkbounds){
  from <- c()
  to <- c()
  if(length(shrinkbounds > 0)){
    for(i in 1:(length(shrinkbounds)/2)){
      from <- append(from, shrinkbounds[2*i-1])
      to <- append(to, shrinkbounds[2*i])
    }
    from_order <- order(from, decreasing = TRUE)
    to_order <- order(to, decreasing = TRUE)
    if(identical(from_order, to_order)){
      shrink_out <- c()
      for(i in 1:(length(shrinkbounds)/2)){
        shrink_out <- append(shrink_out, from[from_order[i]])
        shrink_out <- append(shrink_out, to[to_order[i]])
      }
      return(shrink_out)
    }
  }
  return(shrinkbounds)
}

最后，我最终得到的函数：

shrink_trans <- function(shrinkbounds, factor){
  shrinkbounds <- sort_bounds(shrinkbounds)
  trans_final <- trans_builder(shrinkbounds[1], shrinkbounds[2], factor)
  inv_final <- inv_builder(shrinkbounds[1], shrinkbounds[2], factor)
  
  if(length(shrinkbounds) > 2){
    for (i in 2:(length(shrinkbounds)/2)){
      transi <- trans_builder(shrinkbounds[2*i-1], shrinkbounds[2*i], factor)
      invi <- trans_builder(shrinkbounds[2*i-1], shrinkbounds[2*i], factor)
      
      trans_int <- trans_final
      inv_int <- inv_final
      
      trans_final <- function(x) return(transi(trans_int(x)))
      inv_final <- function(x) return(inv_int(invi(x)))
    }
  }
  return(trans_new('shrink_trans', trans_final, inv_final))
}

这个想法是，收缩边界是一个向量，列出了你想要收缩的区域的边界（即，c（1，5，6，8，9，10）在1和5、6和8以及9和10之间收缩），而factor指定希望轴收缩的程度。现在，在测试数据集上运行函数：

df <- data.frame(x = 1:50, y = runif(50))

ggplot(df, aes(x, y)) +
  geom_point() +
  coord_cartesian(clip = 'off', xlim = c(1, 50)) +
  scale_x_continuous(breaks = 1:50, labels = 1:50, trans = shrink_trans(c(1, 20, 30, 50), 20), expand = c(0, 0))

输出图

正如您所看到的，在两端有两个数据簇，但唯一显示的x轴刻度是1。为什么会这样？
我尝试在shrink_transs函数中添加一个参数xbreaks，这样我就可以将transnew中的breaks参数设置为trans_new('shrink_trans', trans_final, inv_final, breaks = xbreaks)，但这并没有什么区别。