分组日期和时间

Question

是否有 R 包提供所有典型时间单位（秒、分钟等）的日期和时间分组？

或者换句话说：我如何截断特定时间单位的倍数？

背景

我经常需要将对 HTTP 请求的响应分组为 15 秒的时间间隔。

函数 lubridate::floor_date() 和 lubridate::ceiling_date() 让我开始了，但是

我想出了一些基于模 (%%) 的东西，但感觉我正在重新发明有关原子时间组件操作的轮子。

函数定义

library(magrittr)

group_date <- function(
  x,
  interval = 15,
  unit = c(
    "seconds",
    "minutes",
    "hours",
    "days",
    "weeks",
    "months",
    "bimonths",
    "quarters",
    "seasons",
    "halfyears",
    "years"
  )
) {
  # Validate units:
  unit <- match.arg(unit)

  # Possibly base units on "basic units" as {lubridate} does:
  # parsed_unit <- lubridate:::parse_period_unit(unit)
  # n <- parsed_unit$n
  # basic_unit <- lubridate:::standardise_period_names(parsed_unit$unit)

  if (unit %in% c("bimonths", "halfyears", "season")) {
    stop(stringr::str_glue("Unit '{unit}' not supported yet"))
  }
  # No clue how these would need to be handled yet

  # Extract unit value:
  unit_value <- dplyr::case_when(
    unit == "seconds" ~ as.numeric(lubridate::second(x)),
    unit == "minutes" ~ as.numeric(lubridate::minute(x)),
    unit == "hours" ~ as.numeric(lubridate::hour(x)),
    unit == "days" ~ as.numeric(lubridate::day(x)),
    unit == "weeks" ~ as.numeric(lubridate::isoweek(x)),
    unit == "months" ~ as.numeric(lubridate::month(x)),
    unit == "quarters" ~ as.numeric(lubridate::quarter(x)),
    unit == "year" ~ as.numeric(lubridate::year(x))
  )

  offset_factor <- dplyr::case_when(
    unit == "seconds" ~ 1,
    unit == "minutes" ~ 60,
    unit == "hours" ~ 60 * 60,
    unit == "days" ~ 60 * 60 * 24,
    unit == "weeks" ~ NA_real_, # Seconds per week -> no clue how to do that,
    unit == "months" ~ NA_real_, # Seconds per month -> no clue how to do that
    unit == "quarters" ~ NA_real_, # Seconds per quarter -> no clue how to do that
    unit == "year" ~ NA_real_ # Seconds per year -> no clue how to do that
  )

  # Calculate time offset to lower group boundary:
  time_offset <- unit_value %% interval

  # Apply offset:
  x - (time_offset * offset_factor)
}

分组秒数

x <- c(
  "2020-01-31 13:01:14",
  "2020-01-31 13:01:15",
  "2020-01-31 13:01:16",
  "2020-01-31 13:01:29",
  "2020-01-31 13:01:30",
  "2020-01-31 13:01:31",
  "2020-01-31 13:01:44",
  "2020-01-31 13:01:45",
  "2020-01-31 13:01:46",
  "2020-01-31 13:01:59",
  "2020-01-31 13:02:00",
  "2020-01-31 13:02:01"
) %>%
  lubridate::ymd_hms()

x %>% group_date()
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:15 UTC"
#>  [3] "2020-01-31 13:01:15 UTC" "2020-01-31 13:01:15 UTC"
#>  [5] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [7] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:45 UTC"
#>  [9] "2020-01-31 13:01:45 UTC" "2020-01-31 13:01:45 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

x %>% group_date(30)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [3] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [5] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [7] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [9] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

x %>% group_date(45)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [3] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [5] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [7] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:45 UTC"
#>  [9] "2020-01-31 13:01:45 UTC" "2020-01-31 13:01:45 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

x %>% group_date(60)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [3] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [5] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [7] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [9] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

分组分钟数

x <- c(
  "2020-01-31 13:04:00",
  "2020-01-31 13:05:00",
  "2020-01-31 13:06:00",
  "2020-01-31 13:29:00",
  "2020-01-31 13:30:00",
  "2020-01-31 13:31:00",
  "2020-01-31 13:44:00",
  "2020-01-31 13:45:00",
  "2020-01-31 13:46:00"
) %>%
  lubridate::ymd_hms()

x %>% group_date(15, "minutes")
#> [1] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [3] "2020-01-31 13:00:00 UTC" "2020-01-31 13:15:00 UTC"
#> [5] "2020-01-31 13:30:00 UTC" "2020-01-31 13:30:00 UTC"
#> [7] "2020-01-31 13:30:00 UTC" "2020-01-31 13:45:00 UTC"
#> [9] "2020-01-31 13:45:00 UTC"

x %>% group_date(30, "minutes")
#> [1] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [3] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [5] "2020-01-31 13:30:00 UTC" "2020-01-31 13:30:00 UTC"
#> [7] "2020-01-31 13:30:00 UTC" "2020-01-31 13:30:00 UTC"
#> [9] "2020-01-31 13:30:00 UTC"

x %>% group_date(45, "minutes")
#> [1] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [3] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [5] "2020-01-31 13:00:00 UTC" "2020-01-31 13:00:00 UTC"
#> [7] "2020-01-31 13:00:00 UTC" "2020-01-31 13:45:00 UTC"
#> [9] "2020-01-31 13:45:00 UTC"

编辑

刚刚遇到hms::trunc_hms().

似乎给了我 secs = 15 和 secs = 30 所需的东西，所以它会解决我眼前的问题。但我看不出它对于秒以外的时间单位如何工作：

library(magrittr)

