###################################
# Constructor and basic functions #
###################################
#' Unevenly-spaced Time Series
#'
#' Create an unevenly spaced time series (\code{"uts"}) object from a vector of observation values and a vector of observation times of matching length.
#'
#' As shown in an example below, it is possible to store arbitrary \R objects in a \code{"uts"} object. However, many time series methods work only when the observation values are of a certain class or type. For example, arithmetic methods require the observation values to be \code{\link{numeric}} (i.e. double or integer), \code{\link{logical}}, or \code{\link{complex}}; plotting only works for \code{\link{numeric}} and \code{\link{logical}} values; while \code{\link{as.data.frame.uts}} requires \code{\link{atomic}} observation values.
#'
#' @note An abstract class \code{"uts_virtual"} exists from which \code{"uts"}, \code{"uts_vector"}, and \code{"uts_matrix"}, inherit (see package \code{utsMultivariate} for the latter three classes): it is used to allow operations such as subtraction to mix the classes.
#'
#' @return An object of class \code{"uts"}.
#' @param values a vector of observation values.
#' @param times a vector of strictly increasing observation times. Must be a \code{\link{POSIXct}} object or be coercible using \code{\link{as.POSIXct}}. Observation times cannot be \code{NA}.
#'
#' @keywords ts classes
#' @examples
#' # Create a numeric "uts"
#' dts <- c("2007-11-08", "2007-11-08", "2007-11-08", "2007-11-09", "2007-11-09", "2007-11-09")
#' tms <- c("7:00:00", "8:01:00", "13:15:00", "7:30:00", "8:51:00", "15:15:00")
#' uts(values=c(48.375, 48.5, 48.375, 47, 47.5, 47.35), times=paste(dts, tms))
#'
#' # Store arbitrary R objects in a "uts"
#' uts(list(1:5, c("a", "B")), c("2007-11-08 1:01:00", "2007-11-09 15:16:00"))
#'
#' # Create an empty "uts"
#' uts()
#'
#' # All of the following are TRUE
#' is.uts(ex_uts())
#' is.uts_virtual(ex_uts())
uts <- function(values=numeric(), times=as.POSIXct(character()))
{
# Argument checking
if (length(values) != length(times))
stop("The number of observation values and observation times does not match")
if (!is.POSIXct("POSIXct"))
times <- as.POSIXct(times)
if (anyNA(times))
stop("Observation times cannot be NA")
if (is.unsorted(times, strictly=TRUE))
stop("The observation times need to be a strictly increasing")
# Creat "uts" object
x <- list(values=values, times=times)
class(x) <- c("uts", "uts_virtual")
x
}
#' @rdname uts
#'
#' @description \code{is.uts} returns \code{TRUE} if its argument is a \code{"uts"} object.
#'
#' @keywords internal
#' @param x an \R object.
is.uts <- function(x)
{
inherits(x, "uts")
}
#' @rdname uts
#'
#' @keywords internal
#' @description \code{is.uts_virtual} returns \code{TRUE} if its argument is a \code{"uts_virtual"} object.
is.uts_virtual <- function(x)
{
inherits(x, "uts_virtual")
}
#' Internal Structure of uts
#'
#' Compactly display the internal structure of a \code{"uts"} object.
#'
#' @note
#' This methods only exists because the default implementation of \code{\link{str}} in base \R produces an error message.
#'
#' @param object a \code{"uts"} object.
#' @param \dots further arguments passed to or from methods.
#'
#' @keywords internal
#' @examples
#' str(ex_uts())
#' str(ex_uts2())
str.uts <- function(object, ...)
{
str(unclass(object), ...)
}
#' Print Observation Times and Values
#'
#' Print the observation time and values in one of two different formats.
#'
#' @param x a time series object.
#' @param style the printing style. Either \code{"horizontal"} (the default), "vertical" or "plain" (which first prints the data and then the index).
#' @param \dots further arguments passed to or from methods.
#'
#' @seealso \code{\link{print}} in base \R
#' @examples
#' print(ex_uts())
#' print(ex_uts(), style="vertical")
#' print(ex_uts(), style="plain")
#' uts()
print.uts <- function (x, style="horizontal", ...)
{
# Special case of zero length
if (length(x) == 0L) {
cat("uts(0)\n")
return(invisible(x))
}
style <- match.arg(style, c("horizontal", "vertical", "plain"))
if (style == "vertical") {
out <- as.matrix(x$values)
rownames(out) <- as.character(x$times)
colnames(out) <- "values"
print(out, ...)
} else if (style == "horizontal") {
out <- x$values
names(out) <- x$times
print(out, ...)
} else
print.default(x, ...)
invisible(x)
}
#' Merge two or more uts
#'
#' Merge two or more \code{"uts"} into a single time series. For observation times that show up in more than one time series, the observation value of the first \code{"uts"} in the argument list with such observation time is used.
#'
#' @param x,y \code{"uts"} objects.
#' @param tolerance tolerance for numerical noise in observation times.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' merge(ex_uts(), ex_uts())
#' merge(ex_uts(), ex_uts2())
#' merge(ex_uts2(), ex_uts())
#' merge(uts(), ex_uts())
merge.uts <- function(x, y, tolerance=.Machine$double.eps ^ 0.5, ...)
{
# Determine the union of observation times
utsv <- c(list(x, y), list(...))
all_times <- x$times
for (j in 2:length(utsv))
all_times <- sorted_union(all_times, utsv[[j]]$times, tolerance=tolerance)
attributes(all_times) <- attributes(x$times)
# Merge observation values, with priority determined by the order of arguments
values <- numeric(length(all_times))
for (j in length(utsv):1) {
uts <- utsv[[j]]
pos <- num_leq_sorted(uts$times, all_times, tolerance=tolerance)
values[pos] <- uts$values
}
# Return single merged "uts"
uts(values, all_times)
}
#' Time Window
#'
#' Extract a subperiod time series between times \code{start} and \code{end}.
#'
#' @param x a \code{"uts"} object.
#' @param start,end \code{\link{POSIXct}} objects or coercible using \code{\link{as.POSIXct}}. The start and end times, respectively, of the period of interest.
#' @param \dots further arguments passed to or from methods.
#'
#' @seealso \code{\link{head}}, \code{\link{head_t}}, \code{\link{tail}}, \code{\link{tail_t}} for other methods that extract a subperiod time series.
#' @examples
#' window(ex_uts(), start="2007-11-09")
#' window(ex_uts(), start="2007-11-08", end="2007-11-09")
#' window(ex_uts(), start=as.POSIXct("2007-11-09", tz="America/New_York"))
#' window(ex_uts(), start=as.POSIXct("2007-11-09", tz="Australia/Sydney"))
window.uts <- function(x, start=NULL, end=NULL, ...)
{
if (is.null(start))
start <- start(x)
if (is.null(end))
end <- end(x)
# Argument checking
if (length(x) == 0L)
return(x)
if (!is.POSIXct(start))
start <- as.POSIXct(start)
if (!is.POSIXct(end))
end <- as.POSIXct(end)
# Determine observations in [start, end] window
start_pos <- sum(x$times < start) + 1
end_pos <- sum(x$times <= end)
if (start_pos <= end_pos)
used_pos <- start_pos:end_pos
else
used_pos <- c()
# Drop observations outside window
x$values <- x$values[used_pos]
x$times <- x$times[used_pos]
x
}
#' Coerce to a Data Frame
#'
#' Flatten a \code{"uts"} to a two-column \code{data.frame}, with the observation times in first column and observation values in the second column. The column names are \code{"time"} and \code{"value"}.
#'
#' @note Only time series with atomic observation values can be coerced to a \code{data.frame}.
#' @note This method is helpful for saving a time series to a human-readable text file.
#'
#' @param x a \code{"uts"} object.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' as.data.frame(ex_uts())
#'
#' # Save a time series to a text file with nice date formatting
#' uts1 <- uts(rnorm(10), Sys.time() + days(1:10))
#' data <- as.data.frame(uts1)
#' data$time <- format(data$time, format="%Y-%m-%d")
#' \dontrun{write.csv(data, file="random.csv", row.names=FALSE, quote=FALSE)}
as.data.frame.uts <- function(x, ...)
{
# Argument checking
if (!is.atomic(x$values))
stop("Only time series with atomic observation values can be coerced to a data.frame")
# Flatten the data
if (length(x) == 0L)
values <- numeric()
else
values <- x$values
data.frame(time=x$times, value=values, stringsAsFactors=FALSE)
}
#' Observation Times
#'
#' Get the observation times.
#'
#' @note The observation times of a \code{"uts"} object \code{x} can also be accessed using \code{x$times}. However, using \code{time(x)} relies on the internal object representation.
#'
#' @return A \code{\link{POSIXct}} object.
#' @param x a \code{"uts"} object with \code{\link{logical}} observation values.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' time(ex_uts())
#' identical(time(ex_uts()), ex_uts()$times) # TRUE
time.uts <- function(x, ...)
{
x$times
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.