R/convert.R

Defines functions toTimezone toUTC utcOffset utcToLocalTime localNormalTimeToUTC localNormalTimeToLocalTime utcToBerlinLocalTime berlinNormalTimeToBerlinLocalTime berlinNormalTimeToUTC .test_hsToPosix hsToPosix stringToPosix toGmtRelativePosix to.GMT.plus.1 decade isoToLocaltime

Documented in berlinNormalTimeToBerlinLocalTime berlinNormalTimeToUTC decade hsToPosix isoToLocaltime localNormalTimeToLocalTime localNormalTimeToUTC stringToPosix to.GMT.plus.1 toGmtRelativePosix toTimezone toUTC utcOffset utcToBerlinLocalTime utcToLocalTime

#
# IMPORTANT fact about GMT/UTC timezones:
#
# http://stackoverflow.com/questions/7303580/understanding-the-etc-gmt-time-zone
#
# "For example, TZ='Etc/GMT+4' uses the abbreviation "GMT+4" and corresponds to
# 4 hours behind UTC (i.e. west of Greenwich) even though many people would
# expect it to mean 4 hours ahead of UTC (i.e. east of Greenwich)."
#

# isoToLocaltime ---------------------------------------------------------------

#' Text Timestamps to POSIXct
#' 
#' Convert text timestamps in a format according to ISO 8601 to POSIXct objects 
#' 
#' @param timestamps vector of character timestamps of format \code{yyyy-mm-dd 
#'   HH:MM:SS+[01|02]}, i.e. ending either in '+0100' (UTC offset in Berlin in
#'   winter) or '+0200' (UTC offset in Berlin in summer)
#' @param dbg if \code{TRUE} debug messages are shown
#' 
#' @export
#' 
#' @examples
#' times <- isoToLocaltime(c(
#'   "2017-10-29 01:00:00+0200", 
#'   "2017-10-29 01:30:00+0200", 
#'   "2017-10-29 02:00:00+0200",
#'   "2017-10-29 02:30:00+0200",
#'   "2017-10-29 02:00:00+0100", 
#'   "2017-10-29 02:30:00+0100", 
#'   "2017-10-29 03:00:00+0100", 
#'   "2017-10-29 03:30:00+0100"
#' ))
#' 
#' class(times)
#' plot(times, rep(1, length(times)), ylab = "", xlab = "LocalTime")
#' 
isoToLocaltime <- function(timestamps, dbg = TRUE)
{
  if (! is.character(timestamps)) {
    
    stop("timestamps are expected to be of mode character")
  }
  
  if (! all(hasTimeFormat(timestamps, "^%Y-%m-%d %H:%M:%S[+](0100|0200)$"))) {
    
    stop(
      'Not all timestamps are in the expected format\n', 
      '"yyyy-mm-dd HH:MM:SS+[0100|0200]", i.e. ending either in\n',
      '  "+0100" (UTC offset in winter) or\n', 
      '  "+0200" (UTC offset in summer)!'
    )
  }
  
  kwb.utils::catIf(dbg, "Converting", length(timestamps), "timestamps ... ")
  localtimes <- as.POSIXct(timestamps, format = "%F %T%z")
  kwb.utils::catIf(dbg, "ok.\n")
  
  localtimes
}

# decade -----------------------------------------------------------------------

#' Year Number to Decade Number
#' 
#' Convert a year number to a decade number (round down to full decade)
#' 
#' @param year year number, e.g. 2016
#' 
#' @keywords internal
#' 
decade <- function(year)
{
  stopifnot(is.numeric(year))
  
  10 * (year %/% 10)  
}

# to.GMT.plus.1 ----------------------------------------------------------------

#' Character Timestamps to POSIXct Objects (GMT+1)
#' 
#' @param timestamp character timestamp(s) to be converted to POSIXct in
#'   timezone "Etc/GMT+1"
#'   
#' @return vector of POSIXct in timezone \dQuote{Etc/GMT+1}
#' 
#' @export
#' 
to.GMT.plus.1 <- function(timestamp)
{
  stopifnot(is.character(timestamp))
  
  toGmtRelativePosix(timestamp, GMT.offset = 1)
}

# toGmtRelativePosix -----------------------------------------------------------

