1#' Get date-time in a different time zone
2#'
3#' with_tz returns a date-time as it would appear in a different time zone.
4#' The actual moment of time measured does not change, just the time zone it is
5#' measured in. with_tz defaults to the Universal Coordinated time zone (UTC)
6#' when an unrecognized time zone is inputted. See [Sys.timezone()]
7#' for more information on how R recognizes time zones.
8#'
9#' @param time a POSIXct, POSIXlt, Date, chron date-time object or a data.frame
10#'   object. When a data.frame all POSIXt elements of a data.frame are processed
11#'   with `with_tz()` and new data.frame is returned.
12#' @param tzone a character string containing the time zone to convert to. R
13#'   must recognize the name contained in the string as a time zone on your
14#'   system.
15#' @return a POSIXct object in the updated time zone
16#' @keywords chron manip
17#' @seealso [force_tz()]
18#' @examples
19#' x <- ymd_hms("2009-08-07 00:00:01", tz = "America/New_York")
20#' with_tz(x, "GMT")
21#' @export
22with_tz <- function(time, tzone = "") {
23  if (!C_valid_tz(tzone))
24    warning(sprintf("Unrecognized time zone '%s'", tzone))
25  if (is.data.frame(time)) {
26    for (nm in names(time)) {
27      if (is.POSIXt(time[[nm]])) {
28        time[[nm]] <- .with_tz(time[[nm]], tzone = tzone)
29      }
30    }
31    time
32  } else {
33    .with_tz(time, tzone)
34  }
35}
36
37.with_tz <- function(time, tzone = "") {
38  out <- if (!is.POSIXct(time)) as.POSIXct(time) else time
39  attr(out, "tzone") <- tzone
40  if (is.POSIXlt(time)) {
41    out <- as.POSIXlt(out)
42  }
43  out
44}
45
46#' Replace time zone to create new date-time
47#'
48#' `force_tz` returns the date-time that has the same clock time as input time,
49#'  but in the new time zone. `force_tzs` is the parallel version of `force_tz`,
50#'  meaning that every element from `time` argument is matched with the
51#'  corresponding time zone in `tzones` argument.
52#'
53#'  Although the new date-time has the same clock time (e.g. the same values in
54#'  the year, month, days, etc. elements) it is a different moment of time than
55#'  the input date-time.
56#'
57#'  As R date-time vectors cannot hold elements with non-uniform time zones,
58#'  `force_tzs` returns a vector with time zone `tzone_out`, UTC by default.
59#'
60#' @param time a POSIXct, POSIXlt, Date, chron date-time object, or a data.frame
61#'   object. When a data.frame all POSIXt elements of a data.frame are processed
62#'   with `force_tz()` and new data.frame is returned.
63#' @param tzone a character string containing the time zone to convert to. R
64#'   must recognize the name contained in the string as a time zone on your
65#'   system.
66#' @param roll logical. If TRUE, and `time` falls into the DST-break, assume
67#'   the next valid civil time, otherwise return NA. See examples.
68#' @return a POSIXct object in the updated time zone
69#' @keywords chron manip
70#' @seealso [with_tz()], [local_time()]
71#' @examples
72#' x <- ymd_hms("2009-08-07 00:00:01", tz = "America/New_York")
73#' force_tz(x, "UTC")
74#' force_tz(x, "Europe/Amsterdam")
75#'
76#' ## DST skip:
77#'
78#' y <- ymd_hms("2010-03-14 02:05:05 UTC")
79#' force_tz(y, "America/New_York", roll=FALSE)
80#' force_tz(y, "America/New_York", roll=TRUE)
81#' @export
82force_tz <- function(time, tzone = "", roll = FALSE) {
83  tzone <- as.character(tzone)
84  if (is.data.frame(time)) {
85    for (nm in names(time)) {
86      if (is.POSIXt(time[[nm]])) {
87        time[[nm]] <- force_tz(time[[nm]], tzone = tzone)
88      }
89    }
90    time
91  } else {
92    if (is.POSIXct(time))
93      cpp_force_tz(time, tz = tzone, roll)
94    else if (is.Date(time))
95      cpp_force_tz(date_to_posix(time), tz = tzone, roll)
96    else {
97      out <- cpp_force_tz(as.POSIXct(time, tz = tz(time)), tz = tzone, roll)
98      reclass_date(out, time)
99    }
100  }
101}
102
103#' @param tzones character vector of timezones to be "enforced" on `time` time
104#'   stamps. If `time` and `tzones` lengths differ, the smaller one is recycled
105#'   in accordance with usual R conventions.
106#' @param tzone_out timezone of the returned date-time vector (for `force_tzs`).
107#' @rdname force_tz
108#' @examples
109#'
110#' ## Heterogeneous time-zones:
111#'
112#' x <- ymd_hms(c("2009-08-07 00:00:01", "2009-08-07 01:02:03"))
113#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"))
114#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"), tzone_out = "America/New_York")
115#'
116#' x <- ymd_hms("2009-08-07 00:00:01")
117#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"))
118#' @export
119force_tzs <- function(time, tzones, tzone_out = "UTC", roll = FALSE) {
120  if (length(tzones) < length(time))
121    tzones <- rep_len(tzones, length(time))
122  else if (length(tzones) > length(time)) {
123    attr <- attributes(time)
124    time <- rep_len(time, length(tzones))
125    attributes(time) <- attr
126  }
127  out <- cpp_force_tzs(as.POSIXct(time), tzones, tzone_out, roll)
128  reclass_date(out, time)
129}
130
131#' Get local time from a date-time vector.
132#'
133#' `local_time` retrieves day clock time in specified time zones. Computation is
134#' vectorized over both `dt` and `tz` arguments, the shortest is recycled in
135#' accordance with standard R rules.
136#'
137#' @param dt a date-time object.
138#' @param tz a character vector of timezones for which to compute the local time.
139#' @param units passed directly to [as.difftime()].
140#' @examples
141#'
142#' x <- ymd_hms(c("2009-08-07 01:02:03", "2009-08-07 10:20:30"))
143#' local_time(x, units = "secs")
144#' local_time(x, units = "hours")
145#' local_time(x, "Europe/Amsterdam")
146#' local_time(x, "Europe/Amsterdam") == local_time(with_tz(x, "Europe/Amsterdam"))
147#'
148#' x <- ymd_hms("2009-08-07 01:02:03")
149#' local_time(x, c("America/New_York", "Europe/Amsterdam", "Asia/Shanghai"), unit = "hours")
150#' @export
151local_time <- function(dt, tz = NULL, units = "secs") {
152  if (is.null(tz))
153    tz <- tz(dt)
154  if (length(tz) < length(dt))
155    tz <- rep_len(tz, length(dt))
156  else if (length(tz) > length(dt)) {
157    attr <- attributes(dt)
158    dt <- rep_len(dt, length(tz))
159    attributes(dt) <- attr
160  }
161  secs <- cpp_local_time(as.POSIXct(dt), tz)
162  out <- structure(secs, units = "secs", class = "difftime")
163  units(out) <- units
164  out
165}
166