Calculate seconds between 2 timestamps in R excluding weekends

Question

If I have a dataframe with 2 columns which are YMD HMS, how do I calculate the difference in seconds between the two excluding weekends?

col 2 - col 1 = time in seconds; need to exclude the weekend seconds

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)

I need it to give me (388800 - 43200) = 345600; The reason why I am subtracting 43200 is because that is a Sunday weekend time from Noon until Midnight which the clock stops.

Answer 1

Here's a solution using lubridate and other tidyverse packages. The nice thing about lubridate is that it will handle pretty seamlessly a host of oddball issues with time, from time zones to leap years to the switch to and from daylight saving time. (If you care about those, just make sure your data has time zones.)

The concept I'm using here is that of intervals in lubridate (created using the %--% operator). An interval is literally what it sounds like: a very useful class that basically has a start datetime and an end datetime.

I generate two datasets: one for your start and end times, and another for weekend start and end times, each with its own interval column. In the weekend dataset, note that the start and end times are arbitrarily set to a year of Saturdays and Sundays. You should set those with values that make sense for you, or work out a way to set it from the data. :)

From there, we'll find the overlap between your intervals and the weekend intervals using lubridate's intersect function, so later we can count up the relevant weekend seconds and subtract them out.

But first we use crossing from tidyr to make sure we're checking every one of your intervals against every weekend in the weekends dataset. It just runs a Cartesian product of the two datasets (see this SO answer).

Finally we use int_length to count up the weekend seconds, sum up the weekend seconds for each of your intervals, count up the total seconds for each, and subtract the weekend seconds from the total seconds. And voila! We have total seconds, excluding weekends.

The other nice thing about this solution is that it's extremely flexible. I've defined weekends as 0:00 Saturday to 0:00 Monday... but you could remove Friday evenings, Monday wee hours, whatever strikes your fancy and meets your analytical requirements.

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)

Answer 2

Here's a cut that works on vectors:

#' 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
}

---

Testing/validation:

Perhaps this will be updated as examples come in that do not match my assumptions.

For perspective, here is this month's (June 2019) calendar, in ISO-8601 (right) and US/not-ISO (left):

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

Some data and expectations. (I use dplyr here for simplicity/readability, the function above does not require it.)

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