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.
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
}
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