R/chunks_of_n.R

In stRoke: Clinical Stroke Research

#' MOVED Split to chunks of size n
#'
#' @param d data. Can be vector or data frame.
#' @param n number of chunks
#' @param label naming prefix for chunk names
#' @param even boolean to set if size of chunks should be evenly distributed.
#' @param pattern regex pattern to extract names from provided vector. If data
#' frame, will assume first column is name.
#'
#' @return List of length n
#' @export
#'
#' @examples
#' tail(chunks_of_n(seq_len(100),7),3)
#' tail(chunks_of_n(seq_len(100),7,even=TRUE),3)
#' ds <- data.frame(nm=paste0("Sub",
#' add_padding(rownames(stRoke::talos))),stRoke::talos)
#' head(chunks_of_n(ds,7,pattern="Sub[0-9]{3}",label="grp"),2)
#' ## Please notice that no sorting is performed. This is on purpose to preserve
#' ## original sorting. If sorting is intended, try something like this:
#' ds[order(ds$nm),] |> chunks_of_n(7,pattern="Sub[0-9]{3}",label="grp") |> 
#' head(2)

chunks_of_n <- function(d,n,label=NULL, even=FALSE, pattern=NULL){
  
  if (!(is.vector(d) |
        is.data.frame(d)) |
      inherits(d,"list")) {
    stop("Provided data is not vector or data.frame.")
  }
  
  if (is.data.frame(d)) ns <- nrow(d) else ns <- length(d) 
  
  if (even) {
    g <- sort(rep_len(seq_len(ceiling(ns / n)), ns))
  } else {
    g <- ceiling(seq_len(ns) / n)
  }
  
  ls <- split(d, g)
  
  if (!is.null(pattern)) {
    if(is.data.frame(d)) {
      ns <- str_extract(d=d[[1]],pattern=pattern)
      } else ns <- str_extract(d=d,pattern=pattern)
    
    
    suffix <- do.call(c, lapply(split(ns, g), function(i) {
      paste0(i[[1]], "-", i[[length(i)]])
    }))
  } else suffix <- names(ls)
  
  if (is.character(label)){
    names(ls) <- paste0(label,"-",suffix)
    } else names(ls) <- suffix
  
  ls
}

#' Splits in n chunks
#'
#' @param d data
#' @param n number of chunks
#' @param ... arguments passed to internal `chunks_of_n()`
#'
#' @return List of chunks
#' @export
#'
#' @examples
#' lengths(n_chunks(d=seq_len(100),n=7,even=TRUE))
#' lengths(n_chunks(d=seq_len(100),n=7,even=FALSE))
n_chunks <- function(d,n,...){
  if (!(is.vector(d) |
        is.data.frame(d)) |
      inherits(d,"list")) {
    stop("Provided data is not vector or data.frame.")
  }
  
  if (is.data.frame(d)) ns <- nrow(d) else ns <- length(d) 
  
  nn <- ceiling(ns/n)
  
  chunks_of_n(d=d,n=nn,...)
}