#' Character Timestamps to POSIXct Objects (GMT+\emph{offset})
#' 
#' Convert character timestamps to POSIXct objects in time zont 
#' GMT+\emph{offset}
#' 
#' @param timestamp vector of timestamps (character)
#' @param GMT.offset offset to GMT time. Default: 1 = Berlin Normal Time
#' @param format format string describing the format of \emph{timstamp}, see
#'   help for \code{strptime}. Default: "\%Y-\%m-\%d \%H:\%M:\%S"
#'
#' @export
#' 
toGmtRelativePosix <- function(timestamp, GMT.offset = 1, format = NULL)
{
  stopifnot(is.character(timestamp))
  
  # set default time format (it seems that inlinedocs does not like the default
  # assignment in the argument definition above)
  format <- kwb.utils::defaultIfNULL(format, "%Y-%m-%d %H:%M:%S")
  
  as.POSIXct(timestamp, tz = sprintf("Etc/GMT%+d", GMT.offset), format = format)
}

# stringToPosix ----------------------------------------------------------------

#' Convert a Time String to a POSIXct Object
#' 
#' Convert a time string to a POSIXct object. Allow for different possible 
#' timestamp formats.
#' 
#' @param x character vector of length one representing a timestamp
#' @param formats vector of allowed time formats (using \%-placeholders)
#' @param \dots arguments passed to \code{\link{hsToPosix}}
#' 
#' @export
#' 
#' @examples 
#' stringToPosix("2016-05-26")
#' stringToPosix("2016-05-26 12:00")
#'   
#' # additional arguments passed to hsToPosix
#' stringToPosix("2016-05-26 12:00:33", tzone = "ETC/Gmt-1")
#'   
#' # lt = TRUE -> create POSIXlt instead of POSIXct
#' lt1 <- stringToPosix("2016-05-26 17:00", lt = TRUE)
#' lt2 <- stringToPosix("2016-05-26 17:00", lt = TRUE, tz = "Europe/Berlin")
#'   
#' lt1$hour
#' lt1$isdst # normal time (is daylight saving time = FALSE)
#' lt2$isdst # summer time (is daylight saving time = TRUE)
#' 
stringToPosix <- function(
  x, formats = c("%Y-%m-%d %H:%M:%S", "%Y-%m-%d %H:%M", "%Y-%m-%d"), ...
)
{
  if (is.factor(x)) {
    
    x <- as.character(x)
  }
  
  if (class(x) != "character" || length(x) != 1) {
    
    stop("x must be a character vector of length one.")
  }
  
  # Find the matching format or stop
  isMatching <- sapply(formats, kwb.datetime::hasTimeFormat, timestamps = x)
  
  if (sum(isMatching) == 0) {
    
    formats <- kwb.utils::stringList(formats)
    
    stop("Timestamp '", x, "' does not match any of these formats: ", formats)
  }
  
  # Call the lubridate function corresponding to the matching pattern on x
  hsToPosix(x, format = formats[isMatching], ...)
}

# hsToPosix --------------------------------------------------------------------

