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

Question

我正在尝试绘制动物到达和离开给定地点的过程。动物到达 afternoon/evening 并于第二天早上离开。有时动物会在午夜后到达，因此到达和离开都发生在同一天。

如何缩放 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-07-29 创建

Answer 1

您可以尝试从时间中减去 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")

Answer 2

这是我的解决方案，我首先计算了差异和持续时间，如果持续时间超过 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 自动加载。

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

plot arrival and departure times that cross midnight

r

time-series

ggplot2

lubridate