绘制跨越午夜的到达和离开时间

Posted 2023-02-16

【中文标题】绘制跨越午夜的到达和离开时间

【英文标题】：plot arrival and departure times that cross midnight

【发布时间】：2021-10-05 05:57:22

【问题描述】：

我正在尝试绘制动物进出给定地点的图。动物在下午/晚上到达并在第二天早上离开。有时动物会在午夜之后到达，因此到达和离开发生在同一日期。

如何缩放 x 轴以使时间以午夜为中心？在下面reprex的两个示例中，问题是x轴从早到晚按比例缩放，从而显示动物在当晚到达时间之前从前一天离开的时间，而我想要的是显示每天的到达时间时间和第二天什么时候出发。如何缩放 x 轴，以便每个段从到达时间开始并在第二天早上的出发时间结束？

感谢您的任何想法！

library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
library(hms)
#> 
#> Attaching package: 'hms'
#> The following object is masked from 'package:lubridate':
#> 
#>     hms
library(tidyverse)
library(ggplot2)
library(reprex)

df <- data.frame(
  date = as.Date(c("2021-04-19", "2021-04-20", "2021-04-21", "2021-04-22", "2021-04-23", "2021-04-24", "2021-04-26")),
  arrival_time = ymd_hms(c("2021-04-19 19:03:00", "2021-04-20 19:50:00", "2021-04-21 20:04:00", "2021-04-22 20:52:00", "2021-04-23 21:06:00",
                           "2021-04-24 21:22:00", "2021-04-26 01:47:00")),
  departure_time = ymd_hms(c("2021-04-20 06:00:00", "2021-04-21 05:47:00", "2021-04-22 06:23:00", "2021-04-23 05:56:00",
                            "2021-04-24 04:59:00", "2021-04-25 06:32:00", "2021-04-27 06:40:00"))
)

# attempt 1 - plot separate date variable on y axis
ggplot(df) +
  geom_segment(aes(x = as_hms(arrival_time), xend = as_hms(departure_time), y = date, yend = date)) +
  scale_y_date(date_breaks = "1 day", date_labels = "%d %b") +
  labs(x = "Time at Site",
       y = "Date")

# attempt 2 - plot actual date of POSIXct variable on y axis 
ggplot(df) +
  geom_segment(aes(x = as_hms(arrival_time), xend = as_hms(departure_time), y = date(arrival_time), yend = date(departure_time))) +
  scale_y_date(date_breaks = "1 day", date_labels = "%d %b") +
  labs(x = "Time at Site",
       y = "Date")

^{由reprex package (v1.0.0) 于 2021 年 7 月 29 日创建}

【参考方案1】：

这是我的解决方案，我首先计算差异和持续时间，如果持续时间超过 1 天（如您的最后一行），这也是正确的。

df %>%
    mutate(
        # Extract hms to plot all on the same day, convert back to datetime otherwise we need to use scale_x_time, without date_breaks and date_labels option
        arrival = hms::as_hms(arrival_time) %>% lubridate::as_datetime(),
        # calculate difference between cols and with the result the duration
        diff = lubridate::interval(arrival_time, departure_time),
        dur = lubridate::as.duration(diff) # this is the duration they are on site
        # workaround if arrival is after midnight
        arrival = if_else(day(arrival_time) > day(date), arrival + days(1), arrival),
    ) %>%
    # show our intermediate result
    glimpse() %>%
    ggplot(aes(x = arrival, y = date, group = date)) +
    # using point range as I think it looks nicer
    # important xmax is now arrival plus the duration
    geom_pointrange(aes(xmin = arrival, xmax = arrival + dur)) +
    # also add a text label why not
    geom_text(aes(label = dur, x = arrival + hours(2)), nudge_y = 0.3) +
    scale_y_date(date_breaks = "1 day", date_labels = "%d %b") +
    scale_x_datetime(
        date_breaks = "1 hour",
        date_labels = "%H"
    ) +
    labs(
        x = "Time at Site",
        y = "Date"
    )

PS：您不需要加载 hms 和 ggplot2，它们都带有自动加载的 tidyverse。

【参考方案2】：

您可以尝试从时间中减去 12 小时，然后在标签上添加 12 小时。

先写一个标注函数：

# The hms format stores time as seconds internally.
# There are 86400 seconds in 24 hours and 43200 seconds in 12 hours, so our
# labelling function adds 43200 seconds to increase the time values by 12
# hours, then gives the result modulo 86400 to deal with values above 24 hours.
# The result is an integer number of seconds, so we need to convert this with as_hms.
# Finally we take the first 5 characters of the result with substr to give %H:%M
# formatted character strings as the labels

labelling_fn <- function(x) 
  (as.numeric(x + 43200) %% 86400) %>%
     as_hms()                      %>%
     substr(1, 5)

现在将标签函数传递给scale_x_time的labels参数

df %>%
ggplot(aes(y = date(arrival_time), xmin = as_hms(arrival_time - hours(12)),
           xmax = as_hms(departure_time - hours(12)))) +
  geom_linerange() +
  scale_x_time(labels = labelling_fn) +
  scale_y_date(date_breaks = "1 day", date_labels = "%d %b") +
  labs(x = "Time at Site",
       y = "Date")

【讨论】：

非常感谢艾伦 - 这是一个比我尝试过的任何其他方法都更清洁的解决方案！您将如何格式化 x 轴标签以仅显示 %H:%M？当我尝试指定中断或向标签参数添加格式调用时，它会覆盖您编写的标签函数并使 x 轴空白且没有标签。

@m.hand 当然 - 您可以随意格式化标签。我在更新中将标记功能与 ggplot 调用分开，以使其更清晰。

啊哈！谢谢。