series.R
# TIME SERIES
#' @include AllGenerics.R
NULL
# array ========================================================================
#' @export
#' @rdname series
#' @aliases series,array,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "array", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
## Validation
arkhe::assert_length(time, NROW(object))
## Set the names of the series
if (!is.null(names))
dimnames(object)[[2L]] <- names
if (is.null(dimnames(object)[[2L]]))
dimnames(object)[[2L]] <- paste0("S", seq_len(dim(object)[2L]))
## Chronological order
i <- order(time, decreasing = FALSE)
time <- time[i]
object <- object[i, , , drop = FALSE]
.TimeSeries(object, .Time = time)
}
)
#' @export
#' @rdname series
#' @aliases series,array,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "array", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
if (methods::is(time, "RataDie")) {
msg <- "%s is already expressed in rata die: %s is ignored."
warning(sprintf(msg, sQuote("time"), sQuote("calendar")), call. = FALSE)
} else {
time <- fixed(time, calendar = calendar, scale = scale)
}
methods::callGeneric(object = object, time = time, names = names)
}
)
# matrix =======================================================================
#' @export
#' @rdname series
#' @aliases series,matrix,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "matrix", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
x <- array(object, dim = c(dim(object), 1))
rownames(x) <- rownames(object)
colnames(x) <- colnames(object)
methods::callGeneric(object = x, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,matrix,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "matrix", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
x <- array(object, dim = c(dim(object), 1))
colnames(x) <- colnames(object)
methods::callGeneric(object = x, time = time, names = names)
}
)
# numeric ======================================================================
#' @export
#' @rdname series
#' @aliases series,numeric,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "numeric", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
object <- array(data = object, dim = c(length(object), 1, 1))
methods::callGeneric(object = object, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,numeric,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "numeric", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
object <- array(data = object, dim = c(length(object), 1, 1))
methods::callGeneric(object = object, time = time, names = names)
}
)
# data.frame ===================================================================
#' @export
#' @rdname series
#' @aliases series,data.frame,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "data.frame", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
object <- data.matrix(object)
methods::callGeneric(object = object, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,data.frame,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "data.frame", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
object <- data.matrix(object)
methods::callGeneric(object = object, time = time, names = names)
}
)