R/ten_reshape_back.R

In KOFM: Test the Kronecker Product Structure in Tensor Factor Models

#' Tensor reshape reversal
#'
#' @description Performing reversed tensor reshape on a given tensor.
#' @param ten An array representing a tensor.
#' @param AA A vector representing mode indices to reshape along back.
#' @param original.dim A vector representing the dimension of the original tensor before reshape.
#' @param time.mode Logical. TRUE if mode-1 of the input tensor is the time mode and hence not involved in reshape; otherwise reshape is on the entire input tensor. Default is TRUE.
#'
#' @return An array representing a tensor.
#' @export
#' @import tensorMiss
#'
#' @examples
#' ten_reshape_back(array(1:24, dim=c(2,12)), c(2,3), c(2,3,4), FALSE);
#'
#'
ten_reshape_back <- function(ten, AA, original.dim, time.mode = TRUE){
  if (requireNamespace(c('stats'), quietly = TRUE)){

    AA <- unique(AA)
    ten_K <- length(dim(ten))
    if (time.mode){
      if (ten_K<2){
        message("Parameter `ten` should be at least a vector time series, i.e. the length of dimension of 'ten' should be at least 2.")
        return()
      }
    } else {
      if (ten_K<1){
        message("Parameter `ten` should be at least a vector, i.e. the length of dimension of 'ten' should be at least 1.")
        return()
      }
    }

    if (time.mode){ AA <- AA+1 }
    AA <- sort(AA)

    if (length(AA)==1){
      # if (time.mode){
      #   if (AA==2){ dim_original <- c(dim(ten)[ten_K], dim(ten)[-ten_K])
      #   } else { dim_original <- c(dim(ten)[1:(AA-1)], dim(ten)[ten_K], dim(ten)[-c(1:(AA-1),ten_K)]) }
      # } else {
      #   if (AA==1){ dim_original <- c(dim(ten)[ten_K], dim(ten)[-ten_K])
      #   } else { dim_original <- c(dim(ten)[1:(AA-1)], dim(ten)[ten_K], dim(ten)[-c(1:(AA-1),ten_K)]) }
      # }
      # return( tensorMiss::refold(tensorMiss::unfold(ten, ten_K), AA, dim_original ) )
      return( tensorMiss::refold(tensorMiss::unfold(ten, ten_K), AA, original.dim ) )
    } else if (length(AA)==2) {
      mat_1 <- tensorMiss::unfold(ten, ten_K)
      mat_2 <- matrix(0, nrow = original.dim[AA[2]], ncol = prod(original.dim[-AA[2]]) )
      for (i in 1:nrow(mat_2)){
        mat_2[i,] <- c(tensorMiss::unfold( tensorMiss::refold(
          matrix(mat_1[ (1+ (i-1)*(original.dim[AA[1]])): (i*(original.dim[AA[1]])),], ncol=ncol(mat_1)),
          AA[1], original.dim[-AA[2]]) ,1) )
      }
      return( tensorMiss::refold(mat_2, AA[2], original.dim) )
    } else if (length(AA)>=3){
      if (time.mode){
        return( ten_reshape_back(ten_reshape_back(ten, c(AA[1], ten_K+1)-1,
                                                  c(original.dim[-AA[-1]], prod(original.dim[AA[-1]])), time.mode),
                                 AA[-1]-1, original.dim, time.mode) )
      } else {
        return( ten_reshape_back(ten_reshape_back(ten, c(AA[1], ten_K+1),
                                                  c(original.dim[-AA[-1]], prod(original.dim[AA[-1]])), time.mode),
                                 AA[-1], original.dim, time.mode) )
      }
    }

  }
}