File: time-zones.r

package info (click to toggle)
r-cran-lubridate 1.7.4-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,952 kB
  • sloc: cpp: 3,329; ansic: 714; sh: 22; makefile: 2
file content (164 lines) | stat: -rw-r--r-- 6,048 bytes parent folder | download
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
#' Get date-time in a different time zone
#'
#' with_tz returns a date-time as it would appear in a different time zone.
#' The actual moment of time measured does not change, just the time zone it is
#' measured in. with_tz defaults to the Universal Coordinated time zone (UTC)
#' when an unrecognized time zone is inputted. See [Sys.timezone()]
#' for more information on how R recognizes time zones.
#'
#' @param time a POSIXct, POSIXlt, Date, chron date-time object or a data.frame
#'   object. When a data.frame all POSIXt elements of a data.frame are processed
#'   with `with_tz()` and new data.frame is returned.
#' @param tzone a character string containing the time zone to convert to. R
#'   must recognize the name contained in the string as a time zone on your
#'   system.
#' @return a POSIXct object in the updated time zone
#' @keywords chron manip
#' @seealso [force_tz()]
#' @examples
#' x <- ymd_hms("2009-08-07 00:00:01", tz = "America/New_York")
#' with_tz(x, "GMT")
#' @export
with_tz <- function (time, tzone = "") {
  if (!C_valid_tz(tzone))
    warning(sprintf("Unrecognized time zone '%s'", tzone))
  if (is.data.frame(time)) {
    for (nm in names(time)) {
      if (is.POSIXt(time[[nm]])) {
        time[[nm]] <- .with_tz(time[[nm]], tzone = tzone)
      }
    }
    time
  } else {
    .with_tz(time, tzone)
  }
}

.with_tz <- function (time, tzone = "") {
  new <-
    if (is.POSIXlt(time)) as.POSIXct(time)
    else time
  attr(new, "tzone") <- tzone
  reclass_date(new, time)
}

#' Replace time zone to create new date-time
#'
#' `force_tz` returns the date-time that has the same clock time as input time,
#'  but in the new time zone. `force_tzs` is the parallel version of `force_tz`,
#'  meaning that every element from `time` argument is matched with the
#'  corresponding time zone in `tzones` argument.
#'
#'  Although the new date-time has the same clock time (e.g. the same values in
#'  the year, month, days, etc. elements) it is a different moment of time than
#'  the input date-time.
#'
#'  As R date-time vectors cannot hold elements with non-uniform time zones,
#'  `force_tzs` returns a vector with time zone `tzone_out`, UTC by default.
#'
#' @param time a POSIXct, POSIXlt, Date, chron date-time object, or a data.frame
#'   object. When a data.frame all POSIXt elements of a data.frame are processed
#'   with `force_tz()` and new data.frame is returned.
#' @param tzone a character string containing the time zone to convert to. R
#'   must recognize the name contained in the string as a time zone on your
#'   system.
#' @param roll logical. If TRUE, and `time` falls into the DST-break, assume
#'   the next valid civil time, otherwise return NA. See examples.
#' @return a POSIXct object in the updated time zone
#' @keywords chron manip
#' @seealso [with_tz()], [local_time()]
#' @examples
#' x <- ymd_hms("2009-08-07 00:00:01", tz = "America/New_York")
#' force_tz(x, "UTC")
#' force_tz(x, "Europe/Amsterdam")
#'
#' ## DST skip:
#'
#' y <- ymd_hms("2010-03-14 02:05:05 UTC")
#' force_tz(y, "America/New_York", roll=FALSE)
#' force_tz(y, "America/New_York", roll=TRUE)
#' @export
force_tz <- function(time, tzone = "", roll = FALSE) {
  tzone <- as.character(tzone)
  if (is.data.frame(time)) {
    for (nm in names(time)) {
      if (is.POSIXt(time[[nm]])) {
        time[[nm]] <- force_tz(time[[nm]], tzone = tzone)
      }
    }
    time
  } else {
    if (is.POSIXct(time))
      C_force_tz(time, tz = tzone, roll)
    else if (is.Date(time))
      as_date(C_force_tz(date_to_posix(time), tz = tzone, roll))
    else {
      out <- C_force_tz(as.POSIXct(time, tz = tz(time)), tz = tzone, roll)
      reclass_date(out, time)
    }
  }
}

#' @param tzones character vector of timezones to be "enforced" on `time` time
#'   stamps. If `time` and `tzones` lengths differ, the smaller one is recycled
#'   in accordance with usual R conventions.
#' @param tzone_out timezone of the returned date-time vector (for `force_tzs`).
#' @rdname force_tz
#' @examples
#'
#' ## Heterogeneous time-zones:
#'
#' x <- ymd_hms(c("2009-08-07 00:00:01", "2009-08-07 01:02:03"))
#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"))
#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"), tzone_out = "America/New_York")
#'
#' x <- ymd_hms("2009-08-07 00:00:01")
#' force_tzs(x, tzones = c("America/New_York", "Europe/Amsterdam"))
#' @export
force_tzs <- function(time, tzones, tzone_out = "UTC", roll = FALSE) {
  if (length(tzones) < length(time))
    tzones <- rep_len(tzones, length(time))
  else if (length(tzones) > length(time)) {
    attr <- attributes(time)
    time <- rep_len(time, length(tzones))
    attributes(time) <- attr
  }
  out <- C_force_tzs(as.POSIXct(time), tzones, tzone_out, roll)
  reclass_date(out, time)
}

#' Get local time from a date-time vector.
#'
#' `local_time` retrieves day clock time in specified time zones. Computation is
#' vectorized over both `dt` and `tz` arguments, the shortest is recycled in
#' accordance with standard R rules.
#'
#' @param dt a date-time object.
#' @param tz a character vector of timezones for which to compute the local time.
#' @param units passed directly to [as.difftime()].
#' @examples
#'
#' x <- ymd_hms(c("2009-08-07 01:02:03", "2009-08-07 10:20:30"))
#' local_time(x, units = "secs")
#' local_time(x, units = "hours")
#' local_time(x, "Europe/Amsterdam")
#' local_time(x, "Europe/Amsterdam") == local_time(with_tz(x, "Europe/Amsterdam"))
#'
#' x <- ymd_hms("2009-08-07 01:02:03")
#' local_time(x, c("America/New_York", "Europe/Amsterdam", "Asia/Shanghai"), unit = "hours")
#' @export
local_time <- function(dt, tz = NULL, units = "secs") {
  if (is.null(tz))
    tz <- tz(dt)
  if (length(tz) < length(dt))
    tz <- rep_len(tz, length(dt))
  else if (length(tz) > length(dt)) {
    attr <- attributes(dt)
    dt <- rep_len(dt, length(tz))
    attributes(dt) <- attr
  }
  secs <- C_local_time(as.POSIXct(dt), tz)
  out <- structure(secs, units = "secs", class = "difftime")
  units(out) <- units
  out
}