计算R中2个时间戳之间的秒数，不包括周末
计算R中2个时间戳之间的秒数，不包括周末
提问于 2019-05-23 02:25:41
如果我有一个包含两列的dataframe，这两列都是YMD HMS，我如何计算这两列之间的差值(不包括周末)？
COL2-COL1=以秒为单位的时间；需要排除周末秒
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的原因是因为这是一个周日周末的时间，从中午到午夜，时钟停止。
回答 2
Stack Overflow用户
回答已采纳
发布于 2019-05-23 03:08:56
这是一个对向量起作用的切分：
#' 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 (右)和US/not-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] TRUEStack Overflow用户
发布于 2019-05-23 03:30:53
这里有一个使用lubridate和其他tidyverse包的解决方案。lubridate的好处在于，它将非常无缝地处理一系列与时间相关的奇怪问题，从时区到闰年，再到夏令时的转换。(如果您关心这些，只需确保您的数据具有时区。)
我在这里使用的概念是lubridate中的intervals (使用%--%操作符创建)。从字面上看，interval就像它听起来那样:一个非常有用的类，基本上有一个开始日期时间和一个结束日期时间。
我生成了两个数据集:一个用于开始和结束时间，另一个用于周末开始和结束时间，每个数据集都有自己的interval列。在周末数据集中，请注意开始时间和结束时间被任意设置为星期六和星期日的年份。您应该使用对您有意义的值来设置它们，或者从数据中找出一种方法来设置它们。:)
从那里，我们将使用lubridate的intersect函数找到您的间隔和周末间隔之间的重叠，因此稍后我们可以将相关的周末秒数加起来并减去它们。
但首先，我们使用来自tidyr的crossing，以确保我们在weekends数据集中每个周末检查您的每个间隔。它只运行两个数据集的笛卡尔乘积(参见this SO answer)。
最后，我们使用int_length来计算周末秒数，对每个间隔的周末秒数求和，对每个间隔的总秒数进行计数，然后从总秒数中减去周末秒数。瞧！我们总共有几秒钟，不包括周末。
这个解决方案的另一个好处是它非常灵活。我把周末定义为周六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)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/56262872
复制相关文章
相似问题