r - 当 x 中没有 NA 值时，scale_x_continues 将 NA 值发送到 trans

Question

因此，由于时间序列上的样本间隔不均匀，我试图扩展我的 X 轴的一部分，以便可以可视化早期动态。我发现了这个用于挤压 Y 轴的 neet 函数（需要从 MWE 获取）：

squash_axis <- function(from, to, factor) {
  # A transformation function that squashes the range of [from, to] by factor on a given axis

  # Args:
  #   from: left end of the axis
  #   to: right end of the axis
  #   factor: the compression factor of the range [from, to]
  #
  # Returns:
  #   A transformation called "squash_axis", which is capsulated by trans_new() function
  trans <- function(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) {
    # get indices for the relevant regions
    isq_i <- x > from & x < from + (to - from)/factor
#This was added by me in an atempt to understand the error
    if(anyNA(isq_i)){
      message(x)
    }
    ito_i <- x >= from + (to - from)/factor
    # apply transformation
    x[isq_i] <- from + (x[isq_i] - from) * factor
    x[ito_i] <- to + (x[ito_i] - (from + (to - from)/factor))

    return(x)
  }

  # return the transformation
  return(trans_new("squash_axis2", trans, inv))
}

（来源：https ://rpubs.com/huanfaChen/squash_remove_y_axix_ggplot ）我想我可以将它应用到我的 x 轴但因子<1。但是，我得到了这些非常奇怪的 NA 值，我不明白它们是从哪里来的。

这是我的 MWE（请注意，我注释掉了一些我运行但认为不会导致错误的代码）：

#MWE
if (!("pacman" %in% .packages(all.available = T))) {
  install.packages("pacman")
  library("pacman")
} else if(!("pacman" %in% (.packages()))) {
  library("pacman")
}
p_load(dplyr, ggplot2, scales, signal)
my_spline <- function(x, y, ...){
  signal::pchip(x, y, xi = seq(min(x), max(x), length.out = 1000)) %>%
    tibble(time = seq(min(x), max(x), length.out = 1000), expression = .)
}
map_from <- c('a', 'b', 'c', 'd', 'e')
map_to_cluster <- c(1:5)
map_to_top <- sample(c(T,F), size = length(map_from), replace = T)
data <- tibble(
  time = c(1, 5, 15, 30, 60, 180, 360, 720, 1440, 2880),
  a_g1 = runif(10),
  a_g2 = runif(10),
  b_g1 = runif(10),
  b_g2 = runif(10),
  c_g1 = runif(10),
  c_g2 = runif(10),
  d_g1 = runif(10),
  d_g2 = runif(10),
  e_g1 = runif(10),
  e_g2 = runif(10)
) %>%
  gather('tmp', 'expression', -time) %>%
  extract(tmp, c('id', 'type'), '^(.*)_(.*)$') %>%
  mutate(
    cluster = mapvalues(gene_id, map_from, map_to_cluster),
    cluster = as.integer(cluster),
    on_top = mapvalues(gene_id, map_from, map_to_top),
    on_top = as.logical(on_top)
  ) %>%
  group_by(cluster, gene_id, genotype, on_top) %>%
  summarise(
    tmp = list(my_spline(time, expression)),
    .groups = 'drop'
  ) %>%
  unnest(tmp)

#cycle_data <- tibble(
#  start = c(0, 12*60, 24*60, 36*60),
#  end = c(12*60, 24*60, 36*60, 48*60),
#  cycle = c('Day', 'Night', 'Day', 'Night')
#)
ggplot(data, aes(time, expression, group = gene_id, color = on_top))+
  #geom_rect(data = cycle_data, aes(xmin = start, xmax = end, fill = cycle), ymin = -Inf, ymax = Inf, alpha = 1/2)+
  geom_path(size = 1/4)+
  #geom_path(data = dplyr::filter(data, on_top),
  #          aes(time, expression, group = gene_id, color = on_top),
  #          size = 1/4)+
  #facet_grid(cluster~genotype, scales = 'free')+
  scale_x_continuous(trans = squash_axis(0, 60, .1), labels = breaks, breaks = breaks)
  #theme_classic()+
  #scale_color_viridis_d(begin = 1, end = 0)+
  #scale_fill_manual(values = c('white', 'grey'))

（编辑：）R，以及我运行它的包版本：

R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 17134)
scales_1.1.1
ggplot2_3.3.2
signal_0.7-6
pacman_0.5.1
dplyr_1.0.2

标签： rggplot2