计算 R 中 2 个时间戳之间的秒数，不包括周末

Question

如果我有一个包含 2 列 YMD HMS 的数据框，我如何计算两个不包括周末的时间差（以秒为单位）？

col 2 - col 1 = 以秒为单位的时间；需要排除周末秒数

Dates1 <- as.POSIXct("2011-01-30 12:00:00") + rep(0, 10)
Dates2 <- as.POSIXct("2011-02-04") + seq(0, 9, 1)
df <- data.frame(Dates1 = Dates1, Dates2 = Dates2)

我需要它给我 (388800 - 43200) = 345600;我减去 43200 的原因是因为这是从中午到午夜的周日周末时间，时钟停止。

Answer 1

这是一个适用于向量的剪辑：

#' Seconds difference without weekends
#'
#' @param a, b POSIXt
#' @param weekends 'character', day of the week (see
#'   [base::strptime()] for the "%w" argument), "0" is Sunday, "6" is
#'   Saturday; defaults to `c("0","6")`: Saturday and Sunday
#' @param units 'character', legal values for [base::units()], such as
#'   "secs", "mins", "hours"
#' @return 'difftime' object
#' @md
secs_no_weekend <- function(a, b, weekends = c("0", "6"), units = "secs") {
  out <- mapply(function(a0, b0) {
    astart <- as.POSIXct(format(a0, "%Y-%m-%d 00:00:00"))
    aend <- as.POSIXct(format(a0, "%Y-%m-%d 24:00:00"))
    bstart <- as.POSIXct(format(b0, "%Y-%m-%d 00:00:00"))
    days <- seq.POSIXt(astart, bstart, by = "day")
    ndays <- length(days)
    if (ndays == 1) {
      d <- b0 - a0
      units(d) <- "secs"
    } else {
      d <- rep(60 * 60 * 24, ndays) # secs
      d[1] <- `units<-`(aend - a0, "secs")
      d[ndays] <- `units<-`(b0 - bstart, "secs")
      wkend <- format(days, "%w")
      d[ wkend %in% weekends ] <- 0
    }
    sum(pmax(0, d))
  }, a, b)
  out <- structure(out, class = "difftime", units = units)
  out
}

---

测试/验证：

也许这会随着不符合我假设的示例的出现而更新。

从角度来看，这是本月（2019 年 6 月）的日历，采用 ISO-8601（右）和美国/非 ISO（左）：

week <- c("Mon","Tue","Wed","Thu","Fri","Sat","Sun")
# sunfirst <- ... calculated
monfirst <- tibble(dt = seq(as.Date("2019-06-01"), as.Date("2019-06-30"), by="days")) %>%
  mutate(
    dow = factor(format(dt, format = "%a"), levels = week),
    dom = as.integer(format(dt, format = "%e")),
    wom = format(dt, format = "%V") # %U for sunfirst, %V for monfirst
  ) %>%
  select(-dt) %>%
  spread(dow, dom) %>%
  select(-wom)
monfirst <- rbind(monfirst, NA)
cbind(sunfirst,   ` `="     ",        monfirst                   )
#   Sun Mon Tue Wed Thu Fri Sat       Mon Tue Wed Thu Fri Sat Sun
# 1  NA  NA  NA  NA  NA  NA   1        NA  NA  NA  NA  NA   1   2
# 2   2   3   4   5   6   7   8         3   4   5   6   7   8   9
# 3   9  10  11  12  13  14  15        10  11  12  13  14  15  16
# 4  16  17  18  19  20  21  22        17  18  19  20  21  22  23
# 5  23  24  25  26  27  28  29        24  25  26  27  28  29  30
# 6  30  NA  NA  NA  NA  NA  NA        NA  NA  NA  NA  NA  NA  NA

一些数据和预期。 （为了简单/可读性，我在这里使用dplyr，上面的函数不需要它。）

