如何防止 gridExtra::grid.arrage 在 R 中自动缩放 x 轴?

时间:2021-03-31 01:24:42

标签: r ggplot2 dplyr lubridate gridextra

我在循环中运行以下每个图都没有问题,但出于某种原因,当我尝试将它们组合到 grid.arrange 中时,轴会自动缩放。我不知道如何自动缩放。我真的只是想将 ggplots 组合在一起(就像我使用 par(mfrow = c(2,3)) 和 base R 一样)。

我认为 X 轴实际上是重新格式化的日期时间 (as.posixct) 的事实正在抛弃它。理想情况下,我希望 X 轴仅显示小时。

library(ggplot2)
library(bp)

df <- data(hypnos_data)

ids <- unique(df$ID)
id_tab <- cbind(ids, c(1:5))

index <- c(8:23, 0:7)

plot_list <- list()
for(i in ids){
  
  subs <- df[which(df$ID == i & df$VISIT == 1),]
  subs$DATE.TIME <- as.POSIXct(subs$DATE.TIME)
  subs$hour_rec <- lubridate::hour(subs$DATE.TIME)
  
  subs$hour_rec <- factor(subs$hour_rec, levels = as.character(index), ordered = T)
  
  row.names(subs) <- NULL
  
  tmp <- subs %>% dplyr::filter(WAKE == 0)
  min(tmp$hour_rec)
  
  p <- ggplot2::ggplot(subs, ggplot2::aes(x = DATE.TIME, y = SYST)) +
    
    geom_rect(aes(xmin = min(tmp$DATE.TIME), xmax = max(tmp$DATE.TIME), ymin = -Inf, ymax = Inf),
              fill = "navajowhite2", alpha = 0.03) + 
    
    ggplot2::geom_point(aes(y = SYST), col = 'blue') + 
    ggplot2::geom_smooth(aes(y = SYST), method = "loess", col = 'blue') + 
    ggplot2::geom_point(aes(y = DIAST), col = 'red') + 
    ggplot2::geom_smooth(aes(y = DIAST), method = "loess", col = 'red') + 

    scale_x_datetime(date_label = "%H:%M", date_breaks = "1 hour") +
    theme(axis.text.x = element_text(angle=45)) +
    
    ggtitle( paste("BP Profile for Subject: ", i, sep = "") )
  
  plot_list[[match(i, id_tab)]] <- p
  print(p)
  
  #grid::grid.newpage()
}

上面的代码应该产生 5 个与此类似的图(正确):

个人绘图输出

enter image description here

gridExtra::grid.arrange(grobs = plot_list, ncol = 2 )

然而,尝试使用 grid.arrange 组合它们会产生以下结果:

grid.arrange 绘图输出

enter image description here

1 个答案:

答案 0 :(得分:0)

问题不在 grid.arrange 中,而是由 ggplot2 中的引用变量引起的。一些轴数据是参考值,而不是图中存储的值。这会导致每次 subs 交互的 tmpfor-loop 发生变化时轴发生变化。这是一种使用 eval(substitute(...))

绕过它的方法
library(ggplot2)
library(bp)
library(doParallel)
#> Loading required package: foreach
#> Loading required package: iterators
#> Loading required package: parallel

data(hypnos_data)
df <- hypnos_data
ids <- unique(df$ID)
id_tab <- cbind(ids, c(1:5))

index <- c(8:23, 0:7)

plot_list <- list()
plot_list <- foreach(i = ids) %do% {
  eval(substitute({
    subs <- df[which(df$ID == i & df$VISIT == 1),]
    subs$DATE.TIME <- as.POSIXct(subs$DATE.TIME)
    subs$hour_rec <- lubridate::hour(subs$DATE.TIME)
    
    subs$hour_rec <- factor(subs$hour_rec, levels = as.character(index), ordered = T)
    
    row.names(subs) <- NULL
    
    tmp <- subs %>% dplyr::filter(WAKE == 0)
    min(tmp$hour_rec)
    
    p <- ggplot2::ggplot(subs, ggplot2::aes(x = DATE.TIME, y = SYST)) +
      
      geom_rect(aes(xmin = min(tmp$DATE.TIME), xmax = max(tmp$DATE.TIME), ymin = -Inf, ymax = Inf),
        fill = "navajowhite2", alpha = 0.03) + 
      ggplot2::geom_point(aes(y = SYST), col = 'blue') + 
      ggplot2::geom_smooth(aes(y = SYST), method = "loess", col = 'blue') + 
      ggplot2::geom_point(aes(y = DIAST), col = 'red') + 
      ggplot2::geom_smooth(aes(y = DIAST), method = "loess", col = 'red') + 
      
      scale_x_datetime(date_label = "%H:%M", date_breaks = "1 hour") +
      theme(axis.text.x = element_text(angle=45)) +
      
      ggtitle( paste("BP Profile for Subject: ", i, sep = "") )
  }, list(subs = as.name(paste0("subs_", i)), tmp = as.name(paste0("tmp_", i)))))
  
  p
}

gridExtra::grid.arrange(grobs = plot_list)
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'
#> `geom_smooth()` using formula 'y ~ x'

Output plot

reprex package (v1.0.0) 于 2021 年 3 月 31 日创建

相关问题