#' Conversion to POSIXt
#' 
#' Converts an object representing a date (and if applicable a time) into an 
#' object of class POSIXct. Supported input classes are character, Date and 
#' POSIXt.
#' 
#' @param datetime object of class POSIXt or Date or character representing date
#'   (and time) information to be converted to class POSIXct.
#' @param keepTZ if \code{TRUE} and if the given object is already of
#'   POSIX-type, the returned POSIXct object will be in the same time zone as
#'   the original object. Otherwise POSIX-objects will be returned in the time
#'   zone \emph{tzone}.
#' @param tzone time zone. Will be set to \dQuote{UTC} if missing. UTC it the
#'   preferred time zone as it seems that only UTC prevents the POSIXt-classes
#'   from applying daylight-savings time.
#' @param lt if TRUE a POSIXlt object is returned instead of a POSIXct object.
#' @param \dots further arguments to be passed to as.POSIXct/as.POSIXlt, e.g.
#'   format, help for as.POSIXct/as.POSIXlt.
#' 
#' @details If \emph{datetime} is already of class POSIXlt or POSIXct the time
#'   zone is preserved unless \emph{keepTZ} is FALSE. If \emph{datetime} is a
#'   character string it is expected to be in ISO format: \dQuote{yyyy-mm-dd
#'   [HH:MM:SS]} where the time-part in brackets is optional.
#' 
#' @export
#' 
#' @examples 
#' # Start with a string representing a timestamp
#' datetime <- "2011-01-02 12:34:56"
#'   
#' # By default hsToPosix creates a POSIXct object:
#' ct <- hsToPosix(datetime)
#' class(ct) # "POSIXct" "POSIXt"
#'   
#' # You may decide to create a POSIXlt object instead:
#' lt <- hsToPosix(datetime, lt = TRUE)
#' class(lt) # "POSIXlt" "POSIXt"
#'   
#' # With a POSIXlt object you can access the different parts of the timestamp
#' sprintf("%d hours, %d minutes, %d seconds", lt$hour, lt$min, lt$sec)
#' 
#' # These are all available pieces of information 
#' # (isdst = is daylight savings time in effect)
#' sapply(attr(lt, "names"), function(name) try(lt[[name]]))
#'   
#' # You may use hsToPosix to convert between lt and ct
#' identical(hsToPosix(ct, lt = TRUE), lt)
#' identical(hsToPosix(lt, lt = FALSE), ct)
#'   
#' # The following time does not exist in CET/CEST but in UTC 
#' # as it is the time when daylight-savings time switched.
#' hsToPosix("2011-03-27 02:00:00") # "2011-03-27 02:00:00 UTC"
#'   
#' # Compare with as.POSIXct: between 02:00:00 and 02:59:59 the 
#' # time information gets lost and is only recognized again 
#' # from 03:00:00 on. Similar results with as.POSIXlt.
#' as.POSIXlt("2011-03-27 01:59:59") # "2011-03-27 01:59:59"
#' as.POSIXlt("2011-03-27 02:00:00") # "2011-03-27"
#' as.POSIXlt("2011-03-27 02:59:59") # "2011-03-27"
#' as.POSIXlt("2011-03-27 03:00:00") # "2011-03-27 03:00:00"  
#'   
#' # When loading data from an Access table it will be of class
#' # POSIXct:
#' #dat <- hsGetTable(xmdb(), "tbl_Hyd")
#' #class(dat$Zeitst) # "POSIXct" "POSIXt"
#'   
#' # In order to prevent R from considering daylight savings time
#' # we should convert to UTC time zone. But then we have to keep
#' # in mind that the indication "UTC" is not correct as the time
#' # stamps in fact represent the time zone "UTC+1"!
#' #head(dat$Zeitst) 
#' # "2011-08-23 00:00:00 CEST" "2011-08-23 00:01:00 CEST" ...
#'   
#' #head(hsToPosix(dat$Zeitst))  
#' # "2011-08-23 00:00:00 UTC" "2011-08-23 00:01:00 UTC" ...
#' 
hsToPosix <- function(
  datetime, keepTZ = is.null(tzone), tzone = NULL, lt = FALSE, ...
) 
{
  # Check if object is of allowed class.
  allowed <- c("character", "Date", "POSIXt")
  
  isOfClass <- sapply(allowed, inherits, x = datetime)
  
  # Raise error if object is of neither of the supported classes.
  if (! any(isOfClass)) {
    
    stop(
      "datetime is not of one of the supported classes ", 
      kwb.utils::stringList(allowed)
    )
  }
  
  # Default time zone is Coordinated Universal Time (UTC)
  tzone <- kwb.utils::defaultIfNULL(tzone, "UTC")
  
  # Use as.POSIXct or as.POSIXlt as the conversion function
  functionName <- paste0("as.POSIX", ifelse(lt, "lt", "ct"))
  
  # If the object is of class POSIXt and the time zone is to be kept,
  # convert it to POSIXct (it may be in POSIXlt) and return the result
  if (inherits(datetime, "POSIXt") && keepTZ) {
    
    do.call(functionName, list(x = datetime))
    
  } else {
    
    # If the original object is of class Date or POSIXt it needs to be
    # transformed to a string containing the date in ISO format first.
    datetime <- as.character(datetime)
    
    # Return a POSIXct/POSIXlt object in the requested time zone.
    do.call(functionName, list(x = datetime, tz = tzone, ...))
  }
}

# .test_hsToPosix --------------------------------------------------------------
.test_hsToPosix <- function()
{
  datetime <- "2011-01-02 12:34:56"
  
  ct <- hsToPosix(datetime)
  lt <- hsToPosix(datetime, lt = TRUE)
  
  stopifnot("POSIXct" %in% class(ct))
  stopifnot("POSIXlt" %in% class(lt))
  
  stopifnot(identical(hsToPosix(ct), ct))
  stopifnot(identical(hsToPosix(lt), ct))
}

# berlinNormalTimeToUTC --------------------------------------------------------