x <- c(
  "2020-01-31 13:01:14",
  "2020-01-31 13:01:15",
  "2020-01-31 13:01:16",
  "2020-01-31 13:01:29",
  "2020-01-31 13:01:30",
  "2020-01-31 13:01:31",
  "2020-01-31 13:01:44",
  "2020-01-31 13:01:45",
  "2020-01-31 13:01:46",
  "2020-01-31 13:01:59",
  "2020-01-31 13:02:00",
  "2020-01-31 13:02:01"
) %>%
  lubridate::ymd_hms()

x %>% hms::trunc_hms(15)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:15 UTC"
#>  [3] "2020-01-31 13:01:15 UTC" "2020-01-31 13:01:15 UTC"
#>  [5] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [7] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:45 UTC"
#>  [9] "2020-01-31 13:01:45 UTC" "2020-01-31 13:01:45 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

x %>% hms::trunc_hms(30)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [3] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [5] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [7] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [9] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

x %>% hms::trunc_hms(45)
#>  [1] "2020-01-31 13:00:45 UTC" "2020-01-31 13:00:45 UTC"
#>  [3] "2020-01-31 13:00:45 UTC" "2020-01-31 13:00:45 UTC"
#>  [5] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [7] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#>  [9] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"
#> [11] "2020-01-31 13:01:30 UTC" "2020-01-31 13:01:30 UTC"

x %>% hms::trunc_hms(60)
#>  [1] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [3] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [5] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [7] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#>  [9] "2020-01-31 13:01:00 UTC" "2020-01-31 13:01:00 UTC"
#> [11] "2020-01-31 13:02:00 UTC" "2020-01-31 13:02:00 UTC"

编辑 2

正在研究使用 cut()

的建议

x %>%
  tibble::enframe() %>%
  dplyr::mutate(
    grp = value %>% group_date(15)
  ) %>% 
  dplyr::group_by(
    grp_2 = cut(as.POSIXct(value, '%Y-%m-%d %H:%M:%S'), '15 secs')
  )
# # A tibble: 12 x 4
# # Groups:   grp [4]
# name value                   grp_2                   grp                
# <int> <dttm>                  <dttm>                  <fct>              
#   1     1 2020-01-31 13:01:14.000 2020-01-31 13:01:00.000 2020-01-31 13:01:14
# 2     2 2020-01-31 13:01:15.000 2020-01-31 13:01:15.000 2020-01-31 13:01:14
# 3     3 2020-01-31 13:01:16.000 2020-01-31 13:01:15.000 2020-01-31 13:01:14
# 4     4 2020-01-31 13:01:29.000 2020-01-31 13:01:15.000 2020-01-31 13:01:29
# 5     5 2020-01-31 13:01:30.000 2020-01-31 13:01:30.000 2020-01-31 13:01:29
# 6     6 2020-01-31 13:01:31.000 2020-01-31 13:01:30.000 2020-01-31 13:01:29
# 7     7 2020-01-31 13:01:44.000 2020-01-31 13:01:30.000 2020-01-31 13:01:44
# 8     8 2020-01-31 13:01:45.000 2020-01-31 13:01:45.000 2020-01-31 13:01:44
# 9     9 2020-01-31 13:01:46.000 2020-01-31 13:01:45.000 2020-01-31 13:01:44
# 10    10 2020-01-31 13:01:59.000 2020-01-31 13:01:45.000 2020-01-31 13:01:59
# 11    11 2020-01-31 13:02:00.000 2020-01-31 13:02:00.000 2020-01-31 13:01:59
# 12    12 2020-01-31 13:02:01.000 2020-01-31 13:02:00.000 2020-01-31 13:01:59

由 reprex package (v0.3.0)

于 2020-01-31 创建

Answer 1

这个简单的函数如何四舍五入到任何给定的秒数、分钟数、小时数、天数或周数？如果你想在特定日期和时间开始你的块，有一个可选的默认起始时间。 "units" 的参数是匹配的，所以你可以缩写。默认为秒

time_group <- function(times, intervals, since = as.POSIXct("2000-01-01"), 
                       units = c("secs", "mins", "hours", "days", "weeks"))
{
  all_units <- c("secs", "mins", "hours", "days", "weeks")
  units     <- match.arg(units, all_units)
  intervals <- intervals * c(1, 60, 3600, 86400, 604800)[match(units, all_units)]
  cuts      <- intervals * floor(as.numeric(difftime(times, since, units = "secs"))/intervals)

  return(as.POSIXct(cuts, origin = since))
}

这允许您这样做：

# Units default to seconds so this groups by 15 seconds at a time
time_group(x, 15)
#>  [1] "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:15 GMT" "2020-01-31 13:01:15 GMT"
#>  [4] "2020-01-31 13:01:15 GMT" "2020-01-31 13:01:30 GMT" "2020-01-31 13:01:30 GMT"
#>  [7] "2020-01-31 13:01:30 GMT" "2020-01-31 13:01:45 GMT" "2020-01-31 13:01:45 GMT"
#> [10] "2020-01-31 13:01:45 GMT" "2020-01-31 13:02:00 GMT" "2020-01-31 13:02:00 GMT"

# We have used argument matching so we can abbreviate minutes to "m"
time_group(x, 1, units = "m")
#>  [1] "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT"
#>  [4] "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT"
#>  [7] "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT" "2020-01-31 13:01:00 GMT"
#> [10] "2020-01-31 13:01:00 GMT" "2020-01-31 13:02:00 GMT" "2020-01-31 13:02:00 GMT"

分组日期和时间

Grouping dates and times

grouping

datetime

r

iso8601

lubridate

背景

函数定义

分组秒数

分组分钟数

编辑

编辑 2