-
Notifications
You must be signed in to change notification settings - Fork 2
/
date-time.R
90 lines (78 loc) · 2.38 KB
/
date-time.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
#' Floor Date/Time
#'
#' Coerces vectors to floored POSIXct vectors.
#'
#' @inheritParams params
#' @param x A vector.
#' @return A floored POSIXct vector.
#'
#' @family floor
#' @export
#'
#' @examples
#' dtt_date_time(1L)
#' dtt_date_time(-1)
#' dtt_date_time(1, tz = "Etc/GMT+8")
#' dtt_date_time(as.Date("2000-01-02"))
#' dtt_date_time(as.Date("2000-01-02"), time = hms::as_hms("04:05:06"))
dtt_date_time <- function(x, ...) {
UseMethod("dtt_date_time")
}
#' @describeIn dtt_date_time Coerce integer vector to a floored POSIXct vector
#' @export
dtt_date_time.integer <- function(x, tz = dtt_default_tz(), ...) {
chk_unused(...)
chk_string(tz)
as.POSIXct(x, tz = tz, origin = as.POSIXct("1970-01-01", tz = "GMT"))
}
#' @describeIn dtt_date_time Coerce double vector to a floored POSIXct vector
#' @export
dtt_date_time.double <- function(x, tz = dtt_default_tz(), ...) {
chk_unused(...)
dtt_date_time(as.integer(floor(x)), tz = tz)
}
#' @describeIn dtt_date_time Coerce character vector to a floored POSIXct vector
#' @export
dtt_date_time.character <- function(x, tz = dtt_default_tz(), ...) {
chk_unused(...)
chk_string(tz)
dtt_floor(as.POSIXct(x, tz = tz))
}
#' @describeIn dtt_date_time Coerce Date vector to a floored POSIXct vector
#' @export
dtt_date_time.Date <- function(x, time = hms::as_hms("00:00:00"),
tz = dtt_default_tz(), ...) {
chk_unused(...)
chk_string(tz)
chk_s3_class(time, "hms")
chk_not_any_na(time)
chk_subset(length(time), c(1L, length(x)))
if (!length(x)) {
return(dtt_date_time(integer(0), tz = tz))
}
x <- dtt_date(x)
time <- dtt_time(time)
dtt_set_tz(dtt_adjust_tz(as.POSIXct(x), "UTC"), tz) + time
}
#' @describeIn dtt_date_time Coerce POSIXct vector to a floored POSIXct vector
#' @export
dtt_date_time.POSIXct <- function(x, tz = dtt_tz(x), ...) {
chk_unused(...)
x <- dtt_adjust_tz(x, tz = tz)
dtt_floor(x)
}
#' @describeIn dtt_date_time Coerce hms vector to a floored POSIXct vector
#' @export
dtt_date_time.hms <- function(x, date = dtt_date("1970-01-01"),
tz = dtt_default_tz(), ...) {
chk_s3_class(date, "Date")
chk_subset(length(date), c(1L, length(x)))
chk_string(tz)
chk_unused(...)
if (!length(x)) {
return(dtt_date_time(integer(0), tz = tz))
}
date <- dtt_date(date)
x <- dtt_time(x)
dtt_set_tz(dtt_adjust_tz(as.POSIXct(date), "UTC"), tz) + x
}