#' berlinNormalTimeToUTC
#' 
#' @param x character string representing a timestamp measured in Berlin without
#'   adjusting time during the summer period, i.e. keeping the normal (= winter) 
#'   time (= UTC+1)
#' 
#' @export
#' 
berlinNormalTimeToUTC <- function(x) 
{
  localNormalTimeToUTC(x, UTCOffset = 1)
}

# berlinNormalTimeToBerlinLocalTime --------------------------------------------

#' berlinNormalTimeToBerlinLocalTime
#' 
#' @param x character string representing a timestamp measured in Berlin without
#'   adjusting time during the summer period, i.e. keeping the normal (= winter) 
#'   time (= UTC+1)
#'   
#' @export
#' 
berlinNormalTimeToBerlinLocalTime <- function(x) 
{
  localNormalTimeToLocalTime(x, UTCOffset = 1, tz = "Europe/Berlin")
}

# utcToBerlinLocalTime ---------------------------------------------------------

#' utcToBerlinLocalTime
#' 
#' @param x Character timestamp that is interpretable by
#'   \code{\link{as.POSIXct}}, representing a time given in UTC
#' 
#' @keywords internal
#' 
utcToBerlinLocalTime <- function(x) 
{
  utcToLocalTime(x, "Europe/Berlin")
}

# localNormalTimeToLocalTime ---------------------------------------------------

#' localNormalTimeToLocalTime
#' 
#' @param x character timestamp that is interpretable by
#'   \code{\link{as.POSIXct}}, representing a time given in UTC
#' @param UTCOffset UTC offset in number of hours that the local normal time is 
#'   ahead of UTC, e.g. +01 hour for Berlin nomral (= winter) time 
#' @param tz time zone of the local time
#' 
#' @keywords internal
#' 
localNormalTimeToLocalTime <- function(x, UTCOffset, tz)
{
  utcToLocalTime(localNormalTimeToUTC(x, UTCOffset), tz)
}

# localNormalTimeToUTC ---------------------------------------------------------

#' localNormalTimeToUTC
#' 
#' @param x Character timestamp that is interpretable by
#'   \code{\link{as.POSIXct}}, representing a time given in UTC
#' @param UTCOffset UTC offset in number of hours that the local normal time is 
#'   ahead of UTC, e.g. +01 hour for Berlin nomral (= winter) time 
#' 
#' @keywords internal
#' 
localNormalTimeToUTC <- function(x, UTCOffset) 
{
  stopifnot(is.character(x))
  
  format(as.POSIXct(x, tz = "UTC") - UTCOffset * 3600, tz = "UTC")  
}

# utcToLocalTime ---------------------------------------------------------------

#' utcToLocalTime
#' 
#' @param x Character timestamp that is interpretable by
#'   \code{\link{as.POSIXct}}, representing a time given in UTC
#' @param tz string representing the timezone to which the timestamp is to be
#'   converted
#'
#' @keywords internal
#' 
utcToLocalTime  <- function(x, tz) 
{
  stopifnot(is.character(x))  
  
  format(as.POSIXct(x, tz = "UTC"), tz = tz)  
}

# utcOffset --------------------------------------------------------------------

#' Get UTC Offset from Local and UTC Timestamp (Character)
#' 
#' @param LocalDateTime character string representing a local timestamp
#' @param DateTimeUTC character string representing a time stamp in UTC
#' 
#' @export
#' 
utcOffset <- function(LocalDateTime, DateTimeUTC)
{
  stopifnot(is.character(LocalDateTime) && is.character(DateTimeUTC))
  
  as.numeric(difftime(
    as.POSIXct(LocalDateTime, tz = "UTC"),
    as.POSIXct(DateTimeUTC, tz = "UTC"), 
    units = "h"
  ))
}

