A trio of functions to grab square subsets of a square matrix

subsetmatrix.R

## create the logical matrices for subsetting
## x matrix to subset
## n number of rows or columns in each subset (by subset I mean a small square from the larger matrix)
select_matrix <- function(x, n){
  mod <- ncol(x) %% n
  if(mod != 0) stop("not a divisor")
  
  if(ncol(x) != nrow(x)) stop("not a square")
  
  ## numbers along one dimension
  row_seq <- seq_len(nrow(x))
  
  ## divide these numbers into equal groups of size n
  cuts <- cut(row_seq, breaks = n)
  vals <- levels(cuts)
  
  ## store output
  out <- vector(mode = "list")
  
  ## make these vectors into squares
  ## by combining all combinations
  for(i in vals){
    for(j in vals){
      logical_mat <- outer(cuts == i, cuts == j, `&`)
      combo <- paste0(i, "_", j)
      out[[combo]] <- logical_mat
    }
  }
  out  
}


## subset a matrix with a list of logical matrices
subset_matrix <- function(ss, x){
  final <- vector(mode = "list")
  names(final) <- names(ss) # give the names of the subscript list
  for( i in 1:length(ss)){
    selected_numbers <- ss[[i]]
    selected_ind <- which(selected_numbers, arr.ind = TRUE)
    final[[i]] <- x[selected_ind]
  }
  final
}

## apply some function to all the numbers in the same subset
calculation_subsets <- function(n, m, f){
  ss <- select_matrix(m, n)
  subsets <- subset_matrix(ss, m)
  vapply(subsets, FUN = f, FUN.VALUE = 1)
}  

## standard deviation of subsets up to 20
  m <- matrix(rpois(400, 47), 20)
  
  by20 <- lapply(c(2,4,5), function(x) calculation_subsets(x, m, sd))
  
  sapply(by20, mean)