Nothing
R/CFCalendar.R
In CFtime: Using CF-Compliant Calendars with Climate Projection Data
#' @import R6
NULL
#' @title Basic CF calendar
#'
#' @description This class represents a basic CF calendar. It should not be
#' instantiated directly; instead, use one of the descendant classes.
#'
#' This internal class stores the information to represent date and time
#' values using the CF conventions. An instance is created by the exported
#' [CFTime] class, which also exposes the relevant properties of this class.
#'
#' The following calendars are supported:
#'
#' \itemize{
#' \item [`gregorian\standard`][CFCalendarStandard], the international standard calendar for civil use.
#' \item [`proleptic_gregorian`][CFCalendarProleptic], the standard calendar but extending before 1582-10-15
#' when the Gregorian calendar was adopted.
#' \item [`tai`][CFCalendarTAI], International Atomic Time clock with dates expressed using the Gregorian calendar.
#' \item [`utc`][CFCalendarUTC], Coordinated Universal Time clock with dates expressed using the Gregorian calendar.
#' \item [`julian`][CFCalendarJulian], every fourth year is a leap year (so including the years 1700, 1800, 1900, 2100, etc).
#' \item [`noleap\365_day`][CFCalendar365], all years have 365 days.
#' \item [`all_leap\366_day`][CFCalendar366], all years have 366 days.
#' \item [`360_day`][CFCalendar360], all years have 360 days, divided over 12 months of 30 days.
#' }
#' @references
#' https://cfconventions.org/Data/cf-conventions/cf-conventions-1.12/cf-conventions.html#calendar
#' @docType class
CFCalendar <- R6::R6Class("CFCalendar",
public = list(
#' @field name Descriptive name of the calendar, as per the CF Metadata
#' Conventions.
name = "",
#' @field definition The string that defines the units and the origin, as
#' per the CF Metadata Conventions.
definition = "",
#' @field unit The numeric id of the unit of the calendar.
unit = -1L,
#' @field origin `data.frame` with fields for the origin of the calendar.
origin = data.frame(),
#' @description Create a new CF calendar.
#' @param nm The name of the calendar. This must follow the CF Metadata
#' Conventions.
#' @param definition The string that defines the units and the origin, as
#' per the CF Metadata Conventions.
initialize = function(nm, definition) {
stopifnot(length(definition) == 1L, length(nm) == 1L)
self$name <- tolower(nm)
self$definition <- definition
parts <- strsplit(definition, " ")[[1L]]
if ((length(parts) < 3L) || !(tolower(parts[2L]) %in% c("since", "after", "from", "ref", "per")))
stop("Definition string does not appear to be a CF-compliant time coordinate description", call. = FALSE)
u <- which(CFt$CFunits$unit == tolower(parts[1L]))
if (length(u) == 0L) stop("Unsupported unit: ", parts[1L], call. = FALSE)
self$unit <- CFt$CFunits$id[u]
dt <- self$parse(paste(parts[3L:length(parts)], collapse = " "))
if (is.na(dt$year[1L]))
stop("Definition string does not appear to be a CF-compliant time coordinate description: invalid base date specification", call. = FALSE)
self$origin <- dt
},
#' @description Print information about the calendar to the console.
#' @param ... Ignored.
#' @return `self`, invisibly.
print = function(...) {
tz <- self$timezone
if (tz == "+0000") tz <- ""
cat("CF calendar:",
"\n Origin : ", self$origin_date, "T", self$origin_time, tz,
"\n Units : ", CFt$units$name[self$unit],
"\n Type : ", self$name, "\n",
sep = "")
invisible(self)
},
#' @description Indicate which of the supplied dates are valid.
#' @param ymd `data.frame` with dates parsed into their parts in columns
#' `year`, `month` and `day`. Any other columns are disregarded.
#' @return `NULL`. A warning will be generated to the effect that a
#' descendant class should be used for this method.
valid_days = function(ymd) {
warning("Use a descendant class from `CFCalendar` to call this method.", call. = FALSE) # nocov
NULL # nocov
},
#' @description Add a day to the supplied dates.
#' @param ymd `data.frame` with dates parsed into their parts in columns
#' `year`, `month` and `day`. Any other columns are disregarded.
#' @return A `data.frame` like argument `ymd` but with a day added for every
#' row.
add_day = function(ymd) {
md <- self$month_days(ymd)
ifelse(ymd$day < md,
ymd$day <- ymd$day + 1L,
{
ymd$day <- 1L
ifelse(ymd$month < 12L,
ymd$month <- ymd$month + 1L,
{
ymd$month <- 1L
ymd$year <- ymd$year + 1L
}
)
}
)
ymd
},
#' @description Indicate if the time series described using this calendar
#' can be safely converted to a standard date-time type (`POSIXct`,
#' `POSIXlt`, `Date`).
#'
#' Only the 'standard' calendar and the 'proleptic_gregorian' calendar
#' when all dates in the time series are more recent than 1582-10-15
#' (inclusive) can be safely converted, so this method returns `FALSE` by
#' default to cover the majority of cases.
#' @param offsets The offsets from the CFtime instance.
#' @return `FALSE` by default.
POSIX_compatible = function(offsets) {
FALSE
},
#' @description This method tests if the `CFCalendar` instance in argument
#' `cal` is compatible with `self`, meaning that they are of the same
#' class and have the same unit. Calendars "standard", and "gregorian" are
#' compatible, as are the pairs of "365_day" and "no_leap", and "366_day"
#' and "all_leap".
#' @param cal Instance of a descendant of the `CFCalendar` class.
#' @return `TRUE` if the instance in argument `cal` is compatible with
#' `self`, `FALSE` otherwise.
is_compatible = function(cal) {
self$unit == cal$unit && class(self)[1L] == class(cal)[1L]
},
#' @description This method tests if the `CFCalendar` instance in argument
#' `cal` is equivalent to `self`, meaning that they are of the same class,
#' have the same unit, and equivalent origins. Calendars "standard", and
#' "gregorian" are equivalent, as are the pairs of "365_day" and
#' "no_leap", and "366_day" and "all_leap".
#'
#' Note that the origins need not be identical, but their parsed values
#' have to be. "2000-01" is parsed the same as "2000-01-01 00:00:00", for
#' instance.
#' @param cal Instance of a descendant of the `CFCalendar` class.
#' @return `TRUE` if the instance in argument `cal` is equivalent to
#' `self`, `FALSE` otherwise.
is_equivalent = function(cal) {
sum(self$origin[1L,1L:6L] == cal$origin[1L,1L:6L]) == 6L && # Offset column is NA
self$is_compatible(cal)
},
#' @description Parsing a vector of date-time character strings into parts.
#' @param d character. A character vector of date-times.
#' @return A `data.frame` with columns year, month, day, hour, minute,
#' second, time zone, and offset. Invalid input data will appear as `NA`.
parse = function(d) {
# Parsers
# UDUNITS broken timestamp definition, with some changes
# broken_timestamp {broken_date}({space|T}+{broken_clock})? -- T not in definition but present in lexer code
# broken_date {year}-{month}(-{day})?
# year [+-]?[0-9]{1,4}
# month 0?[1-9]|1[0-2]
# day 0?[1-9]|[1-2][0-9]|30|31
# broken_clock {hour}:{minute}(:{second})?
# hour [0-1]?[0-9]|2[0-3] -- sign on hour not allowed, but see timezone
# minute [0-5]?[0-9]
# second {minute}? -- leap second not supported
# fractional part (\.[0-9]*)?
# timezone [+-]?{hour}(:{minute})? -- added, present in lexer code
broken <- paste0(
"^", # anchor string at start
"([+-]?[0-9]{1,4})", # year, with optional sign
"-(0?[1-9]|1[012])", # month
"(?:-(0?[1-9]|[12][0-9]|3[01]))?", # day, optional
"(?:[T ]", # if a time is following, separate with a single whitespace character or a "T"
"([01]?[0-9]|2[0-3])", # hour
":([0-5]?[0-9])", # minute
"(?::([0-5]?[0-9]))?", # second, optional
"(?:\\.([0-9]*))?", # optional fractional part of the smallest specified unit
")?", # close optional time capture group
"(?:\\s", # if a time zone offset is following, separate with a single whitespace character
"([+-])?([01]?[0-9]|2[0-3])", # tz hour, with optional sign
"(?::(00|15|30|45))?", # optional tz minute, only 4 possible values
")?", # close optional timezone capture group
"$" # anchor string at end
)
iso8601 <- paste0(
"^",
"([0-9]{4})",
"-(0[1-9]|1[012])",
"-(0[1-9]|[12][0-9]|3[01])?",
"(?:",
"[T ]([01][0-9]|2[0-3])",
"(?::([0-5][0-9]))?",
"(?::([0-5][0-9]))?",
"(?:[\\.,]([0-9]*))?",
")?",
"(?:([Z+-])([01][0-9]|2[0-3])?(?::(00|15|30|45))?", ## FIXME: Z?, smaller number of captures
")?$"
)
# UDUNITS packed timestamp definition - NOT YET USED
# packed_timestamp {packed_date}({space|T}+{packed_clock})? -- T and space only allowed in packed time follows
# packed_date {year}({month}{day}?)? -- must be YYYYMMDD or else format is ambiguous, as per lexer code
# packed_clock {hour}({minute}{second}?)? -- must be HHMMSS to be unambiguous
# timezone [+-]?{hour}({minute})? -- added, present in lexer code, must be HHMM
# packed <- stringi::stri_join(
# "^", # anchor string at start
# "([+-]?[0-9]{4})", # year, with optional sign
# "(0[1-9]|1[012])?", # month, optional
# "(0[1-9]|[12][0-9]|3[01])?", # day, optional
# "(?:[T,\\s]", # if a time is following, separate with a single whitespace character or a "T"
# "([01][0-9]|2[0-3])?", # hour
# "([0-5][0-9])?", # minute, optional
# "([0-5]?[0-9](?:\\.[0-9]*)?)?", # second, optional, with optional fractional part
# ")?", # close optional time capture group
# "(?:\\s", # if a time zone offset is following, separate with a single whitespace character
# "([+-]?[01][0-9]|2[0-3])?", # hour, with optional sign
# "(00|15|30|45)?", # minute, only 4 possible values
# ")?", # close optional timezone capture group
# "$" # anchor string at end
# )
parse <- data.frame(year = integer(), month = integer(), day = integer(),
hour = integer(), minute = integer(), second = numeric(), frac = character(),
tz_sign = character(), tz_hour = character(), tz_min = character())
# Drop "UTC", if given
d <- trimws(gsub("UTC$", "", d))
cap <- utils::strcapture(iso8601, d, parse)
missing <- which(is.na(cap$year))
if (length(missing) > 0L)
cap[missing,] <- utils::strcapture(broken, d[missing], parse)
# Assign any fraction to the appropriate time part
cap$frac[is.na(cap$frac)] <- "0"
frac <- as.numeric(paste0("0.", cap$frac))
if (sum(frac) > 0) {
ndx <- which(!(is.na(cap$second)) & frac > 0)
if (length(ndx) > 0L) cap$second[ndx] <- cap$second[ndx] + frac[ndx]
ndx <- which(!(is.na(cap$minute)) & is.na(cap$second) & frac > 0)
if (length(ndx) > 0L) cap$second[ndx] <- 60L * frac[ndx]
ndx <- which(!(is.na(cap$hour)) & is.na(cap$minute) & frac > 0)
if (length(ndx) > 0L) {
secs <- 3600 * frac
cap$minute[ndx] <- secs[ndx] %/% 60
cap$second[ndx] <- secs[ndx] %% 60
}
}
cap$frac <- NULL
# Convert NA time parts to 0 - in CF default time is 00:00:00 when not specified
cap$hour[is.na(cap$hour)] <- 0L
cap$minute[is.na(cap$minute)] <- 0L
cap$second[is.na(cap$second)] <- 0L
# Set timezone to default value where needed
ndx <- which(cap$tz_sign == "Z")
if (length(ndx) > 0L) {
cap$tz_sign[ndx] <- "+"
cap$tz_hour[ndx] <- "00"
cap$tz_min[ndx] <- "00"
}
cap$tz <- paste0(ifelse(cap$tz_sign == "", "+", cap$tz_sign),
ifelse(cap$tz_hour == "", "00", cap$tz_hour),
ifelse(cap$tz_min == "", "00", cap$tz_min))
cap$tz <- ifelse(cap$tz =="NANANA", "+0000", cap$tz)
cap$tz_sign <- cap$tz_hour <- cap$tz_min <- NULL
# Set optional date parts to 1 if not specified
cap$month[is.na(cap$month)] <- 1L
cap$day[is.na(cap$day)] <- 1L
# Check date validity
invalid <- !self$valid_days(cap)
invalid[is.na(invalid)] <- TRUE
if (sum(invalid) > 0L) cap[invalid,] <- rep(NA, 7)
# Calculate offsets
if (nrow(self$origin) == 0L) { # if there's no origin yet, don't calculate offsets
cap$offset <- rep(0, nrow(cap)) # this happens, f.i., when a CFCalendar is created
} else {
days <- self$date2offset(cap)
cap$offset <- round((days * 86400 + (cap$hour - self$origin$hour[1]) * 3600 +
(cap$minute - self$origin$minute[1]) * 60 +
cap$second - self$origin$second) / CFt$units$seconds[self$unit], 6)
}
cap
},
#' @description Decompose a vector of offsets, in units of the calendar, to
#' their timestamp values. This adds a specified amount of time to the
#' origin of a `CFTime` object.
#'
#' This method may introduce inaccuracies where the calendar unit is
#' "months" or "years", due to the ambiguous definition of these units.
#' @param offsets Vector of numeric offsets to add to the origin of the
#' calendar.
#' @return A `data.frame` with columns for the timestamp elements and as
#' many rows as there are offsets.
offsets2time = function(offsets = NULL) {
if(is.null(offsets) || (len <- length(offsets)) == 0L)
return(data.frame(year = integer(), month = integer(), day = integer(),
hour = integer(), minute = integer(), second = numeric(),
tz = character(), offset = numeric()))
if (self$unit <= 4L) { # Days, hours, minutes, seconds
# First add time: convert to seconds first, then recompute time parts
secs <- offsets * CFt$units$seconds[self$unit] +
self$origin$hour * 3600 + self$origin$minute * 60 + self$origin$second
days <- secs %/% 86400L # overflow days
secs <- round(secs %% 86400L, 3L) # drop overflow days from time, round down to milli-seconds to avoid errors
# Time elements for output
hrs <- secs %/% 3600L
mins <- (secs %% 3600L) %/% 60L
secs <- secs %% 60L
# Now add days using the calendar
out <- if (any(days != 0L))
self$offset2date(days)
else
data.frame(year = rep(self$origin$year, len),
month = rep(self$origin$month, len),
day = rep(self$origin$day, len))
# Put it all back together again
out$hour <- hrs
out$minute <- mins
out$second <- secs
out$tz <- rep(self$timezone, len)
} else { # Months, years
out <- self$origin[rep(1L, len), ]
if (self$unit == 5L) { # Offsets are months
months <- out$month + offsets - 1L
out$month <- months %% 12L + 1L
out$year <- out$year + months %/% 12L
} else { # Offsets are years
out$year <- out$year + offsets
}
}
out$offset <- offsets
out
}
),
active = list(
#' @field origin_date (read-only) Character string with the date of the
#' calendar.
origin_date = function(value) {
if (missing(value)) {
sprintf("%04d-%02d-%02d", self$origin$year, self$origin$month, self$origin$day)
}
},
#' @field origin_time (read-only) Character string with the time of the
#' calendar.
origin_time = function(value) {
if (missing(value)) {
.format_time(self$origin)
}
},
#' @field timezone (read-only) Character string with the time zone of the
#' origin of the calendar.
timezone = function(value) {
if (missing(value))
self$origin$tz
}
)
)
Try the CFtime package in your browser
Any scripts or data that you put into this service are public.
CFtime documentation built on April 12, 2025, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @import R6
NULL
#' @title Basic CF calendar
#'
#' @description This class represents a basic CF calendar. It should not be
#' instantiated directly; instead, use one of the descendant classes.
#'
#' This internal class stores the information to represent date and time
#' values using the CF conventions. An instance is created by the exported
#' [CFTime] class, which also exposes the relevant properties of this class.
#'
#' The following calendars are supported:
#'
#' \itemize{
#' \item [`gregorian\standard`][CFCalendarStandard], the international standard calendar for civil use.
#' \item [`proleptic_gregorian`][CFCalendarProleptic], the standard calendar but extending before 1582-10-15
#' when the Gregorian calendar was adopted.
#' \item [`tai`][CFCalendarTAI], International Atomic Time clock with dates expressed using the Gregorian calendar.
#' \item [`utc`][CFCalendarUTC], Coordinated Universal Time clock with dates expressed using the Gregorian calendar.
#' \item [`julian`][CFCalendarJulian], every fourth year is a leap year (so including the years 1700, 1800, 1900, 2100, etc).
#' \item [`noleap\365_day`][CFCalendar365], all years have 365 days.
#' \item [`all_leap\366_day`][CFCalendar366], all years have 366 days.
#' \item [`360_day`][CFCalendar360], all years have 360 days, divided over 12 months of 30 days.
#' }
#' @references
#' https://cfconventions.org/Data/cf-conventions/cf-conventions-1.12/cf-conventions.html#calendar
#' @docType class
CFCalendar <- R6::R6Class("CFCalendar",
public = list(
#' @field name Descriptive name of the calendar, as per the CF Metadata
#' Conventions.
name = "",
#' @field definition The string that defines the units and the origin, as
#' per the CF Metadata Conventions.
definition = "",
#' @field unit The numeric id of the unit of the calendar.
unit = -1L,
#' @field origin `data.frame` with fields for the origin of the calendar.
origin = data.frame(),
#' @description Create a new CF calendar.
#' @param nm The name of the calendar. This must follow the CF Metadata
#' Conventions.
#' @param definition The string that defines the units and the origin, as
#' per the CF Metadata Conventions.
initialize = function(nm, definition) {
stopifnot(length(definition) == 1L, length(nm) == 1L)
self$name <- tolower(nm)
self$definition <- definition
parts <- strsplit(definition, " ")[[1L]]
if ((length(parts) < 3L) || !(tolower(parts[2L]) %in% c("since", "after", "from", "ref", "per")))
stop("Definition string does not appear to be a CF-compliant time coordinate description", call. = FALSE)
u <- which(CFt$CFunits$unit == tolower(parts[1L]))
if (length(u) == 0L) stop("Unsupported unit: ", parts[1L], call. = FALSE)
self$unit <- CFt$CFunits$id[u]
dt <- self$parse(paste(parts[3L:length(parts)], collapse = " "))
if (is.na(dt$year[1L]))
stop("Definition string does not appear to be a CF-compliant time coordinate description: invalid base date specification", call. = FALSE)
self$origin <- dt
},
#' @description Print information about the calendar to the console.
#' @param ... Ignored.
#' @return `self`, invisibly.
print = function(...) {
tz <- self$timezone
if (tz == "+0000") tz <- ""
cat("CF calendar:",
"\n Origin : ", self$origin_date, "T", self$origin_time, tz,
"\n Units : ", CFt$units$name[self$unit],
"\n Type : ", self$name, "\n",
sep = "")
invisible(self)
},
#' @description Indicate which of the supplied dates are valid.
#' @param ymd `data.frame` with dates parsed into their parts in columns
#' `year`, `month` and `day`. Any other columns are disregarded.
#' @return `NULL`. A warning will be generated to the effect that a
#' descendant class should be used for this method.
valid_days = function(ymd) {
warning("Use a descendant class from `CFCalendar` to call this method.", call. = FALSE) # nocov
NULL # nocov
},
#' @description Add a day to the supplied dates.
#' @param ymd `data.frame` with dates parsed into their parts in columns
#' `year`, `month` and `day`. Any other columns are disregarded.
#' @return A `data.frame` like argument `ymd` but with a day added for every
#' row.
add_day = function(ymd) {
md <- self$month_days(ymd)
ifelse(ymd$day < md,
ymd$day <- ymd$day + 1L,
{
ymd$day <- 1L
ifelse(ymd$month < 12L,
ymd$month <- ymd$month + 1L,
{
ymd$month <- 1L
ymd$year <- ymd$year + 1L
}
)
}
)
ymd
},
#' @description Indicate if the time series described using this calendar
#' can be safely converted to a standard date-time type (`POSIXct`,
#' `POSIXlt`, `Date`).
#'
#' Only the 'standard' calendar and the 'proleptic_gregorian' calendar
#' when all dates in the time series are more recent than 1582-10-15
#' (inclusive) can be safely converted, so this method returns `FALSE` by
#' default to cover the majority of cases.
#' @param offsets The offsets from the CFtime instance.
#' @return `FALSE` by default.
POSIX_compatible = function(offsets) {
FALSE
},
#' @description This method tests if the `CFCalendar` instance in argument
#' `cal` is compatible with `self`, meaning that they are of the same
#' class and have the same unit. Calendars "standard", and "gregorian" are
#' compatible, as are the pairs of "365_day" and "no_leap", and "366_day"
#' and "all_leap".
#' @param cal Instance of a descendant of the `CFCalendar` class.
#' @return `TRUE` if the instance in argument `cal` is compatible with
#' `self`, `FALSE` otherwise.
is_compatible = function(cal) {
self$unit == cal$unit && class(self)[1L] == class(cal)[1L]
},
#' @description This method tests if the `CFCalendar` instance in argument
#' `cal` is equivalent to `self`, meaning that they are of the same class,
#' have the same unit, and equivalent origins. Calendars "standard", and
#' "gregorian" are equivalent, as are the pairs of "365_day" and
#' "no_leap", and "366_day" and "all_leap".
#'
#' Note that the origins need not be identical, but their parsed values
#' have to be. "2000-01" is parsed the same as "2000-01-01 00:00:00", for
#' instance.
#' @param cal Instance of a descendant of the `CFCalendar` class.
#' @return `TRUE` if the instance in argument `cal` is equivalent to
#' `self`, `FALSE` otherwise.
is_equivalent = function(cal) {
sum(self$origin[1L,1L:6L] == cal$origin[1L,1L:6L]) == 6L && # Offset column is NA
self$is_compatible(cal)
},
#' @description Parsing a vector of date-time character strings into parts.
#' @param d character. A character vector of date-times.
#' @return A `data.frame` with columns year, month, day, hour, minute,
#' second, time zone, and offset. Invalid input data will appear as `NA`.
parse = function(d) {
# Parsers
# UDUNITS broken timestamp definition, with some changes
# broken_timestamp {broken_date}({space|T}+{broken_clock})? -- T not in definition but present in lexer code
# broken_date {year}-{month}(-{day})?
# year [+-]?[0-9]{1,4}
# month 0?[1-9]|1[0-2]
# day 0?[1-9]|[1-2][0-9]|30|31
# broken_clock {hour}:{minute}(:{second})?
# hour [0-1]?[0-9]|2[0-3] -- sign on hour not allowed, but see timezone
# minute [0-5]?[0-9]
# second {minute}? -- leap second not supported
# fractional part (\.[0-9]*)?
# timezone [+-]?{hour}(:{minute})? -- added, present in lexer code
broken <- paste0(
"^", # anchor string at start
"([+-]?[0-9]{1,4})", # year, with optional sign
"-(0?[1-9]|1[012])", # month
"(?:-(0?[1-9]|[12][0-9]|3[01]))?", # day, optional
"(?:[T ]", # if a time is following, separate with a single whitespace character or a "T"
"([01]?[0-9]|2[0-3])", # hour
":([0-5]?[0-9])", # minute
"(?::([0-5]?[0-9]))?", # second, optional
"(?:\\.([0-9]*))?", # optional fractional part of the smallest specified unit
")?", # close optional time capture group
"(?:\\s", # if a time zone offset is following, separate with a single whitespace character
"([+-])?([01]?[0-9]|2[0-3])", # tz hour, with optional sign
"(?::(00|15|30|45))?", # optional tz minute, only 4 possible values
")?", # close optional timezone capture group
"$" # anchor string at end
)
iso8601 <- paste0(
"^",
"([0-9]{4})",
"-(0[1-9]|1[012])",
"-(0[1-9]|[12][0-9]|3[01])?",
"(?:",
"[T ]([01][0-9]|2[0-3])",
"(?::([0-5][0-9]))?",
"(?::([0-5][0-9]))?",
"(?:[\\.,]([0-9]*))?",
")?",
"(?:([Z+-])([01][0-9]|2[0-3])?(?::(00|15|30|45))?", ## FIXME: Z?, smaller number of captures
")?$"
)
# UDUNITS packed timestamp definition - NOT YET USED
# packed_timestamp {packed_date}({space|T}+{packed_clock})? -- T and space only allowed in packed time follows
# packed_date {year}({month}{day}?)? -- must be YYYYMMDD or else format is ambiguous, as per lexer code
# packed_clock {hour}({minute}{second}?)? -- must be HHMMSS to be unambiguous
# timezone [+-]?{hour}({minute})? -- added, present in lexer code, must be HHMM
# packed <- stringi::stri_join(
# "^", # anchor string at start
# "([+-]?[0-9]{4})", # year, with optional sign
# "(0[1-9]|1[012])?", # month, optional
# "(0[1-9]|[12][0-9]|3[01])?", # day, optional
# "(?:[T,\\s]", # if a time is following, separate with a single whitespace character or a "T"
# "([01][0-9]|2[0-3])?", # hour
# "([0-5][0-9])?", # minute, optional
# "([0-5]?[0-9](?:\\.[0-9]*)?)?", # second, optional, with optional fractional part
# ")?", # close optional time capture group
# "(?:\\s", # if a time zone offset is following, separate with a single whitespace character
# "([+-]?[01][0-9]|2[0-3])?", # hour, with optional sign
# "(00|15|30|45)?", # minute, only 4 possible values
# ")?", # close optional timezone capture group
# "$" # anchor string at end
# )
parse <- data.frame(year = integer(), month = integer(), day = integer(),
hour = integer(), minute = integer(), second = numeric(), frac = character(),
tz_sign = character(), tz_hour = character(), tz_min = character())
# Drop "UTC", if given
d <- trimws(gsub("UTC$", "", d))
cap <- utils::strcapture(iso8601, d, parse)
missing <- which(is.na(cap$year))
if (length(missing) > 0L)
cap[missing,] <- utils::strcapture(broken, d[missing], parse)
# Assign any fraction to the appropriate time part
cap$frac[is.na(cap$frac)] <- "0"
frac <- as.numeric(paste0("0.", cap$frac))
if (sum(frac) > 0) {
ndx <- which(!(is.na(cap$second)) & frac > 0)
if (length(ndx) > 0L) cap$second[ndx] <- cap$second[ndx] + frac[ndx]
ndx <- which(!(is.na(cap$minute)) & is.na(cap$second) & frac > 0)
if (length(ndx) > 0L) cap$second[ndx] <- 60L * frac[ndx]
ndx <- which(!(is.na(cap$hour)) & is.na(cap$minute) & frac > 0)
if (length(ndx) > 0L) {
secs <- 3600 * frac
cap$minute[ndx] <- secs[ndx] %/% 60
cap$second[ndx] <- secs[ndx] %% 60
}
}
cap$frac <- NULL
# Convert NA time parts to 0 - in CF default time is 00:00:00 when not specified
cap$hour[is.na(cap$hour)] <- 0L
cap$minute[is.na(cap$minute)] <- 0L
cap$second[is.na(cap$second)] <- 0L
# Set timezone to default value where needed
ndx <- which(cap$tz_sign == "Z")
if (length(ndx) > 0L) {
cap$tz_sign[ndx] <- "+"
cap$tz_hour[ndx] <- "00"
cap$tz_min[ndx] <- "00"
}
cap$tz <- paste0(ifelse(cap$tz_sign == "", "+", cap$tz_sign),
ifelse(cap$tz_hour == "", "00", cap$tz_hour),
ifelse(cap$tz_min == "", "00", cap$tz_min))
cap$tz <- ifelse(cap$tz =="NANANA", "+0000", cap$tz)
cap$tz_sign <- cap$tz_hour <- cap$tz_min <- NULL
# Set optional date parts to 1 if not specified
cap$month[is.na(cap$month)] <- 1L
cap$day[is.na(cap$day)] <- 1L
# Check date validity
invalid <- !self$valid_days(cap)
invalid[is.na(invalid)] <- TRUE
if (sum(invalid) > 0L) cap[invalid,] <- rep(NA, 7)
# Calculate offsets
if (nrow(self$origin) == 0L) { # if there's no origin yet, don't calculate offsets
cap$offset <- rep(0, nrow(cap)) # this happens, f.i., when a CFCalendar is created
} else {
days <- self$date2offset(cap)
cap$offset <- round((days * 86400 + (cap$hour - self$origin$hour[1]) * 3600 +
(cap$minute - self$origin$minute[1]) * 60 +
cap$second - self$origin$second) / CFt$units$seconds[self$unit], 6)
}
cap
},
#' @description Decompose a vector of offsets, in units of the calendar, to
#' their timestamp values. This adds a specified amount of time to the
#' origin of a `CFTime` object.
#'
#' This method may introduce inaccuracies where the calendar unit is
#' "months" or "years", due to the ambiguous definition of these units.
#' @param offsets Vector of numeric offsets to add to the origin of the
#' calendar.
#' @return A `data.frame` with columns for the timestamp elements and as
#' many rows as there are offsets.
offsets2time = function(offsets = NULL) {
if(is.null(offsets) || (len <- length(offsets)) == 0L)
return(data.frame(year = integer(), month = integer(), day = integer(),
hour = integer(), minute = integer(), second = numeric(),
tz = character(), offset = numeric()))
if (self$unit <= 4L) { # Days, hours, minutes, seconds
# First add time: convert to seconds first, then recompute time parts
secs <- offsets * CFt$units$seconds[self$unit] +
self$origin$hour * 3600 + self$origin$minute * 60 + self$origin$second
days <- secs %/% 86400L # overflow days
secs <- round(secs %% 86400L, 3L) # drop overflow days from time, round down to milli-seconds to avoid errors
# Time elements for output
hrs <- secs %/% 3600L
mins <- (secs %% 3600L) %/% 60L
secs <- secs %% 60L
# Now add days using the calendar
out <- if (any(days != 0L))
self$offset2date(days)
else
data.frame(year = rep(self$origin$year, len),
month = rep(self$origin$month, len),
day = rep(self$origin$day, len))
# Put it all back together again
out$hour <- hrs
out$minute <- mins
out$second <- secs
out$tz <- rep(self$timezone, len)
} else { # Months, years
out <- self$origin[rep(1L, len), ]
if (self$unit == 5L) { # Offsets are months
months <- out$month + offsets - 1L
out$month <- months %% 12L + 1L
out$year <- out$year + months %/% 12L
} else { # Offsets are years
out$year <- out$year + offsets
}
}
out$offset <- offsets
out
}
),
active = list(
#' @field origin_date (read-only) Character string with the date of the
#' calendar.
origin_date = function(value) {
if (missing(value)) {
sprintf("%04d-%02d-%02d", self$origin$year, self$origin$month, self$origin$day)
}
},
#' @field origin_time (read-only) Character string with the time of the
#' calendar.
origin_time = function(value) {
if (missing(value)) {
.format_time(self$origin)
}
},
#' @field timezone (read-only) Character string with the time zone of the
#' origin of the calendar.
timezone = function(value) {
if (missing(value))
self$origin$tz
}
)
)
Try the CFtime package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.