####################
# UTS_MATRIX class #
####################
#' Unevenly-spaced Time Series Matrix
#'
#' Create a matrix of unevenly spaced time series (\code{"uts_matrix"}).
#'
#' If there are too few elements in data to fill the matrix, then the elements in data are recycled. However, compared to \code{\link{matrix}} in base \R, this function makes fewer guesses about how to coerce and recycle the data, and instead throws an error.
#'
#' Class \code{"uts_matrix"} inherits from class \code{"uts_vector"}. Hence, a \code{"uts_matrix"} supports all of the methods of a \code{"uts_vector"}, such as \code{\link{first}}, \code{\link{last}}, \code{\link{start}}, \code{\link{end}}, etc., even though no such methods exist specifically for a \code{"uts_matrix"}.
#'
#' @note An abstract class \code{"uts_virtual"} exists from which \code{"uts"}, \code{"uts_vector"}, and \code{"uts_matrix"} inherit: it is used to allow operations such as subtraction to mix the classes.
#'
#' @return An object of class \code{"uts_matrix"}.
#' @param data a \code{\link{uts}}, or a \code{\link{uts_vector}} containing at least one time series.
#' @param nrow the desired number of rows.
#' @param ncol the desired number of columns.
#' @param byrow logical. If \code{FALSE} (the default) the matrix is filled by columns, otherwise the matrix is filled by rows.
#' @param dimnames a \code{\link{dimnames}} attribute for the matrix: \code{NULL} or a \code{list} of length 2 giving the row and column names respectively.
#'
#' @keywords ts classes
#' @examples
#' # Create using a single "uts" with recycling
#' uts_matrix(ex_uts(), 2, 3)
#'
#' # Create using "uts_vector" with recycling
#' uts_matrix(ex_uts_vector(), 2, 3)
#' uts_matrix(ex_uts_vector(), 2, 2, byrow=TRUE)
#' uts_matrix(ex_uts_vector(), ncol=2)
#'
#' # Empty "uts_matrix"
#' uts_matrix(nrow=2, ncol=3, dimnames=list(c("a", "b"), c("X", "Y", "Z")))
#'
#' # One of the dimensions is of length zero
#' uts_matrix(nrow=0, ncol=4)
#' uts_matrix(nrow=4, ncol=0)
#' uts_matrix(nrow=0)
#'
#' # The first test returns TRUE, the others return FALSE
#' is.uts_matrix(uts_matrix())
#' is.uts_matrix(uts_vector())
#' is.uts_matrix(ex_uts())
uts_matrix <- function(data=uts(), nrow=1, ncol=1, byrow=FALSE, dimnames=NULL)
{
# Argument checking
if (is.na(nrow) || nrow < 0 || is.infinite(nrow))
stop("Invalid 'nrow' value")
if (is.na(ncol) || ncol < 0 || is.infinite(ncol))
stop("Invalid 'ncol' value")
# Special case of zero rows and/or columns
if (nrow == 0 || ncol == 0) {
# Return 0x0 matrix, if the other dimension has not been provided
if (missing(nrow) || missing(ncol))
nrow <- ncol <- 0
out <- list()
dim(out) <- c(nrow, ncol)
dimnames(out) <- dimnames
class(out) <- c("uts_matrix", class(uts_vector()))
return(out)
}
# Determine number of time series to work with
if (is.uts(data))
num_ts <- 1
else if (is.uts_vector(data))
num_ts <- length(data)
else
stop("The 'data' for a 'uts_matrix' needs to be a 'uts' or 'uts_vector'")
# Check that nrow/ncol value compatible with the number of time series
if (!missing(nrow) && (nrow > 1) && ((nrow * ncol) %% num_ts > 0) && (num_ts %% (nrow * ncol) > 0))
stop("'data' length not a multiple or sub-multiple of the number of rows")
if (!missing(ncol) && (ncol > 1) && ((nrow * ncol) %% num_ts > 0) && (num_ts %% (nrow * ncol) > 0))
stop("'data' length not a multiple or sub-multiple of the number of columns")
# In case not provided, guess nrows and ncols
if (missing(nrow) && (num_ts >= ncol))
nrow <- num_ts / ncol
else if (missing(ncol) && (num_ts >= nrow))
ncol <- num_ts / nrow
if (num_ts > nrow * ncol)
stop("'data' too long to fit into 'uts_matrix' of provided dimensions")
# Recycle data
if (is.uts(data)) {
out <- rep(data, nrow * ncol)
} else if (is.uts_vector(data)) {
if (byrow)
out <- rep(data, each = (nrow * ncol) %/% num_ts)
else
out <- rep(data, times = (nrow * ncol) %/% num_ts)
}
# Assign attributes
class(out) <- c("uts_matrix", class(uts_vector()))
dim(out) <- c(nrow, ncol)
dimnames(out) <- dimnames
out
}
#' @rdname uts_matrix
#'
#' @description \code{is.uts_matrix} returns \code{TRUE} if its argument is a \code{"uts_matrix"} object.
#'
#' @param x an \R object.
#'
#' @keywords internal
is.uts_matrix <- function(x)
{
inherits(x, "uts_matrix")
}
#' Coerce to a Data Frame
#'
#' Flatten a \code{\link{uts_matrix}} to a \code{\link{data.frame}}.
#'
#' @note Only time series with atomic observation values can be coerced to a \code{data.frame}.
#' @note This method is helpful for saving a multivariate time series to a human-readable text file.
#'
#' @param x a \code{"uts_matrix"} object.
#' @param method either \code{"long"} or \code{"wide"}, determining the shape of the output:
#' \itemize{
#' \item \code{"long"}: a \code{data.frame} with one row for each observation for each time series in \code{x}. The \code{data.frame} has four columns denoting the source of each observation (i.e. from which row and column of \code{x} is the observation from?), the observation time, and the observation value.
#' \item \code{"wide"}: a \code{data.frame} with one column for each time series in \code{x}.
#' }
#' @param \dots further arguments passed to or from methods.
#'
#' @seealso The \code{\link{uts_matrix_long}} and \code{\link{uts_matrix_wide}} constructors provide the opposite functionality, i.e. they convert data in \emph{long} and \emph{wide} format, respectively, to a \code{uts_matrix}.
#' @examples
#' as.data.frame(ex_uts_matrix())
#' as.data.frame(ex_uts_matrix(), method="long")
as.data.frame.uts_matrix <- function(x, ..., method="wide")
{
if (method == "wide") {
as.data.frame(as.uts_vector(x), method="wide")
} else if (method == "long") {
# Call uts_vector method
out <- NextMethod()
# Extract row and columns names
rnames <- rownames(x)
if (is.null(rnames))
rnames <- seq_len(nrow(x))
cnames <- colnames(x)
if (is.null(cnames))
cnames <- seq_len(ncol(x))
# Insert names to indentify rows and columns of observations
row_pos <- ((out$name - 1) %% nrow(x)) + 1
col_pos <- (out$name - row_pos) / ncol(x) + 1
data.frame(row=rnames[row_pos], column=cnames[col_pos], out[,-1])
} else
stop("Unknown 'method'")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.