#' Compute the temporal autocorrelation of a matrix
#'
#' This function computes the temporal autocorrelation of a given matrix using a specified window size and
#' optionally inverts the correlation matrix.
#'
#' @param X A numeric matrix for which to compute the temporal autocorrelation
#' @param window integer, the window size for computing the autocorrelation, must be between 1 and ncol(X) (default is 3)
#' @param inverse logical, whether to compute the inverse of the correlation matrix (default is FALSE)
#'
#' @return A sparse symmetric matrix representing the computed temporal autocorrelation
#'
#' @examples
#' # Create an example matrix
#' X <- matrix(rnorm(50), nrow = 10, ncol = 5)
#'
#' # Compute the temporal autocorrelation
#' result <- temporal_autocor(X, window = 2)
#'
#' @export
temporal_autocor <- function(X, window=3, inverse=FALSE) {
assertthat::assert_that(window > 1 && window < ncol(X))
cmat <- cor(X)
if (inverse) {
cmat <- corpcor::invcor.shrink(cmat)
}
rowmat <- matrix(rep(1:nrow(cmat), ncol(cmat)), nrow(cmat), ncol(cmat))
colmat <- matrix(rep(1:ncol(cmat), each=nrow(cmat)), nrow(cmat), ncol(cmat))
delta <- abs(rowmat - colmat)
cvals <- sapply(1:window, function(i) {
ind <- which(delta == i)
mean(cmat[ind])
})
bmat <- matrix(unlist(cvals), nrow(cmat), length(cvals), byrow=TRUE)
bLis <- as.data.frame(bmat)
A <- bandSparse(nrow(cmat), k = 1:window, diag = bLis, symmetric=TRUE)
A
#fill cmat as distance matrix()
}
#' Compute the temporal adjacency matrix of a time series
#'
#' This function computes the temporal adjacency matrix of a given time series using a specified weight mode,
#' sigma, and window size.
#'
#' @param time A numeric vector representing a time series
#' @param weight_mode Character, the mode for computing weights, either "heat" or "binary" (default is "heat")
#' @param sigma Numeric, the sigma parameter for the heat kernel (default is 1)
#' @param window Integer, the window size for computing adjacency (default is 2)
#'
#' @return A sparse symmetric matrix representing the computed temporal adjacency
#'
#' @examples
#' # Create an example time series
#' time <- 1:10
#'
#' # Compute the temporal adjacency matrix using the heat weight mode
#' result <- temporal_adjacency(time, weight_mode = "heat", sigma = 1, window = 2)
#'
#' @export
temporal_adjacency <- function(time, weight_mode = c("heat", "binary"), sigma=1, window=2) {
weight_mode <- match.arg(weight_mode)
len <- length(time)
wfun <- if (weight_mode == "binary") {
function(x) 1
} else if (weight_mode == "heat") {
function(x) heat_kernel(x, sigma)
} else {
stop()
}
f <- function(t) {
if (length(t) >= 1) {
h <- wfun(sqrt((t[1] - t)^2))
cbind(t[1], t, h)
} else {
NULL
}
}
m <- do.call(rbind, runner(time, f, k=window, lag=0, simplify=TRUE))
# m <- do.call(rbind, rollApply(time, window=window, function(t) {
# if (length(t) >= 1) {
# h <- wfun(sqrt((t[1] - t)^2))
# cbind(t[1], t, h)
# } else {
# NULL
# }
# }))
sm <- sparseMatrix(i=m[,1], j=m[,2], x=m[,3], dims=c(len, len))
sm <- (sm + t(sm))
diag(sm) <- 1
sm
}
#' Compute the temporal Laplacian matrix of a time series
#'
#' This function computes the temporal Laplacian matrix of a given time series using a specified weight mode,
#' sigma, and window size.
#'
#' @param time A numeric vector representing a time series
#' @param weight_mode Character, the mode for computing weights, either "heat" or "binary" (default is "heat")
#' @param sigma Numeric, the sigma parameter for the heat kernel (default is 1)
#' @param window Integer, the window size for computing adjacency (default is 2)
#'
#' @return A sparse symmetric matrix representing the computed temporal Laplacian
#'
#' @examples
#' # Create an example time series
#' time <- 1:10
#'
#' # Compute the temporal Laplacian matrix using the heat weight mode
#' result <- temporal_laplacian(time, weight_mode = "heat", sigma = 1, window = 2)
#'
#' @export
temporal_laplacian <- function(time, weight_mode = c("heat", "binary"), sigma=1, window=2) {
weight_mode <- match.arg(weight_mode)
adj <- temporal_adjacency(time, weight_mode, sigma, window)
Diagonal(x=rowSums(adj)) - adj
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.