去除/平滑 ggplot2 热图中的 x 轴间隙

Question

我正在从使用使用格子“levelplot”创建的热图转换为使用 ggplot2 创建的热图，但我遇到了两个包如何处理不均匀 x 轴变量的问题。

这是我的时间序列不均匀的数据：

MyTimes<-as.POSIXct(c(rep("2020-10-01 10:15:00",3),rep("2020-10-01 11:25:00",3), rep("2020-10-01 11:45:00",3), rep("2020-10-01 12:23:00",3), rep("2020-10-01 14:15:00",3),
                    rep("2020-10-01 15:15:00",3), rep("2020-10-01 16:32:00",3), rep("2020-10-01 16:20:00",3), rep("2020-10-01 18:15:00",3), rep("2020-10-01 19:15:00",3),                      
                    rep("2020-10-02 10:15:00",3), rep("2020-10-02 11:15:00",3), rep("2020-10-02 12:15:00",3), rep("2020-10-02 13:33:00",3), rep("2020-10-02 20:15:00",3),                    
                   rep("2020-10-03 10:15:00",3), rep("2020-10-03 15:15:00",3), rep("2020-10-03 19:15:00",3), rep("2020-10-05 10:15:00",3), rep("2020-10-05 12:15:00",3)))


MyY<-rep(seq(1,3),20)
MyValue<-runif(60, min = 0, max = 25) 
MyData<-data.frame(MyTimes, MyY, MyValue)

由此产生的情节：

library(lattice)
levelplot(MyValue  ~ MyTimes * MyY,
          data = MyData,
          ylim=c(3,0),
          aspect=0.4)

使用上面的 levelplot 代码，绘图“过于平滑”，因为它在较大的时间间隔内平滑。我可以通过插入破坏时间序列图的 NA 值块来解决这个问题，这样只有较小的间隙才能被平滑。我意识到我对什么构成“大时间间隔”有一些判断，但我可以像这样手动决定：

GapTimes<-as.POSIXct(c(rep("2020-10-01 19:16:00",3),rep("2020-10-02 20:16:00",3),rep("2020-10-03 19:16:00",3)))
MyGapY<-rep(seq(1,3),3)
MyGapValues<-rep(NA,9)
Gap<-data.frame(GapTimes,MyGapY,MyGapValues)
colnames(Gap)<-colnames(MyData)


MyData2<-rbind(MyData,Gap)

所以现在当我绘制我的热图时，我已经平滑了小间隙，而较大的则没有，

levelplot(MyValue  ~ MyTimes * MyY,
          data = MyData2,
          ylim=c(3,0),
          aspect=0.4)

我想做的是切换到 Ggplot2 热图，但是下面的 Ggplot2 代码平滑为零，并且大量的空白（即使在最小的间隙之间）使得很难可视化随时间的变化

library(ggplot2)
ggplot(data = MyData2,aes(x=MyTimes, y=MyY)) +
  geom_raster(aes(fill = MyValue), interpolate=TRUE)+
  scale_y_reverse(lim=c(3,0))+
  scale_fill_gradientn(limits=c(0,25), colors=c("blue","red"),oob = scales::squish)+
  theme_bw()+
  theme(panel.border = element_blank(), panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

是否可以使用类似的基于 Ggplot2 的方法重现上述水平图平滑？

这是一个与此类似的问题，似乎没有令人满意的答案： How can I remove space/gaps between continuous x-values in geom_raster

Answer 1

一种方法是计算要绘制为矩形的图块并使用geom_rect 绘制它们。您甚至可以设置一个阈值，以允许您在连续测量之间定义不同但一致的最大间隙：

library(ggplot2)
library(dplyr)

# Set maximum number of hours that will be "filled in" between measurements
max_smooth <- 12

MyData %>%
  group_by(MyY) %>%
  arrange(MyTimes, by_group = TRUE) %>%
  mutate(right = as.numeric(difftime(lead(MyTimes), MyTimes, units = "hour")),
         right = as.POSIXct(ifelse(right > max_smooth, 
                                   MyTimes + lubridate::hours(max_smooth),
                                   lead(MyTimes)),
                           origin = "1970-01-01"),
         top = MyY, bottom = MyY - 1) %>%
  ggplot(aes(MyTimes, MyY)) +
  geom_rect(aes(xmin = MyTimes, xmax = right, ymin = bottom, ymax = top,
                fill = MyValue)) +
  scale_y_reverse(lim = c(3, 0)) +
  scale_fill_gradientn(limits = c(0, 25), 
                       colors = c("blue", "red"), oob = scales::squish) +
  theme_bw()+
  theme(panel.border = element_blank(), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), 
        axis.line = element_line(colour = "black"))
#> Warning: Removed 3 rows containing missing values (geom_rect).

---

数据

set.seed(1)

MyData <- data.frame(MyTimes = as.POSIXct(rep(paste0("2020-10-", 
                                 c("01 10:15:00", "01 11:25:00", "01 11:45:00",
                                   "01 12:23:00", "01 14:15:00", "01 15:15:00", 
                                   "01 16:32:00", "01 16:20:00", "01 18:15:00", 
                                   "01 19:15:00", "02 10:15:00", "02 11:15:00", 
                                   "02 12:15:00", "02 13:33:00", "02 20:15:00",
                                   "03 10:15:00", "03 15:15:00", "03 19:15:00",
                                   "05 10:15:00", "05 12:15:00")), each = 3)),
                      MyY = rep(1:3, 20),
                      MyValue = runif(60, 0, 25))