R/autogrouper.R

In yymmhaha/PackPaper1: Package related to my first paper

#' Automatic grouping function
#'
#' @description
#'
#' @param matr a matrix
#' @param lx a number
#'
#' @return a list of components
#' @export
#'
#' @examples
#' # later


autogrouper <- function(matr, lx){
  nx <- ncol(matr)  # number of covariates X, nx+1 is total number of groups
  non0x <- nx/lx    # number of non0 x for each lag

  W0 <- matrix(c(0), nrow = nx, ncol = 1)
  own_variables <- as.vector(c(0, seq(0, nx-1)), mode = 'integer')  # smallest index of each group.
  N_own_variables <- as.vector(c(0, rep(1, nx)), mode = 'integer')
  eta_g <- as.vector(c(rep(1, nx+1)), mode = 'double')
  ###### the above don't make any assumptions of the lags. it's always nx+1 groups

  # grouping structure
  # construct 5 lags directly, then take necessary lags
  # matrix size non0x*5+1: 1 for group1 (all singletons), 5 lags for all non0 x

  r1 <- rep(0, non0x*5 + 1)   # first row, always full 0
  blankvec <- rep(0, non0x)
  blank <- matrix(rep(0, non0x * non0x), ncol = non0x)
  block1 <- cbind(rep(1, non0x), t(blank %x% rep(1, 5)))
  block2 <- cbind(rep(0, non0x*4), diag(1, non0x*4), blank %x% rep(1, 4))

  big <- rbind(r1, block1, block2)  # dim: non0x*5 + 1

  # select necessary lags
  big.necessary <- big[(1:(non0x*lx+1)), (1:(non0x*lx+1))]  # equivalent to dim nx+1

  BigGroup <- matrix(as.vector(big.necessary, mode = 'logical'),
                     ncol = nx+1, byrow = FALSE)
  groups <- Matrix::Matrix(BigGroup, sparse = TRUE)    # this has been modified
  tree <- list('eta_g' = eta_g, 'groups' = groups, 'own_variables' = own_variables,
               'N_own_variables' = N_own_variables)

  return(list(tree = tree,
              nx = nx,
              non0x = non0x))   # for easier check
}