dh <-  43200 # day-half, 60*60*12
d1 <-  86400 # day=1, 60*60*24
d4 <- 345600 # days=4, 4*d1
d5 <- 432000 # days=5
d7 <- 432000 # 7 days minus weekend
d <- tribble(
  ~x                   , ~y                   , ~expect, ~description
, "2019-06-03 12:00:00", "2019-06-03 12:00:05",      5 , "same day"
, "2019-06-03 12:00:00", "2019-06-04 12:00:05",   d1+5 , "next day"
, "2019-06-03 12:00:00", "2019-06-07 12:00:05",   d4+5 , "4d + 5"
, "2019-06-03 12:00:00", "2019-06-08 12:00:05",  d4+dh , "start weekday, end weekend, no 5"
, "2019-06-03 12:00:00", "2019-06-09 12:00:05",  d4+dh , "start weekday, end weekend+, no 5, same"
, "2019-06-03 12:00:00", "2019-06-10 12:00:05",   d7+5 , "start/end weekday, 1 full week"
, "2019-06-02 12:00:00", "2019-06-03 12:00:05",   dh+5 , "start weekend, end weekday, 1/2 day"
, "2019-06-02 12:00:00", "2019-06-08 12:00:05",     d7 , "start/end weekend, no 5"
) %>% mutate_at(vars(x, y), as.POSIXct)
(out <- secs_no_weekend(d$x, d$y))
# Time differences in secs
# [1]      5  86405 345605 388800 388800 432005  43205 432000
all(out == d$expect)
# [1] TRUE

Answer 2

这是使用lubridate 和其他tidyverse 包的解决方案。 lubridate 的好处在于它可以无缝地处理许多奇怪的时间问题，从时区到闰年，再到夏令时的切换。 （如果您关心这些，请确保您的数据具有时区。）

我在这里使用的概念是lubridate 中的intervals（使用%--% 运算符创建）。间隔字面意思就是听起来的样子：一个非常有用的类，它基本上有一个开始日期时间和一个结束日期时间。

我生成了两个数据集：一个用于您的开始和结束时间，另一个用于周末开始和结束时间，每个都有自己的间隔列。在周末数据集中，请注意开始和结束时间被任意设置为一年中的周六和周日。您应该使用对您有意义的值来设置它们，或者从数据中找出一种方法来设置它。 :)

从那里，我们将使用 lubridate 的 intersect 函数找到您的间隔和周末间隔之间的重叠，以便稍后我们可以计算相关的周末秒数并将它们减去。

但首先我们使用tidyr 中的crossing 来确保我们在weekends 数据集中对照每个周末检查您的每个间隔。它只是运行两个数据集的笛卡尔积（参见this SO answer）。

最后，我们使用int_length 计算周末秒数，将每个间隔的周末秒数相加，计算每个间隔的总秒数，然后从 周末 秒中减去em>总秒。瞧！我们有总秒数，不包括周末。

这个解决方案的另一个好处是它非常灵活。我已将周末定义为周六 0:00 至周一 0:00...但您可以删除周五晚上、周一凌晨，无论您喜欢什么并满足您的分析要求。

library(dplyr)
library(tidyr)
library(tibble)
library(lubridate) # makes dates and times easier!

test <- tribble(
            ~start_time,             ~end_time,
  "2019-05-22 12:35:42", "2019-05-23 12:35:42", # same week no weekends
  "2019-05-22 12:35:42", "2019-05-26 12:35:42", # ends during weekend
  "2019-05-22 12:35:42", "2019-05-28 12:35:42", # next week full weekend
  "2019-05-26 12:35:42", "2019-05-29 12:35:42", # starts during weekend
  "2019-05-22 12:35:42", "2019-06-05 12:35:42"  # two weeks two weekends
) %>% 
  mutate(
    id = row_number(),
    timespan = start_time %--% end_time
  )

weekend_beginnings <- ymd_hms("2019-05-18 00:00:00") + weeks(0:51)
weekend_endings <- ymd_hms("2019-05-20 00:00:00") + weeks(0:51)
weekends <- weekend_beginnings %--% weekend_endings

final_answer <- crossing(test, weekends) %>% 
  mutate(
    weekend_intersection = intersect(timespan, weekends),
    weekend_seconds = int_length(weekend_intersection)
  ) %>% 
  group_by(id, start_time, end_time, timespan) %>% 
  summarise(
    weekend_seconds = sum(weekend_seconds, na.rm = TRUE)
  ) %>% 
  mutate(
    total_seconds = int_length(timespan),
    weekday_seconds = total_seconds - weekend_seconds
  )

glimpse(final_answer)