wrap_frame.R

#' Wrap a frame across multiple columns
#'
#' https://stackoverflow.com/a/52669757/3358272
#' @param x `data.frame`
#' @param nr,nc `integer`; specify only one of these, the number of
#'   rows or columns to be fixed
#' @param rownames if `NULL` (default), row names (if found) are
#'   discarded; if `character`, then a column is added (on the left of
#'   `x`) with this as its title
#' @param byrow `logical`; if `FALSE`, the first column will match the
#'   first `nr` rows of `x`; if `TRUE`, then the first `nc` rows of
#'   `x` will be in the first row; see Examples
#' @param sep `character`; used for the column names, where the
#'   resulting column names will be the original column name appended
#'   with this string and the n-th column-set; see Examples
#' @param unique_names `logical`; if `TRUE` (default), then the names
#'   are all "legal" column names in R; if `FALSE`, then the names do
#'   not ensure uniqueness and are therefore more pleasing
#'   aesthetically but more difficult to use in follow-on R functions
#' @return `data.frame`
#' @export
#' @md
#' @examples
#' \dontrun{
#' mt <- mtcars[1:3]
#' wrap_frame(mt, nr = 10)
#' wrap_frame(mt, nc = 7)
#' wrap_frame(mt, nc = 7, byrow = TRUE)
#' wrap_frame(mt, nc = 3, unique_names = FALSE, rownames = "")
#' }
wrap_frame <- function(x, nr, nc, rownames = NULL, byrow = FALSE, sep = "_", unique_names = TRUE) {
  if (!xor(missing(nr), missing(nc))) stop("specify exactly one of 'nr' or 'nc'")
  has_rownames <- isTRUE(is.character(attr(x, "row.names")))
  if (is.null(rownames)) {
    if (missing(rownames) && has_rownames) warning("wrap_frame: row names discarded", call. = FALSE)
  } else {
    x <- cbind.data.frame(list(row.names(x)), x)
    colnames(x)[1] <- rownames
  }
  if (missing(nr)) {
    nr <- ceiling(nrow(x) / nc)
    ind <- c(rep(seq_len(nc), times = nrow(x) %/% nc),
             head(seq_len(nc), n = nrow(x) %% nc))
  } else {
    nc <- ceiling(nrow(x) / nr)
    ind <- c(rep(seq_len(nrow(x) %/% nr), times = nr),
             rep(nc, nrow(x) %% nr))
  }
  if (!byrow) ind <- sort(ind)
  lst <- split(x, ind)
  lst <- lapply(lst, lapply, `length<-`, nrow(lst[[1]]))
  cnames <-
    if (unique_names) {
      paste(rep(colnames(x), times = nc), rep(seq_len(nc), each = ncol(x)), sep = sep)
    } else {
      rep(colnames(x), times = nc)
    }
  out <- do.call("cbind.data.frame", lst)
  colnames(out) <- cnames
  out
}