删除/平滑 ggplot2 热图中的 x 轴间隙
Removing/ smoothing x axis gaps in ggplot2 heat map
我正在从使用格子“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 代码平滑度为零,大量的白色 space(即使在最小的间隙之间)也很难可视化随时间的变化
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 的方法重现上述水平图平滑?
这是一个与这个类似的问题,似乎没有令人满意的答案:
执行此操作的一种方法是计算要绘制为矩形的图块并使用 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))
我正在从使用格子“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 代码平滑度为零,大量的白色 space(即使在最小的间隙之间)也很难可视化随时间的变化
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 的方法重现上述水平图平滑?
这是一个与这个类似的问题,似乎没有令人满意的答案:
执行此操作的一种方法是计算要绘制为矩形的图块并使用 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))