######################################################################
# Convert objects back and forth between other R time series classes #
######################################################################
#####################
# Coercion to "uts" #
#####################
#' Coercion to uts
#'
#' Convert univariate time series objects from other R packages to \code{"uts"} objects.
#'
#' @return An object of class \code{"uts"}.
#' @param x a time series object of appropriate type.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' # Convert a quarterly "ts"
#' ts1 <- ts(1:10, frequency = 4, start = c(1959, 2))
#' as.uts(ts1)
#'
#' # Convert a monthly "ts"
#' ts2 <- ts(1:10, frequency = 12, start = c(1959, 8))
#' as.uts(ts2)
#'
#' # Convert a yearly 'ts"
#' ts3 <- ts(1:10, frequency = 1, start = 1959)
#' as.uts(ts3)
#'
#' # Convert an "fts"
#' if (requireNamespace("fts", quietly = TRUE)) {
#' fts1 <- fts::fts(index=as.POSIXct("2016-01-01") + dhours(c(1, 4, 27)), data=c(5,4,7))
#' as.uts(fts1)
#' }
#'
#' # Convert an "irts"
#' if (requireNamespace("tseries", quietly = TRUE)) {
#' irts1 <- tseries::irts(as.POSIXct("2015-01-01") + days(c(1, 3, 7, 9)), 1:4)
#' as.uts(irts1)
#' }
#'
#' # Convert an "xts"
#' if (requireNamespace("xts", quietly = TRUE)) {
#' xts1 <- xts::xts(1:4, as.Date("2015-01-01") + c(1, 3, 7, 9))
#' as.uts(xts1)
#' }
#'
#' # Convert a "zoo"
#' if (requireNamespace("zoo", quietly = TRUE)) {
#' zoo1 <- zoo::zoo(1:4, as.Date("2015-01-01") + c(1, 3, 7, 9))
#' as.uts(zoo1)
#' }
#'
#' @seealso \code{as.uts_vector} (in package \code{utsMultivariate}) for converting multivariate time series.
as.uts <- function(x, ...) UseMethod("as.uts")
#' @describeIn as.uts convert a \code{\link{ts}} object
as.uts.ts <- function(x, ...)
{
# Require univariate time series
if (!is.null(ncol(x)) && (ncol(x) > 1))
stop("Only univariate 'ts' objects can be converted to a 'uts' object. Use as.uts_vector() in package utsMultivariate for multivariate time series")
# Extract values and times
times <- date_decimal(as.numeric(time(x)), tz="")
values <- as.numeric(x)
# Round times for monthly and quarterly frequency
freq <- tsp(x)[3]
if (freq %in% c(1, 4, 12))
times <- floor_date(times + days(5), unit="month")
uts(values, times)
}
#' @describeIn as.uts convert an \code{\link[fts]{fts}} object
as.uts.fts <- function(x, ...)
{
# Require univariate time series
if (!is.null(ncol(x)) && (ncol(x) > 1))
stop("Only univariate 'fts' objects can be converted to a 'uts' object. Use as.uts_vector() in package utsMultivariate for multivariate time series")
# The "fts" class inherits from "zoo"
as.uts.zoo(x, ...)
}
#' @describeIn as.uts convert an \code{\link[tseries]{irts}} object
as.uts.irts <- function(x, ...)
{
# Require univariate time series
if (!is.null(ncol(x)) && (ncol(x) > 1))
stop("Only univariate 'irts' objects can be converted to a 'uts' object. Use as.uts_vector() in package utsMultivariate for multivariate time series")
# Clean messed up class attributed of observations times
times <- x$time
class(times) <- class(as.POSIXct(character()))
uts(x$value, times)
}
#' @describeIn as.uts convert an \code{\link[xts]{xts}} object
as.uts.xts <- function(x, ...)
{
# Require univariate time series
if (!is.null(ncol(x)) && (ncol(x) > 1))
stop("Only univariate 'xts' objects can be converted to a 'uts' object. Use as.uts_vector() in package utsMultivariate for multivariate time series")
as.uts(zoo::as.zoo(x, ...))
}
#' @describeIn as.uts convert a \code{\link[zoo]{zoo}} object
as.uts.zoo <- function(x, ...)
{
# Require univariate time series
if (!is.null(ncol(x)) && (ncol(x) > 1))
stop("Only univariate 'zoo' objects can be converted to a 'uts' object. Use as.uts_vector() in package utsMultivariate for multivariate time series")
uts(as.numeric(x), as.POSIXct(as.character(attr(x, "index"))))
}
#######################
# Coercion from "uts" #
#######################
#' Coercion to zoo
#'
#' @return A \code{\link[zoo]{zoo}} object.
#' @param x a \code{"uts"} object with atomic observation values.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' if (requireNamespace("zoo", quietly = TRUE)) {
#' zoo::as.zoo(ex_uts())
#' }
as.zoo.uts <- function(x, ...)
{
if (!requireNamespace("zoo", quietly=TRUE))
stop("Package 'zoo' needed for this function to work")
if (!is.atomic(x$values))
stop("Only time series with atomic observation values can be coerced to a 'zoo' object")
zoo::zoo(x$values, x$times)
}
#' Coercion to xts
#'
#' @return An \code{\link[xts]{xts}} object.
#' @param x a \code{"uts"} object with atomic observation values.
#' @param \dots further arguments passed to or from methods.
#'
#' @examples
#' if (requireNamespace("xts", quietly = TRUE)) {
#' xts::as.xts(ex_uts())
#' }
as.xts.uts <- function(x, ...)
{
if (!requireNamespace("xts", quietly=TRUE))
stop("Package 'xts' needed for this function to work")
if (!is.atomic(x$values))
stop("Only time series with atomic observation values can be coerced to an 'xts' object")
xts::xts(x$values, x$times)
}
#' Coercion to fts
#'
#' @return An \code{\link[fts]{fts}} object.
#' @param x a \code{"uts"} object.
#'
#' @examples
#' if (requireNamespace("fts", quietly = TRUE)) {
#' fts::as.fts(ex_uts())
#' }
as.fts.uts <- function(x)
{
if (!requireNamespace("fts", quietly=TRUE))
stop("Package 'fts' needed for this function to work")
fts::fts(x$times, x$values)
}
#' Coercion to irts
#'
#' @return An \code{\link[tseries]{irts}} object.
#' @param x a \code{"uts"} object with atomic observation values.
#'
#' @examples
#' if (requireNamespace("tseries", quietly = TRUE)) {
#' tseries::as.irts(ex_uts())
#' }
as.irts.uts <- function(x)
{
if (!requireNamespace("tseries", quietly=TRUE))
stop("Package 'tseries' needed for this function to work")
if (!is.atomic(x$values))
stop("Only time series with atomic observation values can be coerced to an 'irts' object")
tseries::irts(x$times, x$values)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.