Heatmap（ggplot）：时间与日期的关系

Question

我有一些示例数据（实际上是犯罪数据）：

randomDatetime <- function(N, st="2018/01/01", et="2018/12/31") {
st <- as.POSIXct(as.Date(st))
et <- as.POSIXct(as.Date(et))
dt <- as.numeric(difftime(et,st,unit="sec"))
ev <- sort(runif(N, 0, dt))
rt <- st + ev
return(rt)
}

df <- data.frame(date=randomDatetime(1000))

现在，我想像这样创建一个KDE-plot / heatmap：

在x轴上应该有日期（2018-01-01至2018-12-31），在y轴上应该有时间（00：00-23：59）。目的是显示某些类型的犯罪在一天中的什么时候最频繁发生，以及各个事件之间是否存在差异等。

现在，我在y轴上遇到问题，因为我不知道如何仅节省时间。例如，我可以计算自午夜以来的分钟数，但这对我来说似乎并不十分优雅。

我想应该是这样：

ggplot(aes(x = date, y = ??) data = df) + 
geom_density_2d()+
scale_x_date(date_breaks = "months", date_labels = "%m", limits=as.Date(c("2018-01-01","2018-12-31"))) 

Answer 1

可能有一种更简洁的方法，但这可行：

library(tidyverse)
library(lubridate)

randomDatetime <- function(N, st="2018/01/01", et="2018/12/31") {
  st <- as.POSIXct(as.Date(st))
  et <- as.POSIXct(as.Date(et))
  dt <- as.numeric(difftime(et,st,unit="sec"))
  ev <- sort(runif(N, 0, dt))
  rt <- st + ev
  return(rt)
}

df <- data.frame(date=randomDatetime(1000)) %>% 
  mutate(dt = as.Date(str_sub(date, end=10)),
         time = str_sub(date, start=12),
         tm = as.numeric(hms(str_sub(date, start=12))))


ggplot(df, aes(x = dt, y=tm)) +
  stat_density_2d(aes(fill = stat(level)), geom = "polygon") +
  labs(x="Date", y="Time", fill=NULL) +
  scale_y_continuous(labels = function(x) format(as.POSIXct((x), origin = Sys.Date(), tz = "UTC"), "%H:%M:%S")) +
  theme(legend.position = "none")

Answer 2

一种方法是使用lubridate ...

library(lubridate)
ggplot(aes(x = date, y = hour(date) + minute(date) / 60), data = df) + 
     geom_density_2d()