# # berlinWinterTimeToBerlinLocalTime --------------------------------------------
# berlinWinterTimeToBerlinLocalTime <- function # berlinWinterTimeToBerlinLocalTime
# ### berlinWinterTimeToBerlinLocalTime
# (
#   x
#   ### character timestamp given in Berlin winter time (i.e. the local timestamp
#   ### itself for times in winter and the local timestamp, reduced by one hour
#   ### for times in summer)
# )
# {
#   utcToBerlinLocalTime(berlinWinterTimeToUTC(x)$charUTC)
# }
# 
# # utcToLocalTimeAndOffset ------------------------------------------------------
# utcToLocalTimeAndOffset <- function # UTC timestamp to Local Time in time zone
# ### convert UTC timestamp to Local Time (in given time zone)
# (
#   DateTimeUTC,
#   ### character timestamp given in UTC
#   tz = "Europe/Berlin",
#   ### timezone. Default: "Europe/Berlin"
#   stringsAsFactors = FALSE
# )
# {
#   stopifnot(is.character(x))
#   
#   utc <- "UTC"
#   LocalDateTime <- format(as.POSIXct(x, tz=utc), tz=tz)  
#   UTCOffset <- as.numeric(difftime(as.POSIXct(LocalDateTime, tz=utc),
#                                    as.POSIXct(DateTimeUTC, tz=utc), units="h"))
#   
#   data.frame(LocalDateTime = LocalDateTime,        
#              UTCOffset = UTCOffset,
#              DateTimeUTC = DateTimeUTC)
#   ### data frame with character (or factor, if stringsAsFactors = TRUT) columns
#   ### \code{LocalDateTime}, \code{UTCOffset}, \code{DateTimeUTC}
# }
# 
# # utcToBerlinLocalTime ---------------------------------------------------------
# utcToBerlinLocalTime <- function # UTC timestamp to Berlin Local Time
# ### convert UTC timestamp to Berlin Local Time (including switches of Daylight
# ### Saving Time)
# (
#   x
#   ### character timestamp given in UTC
# )
# {
#   utcToLocalTime(x, "Europe/Berlin")
#   ### list with elements \code{charLocal}, \code{posixLocal}, \code{utcOffset}
# }
# 
# # utcToOdmDateTimeColumns ------------------------------------------------------
# utcToOdmDateTimeColumns <- function # UTC timestamps to ODM DateTime-columns
# ### UTC timestamps to ODM DateTime-columns
# (
#   DateTimeUTC,
#   ### character timestamps representing UTC time
#   tz = "Europe/Berlin",
#   ### timezone. Default: "Europe/Berlin"
#   stringsAsFactors = FALSE
# )
# {
#   stopifnot(is.character(x))
#   
#   
#   data.frame(LocalDateTime = LocalDateTime,
#              UTCOffset = UTCOffset,
#              DateTimeUTC = DateTimeUTC, 
#              stringsAsFactors = stringsAsFactors)  
# }
# 
# # berlinWinterTimeToUTC --------------------------------------------------------
# berlinWinterTimeToUTC <- function # berlinWinterTimeToUTC
# ### berlinWinterTimeToUTC
# (
#   x
#   ### character timestamp given in Berlin winter time (i.e. the local timestamp
#   ### itself for times in winter and the local timestamp, reduced by one hour
#   ### for times in summer)
# )
# {
#   stopifnot(is.character(x))  
#   
#   offsetUTC <- 1
#   tz <- "UTC"
#   posixUTC <- as.POSIXct(x, tz=tz) - offsetUTC * 3600
#   charUTC <- format(posixUTC, tz=tz)  
#   
#   list(charUTC=charUTC, posixUTC=posixUTC)
#   ### list with elements \code{charUTC}, \code{posixUTC}
# }
# 

# toUTC ------------------------------------------------------------------------

#' Convert POSIXt Object to UTC Time Zone
#' 
#' @param x object of class POSIXt (either POSIXct or POSIXlt)
#' 
#' @return POSIXt object in UTC timezone (hopefully!)
#' 
#' @export
#' 
#' @examples 
#' 
#' # Create a timestamp in the time zone that is set on the local machine
#' time <- as.POSIXct("2017-11-01 01:16")
#' 
#' # Convert time zone to UTC
#' time_utc <- toUTC(time)
#' 
#' # The new time zone "UTC" is set in the attribute "tz"
#' attr(time_utc, "tz")
#' 
#' # The times mean the same, just expressed in another time zone!
#' time_utc == time
#' 
toUTC <- function(x)
{
  toTimezone(x, "UTC")
}

# toTimezone -------------------------------------------------------------------

#' Convert POSIXt Object to given Time Zone
#' 
#' @param x object of class POSIXt (either POSIXct or POSIXlt)
#' @param tz timezone, e.g. "Europe/Berlin", see \code{base::timezones} for help
#'   about possible time zone strings
#'   
#' @return POSIXt object in requested timezone (hopefully!)
#'   
#' @keywords internal
#' 
toTimezone <- function(x, tz)
{
  stopifnot(inherits(x, "POSIXt"))
  
  as.POSIXct(format(x, tz = tz), tz = tz)  
}
KWB-R/kwb.datetime documentation built on July 9, 2021, 10:28 p.m.