R/c2p_nest.R

In mintyr: Grouped and Nested Data Pipelines Built on 'data.table'

# WARNING - Generated by {fusen} from dev/flat_reshape.Rmd: do not edit by hand # nolint: line_length_linter.

#' Column to Pair Nested Transformation
#'
#' @description
#' Generates combinations of specified columns and creates a nested data
#' structure based on these pairs. Each nested subset renames the combined
#' columns to \code{value1}, \code{value2}, ... (up to \code{pairs_n}) to
#' support uniform iterative analyses such as genetic correlation estimation.
#'
#' @param data A data.frame or data.table to be transformed.
#' @param cols A character vector of column names or a numeric vector of
#'   column indices to be combined into pairs. Must not overlap with \code{by}.
#'   Duplicated entries are removed with a warning.
#' @param by A character vector of column names or a numeric vector of column
#'   indices to group by. Default is \code{NULL}.
#' @param pairs_n A positive integer >= 2 indicating the size of each column
#'   combination (e.g., 2 for pairwise). Default is \code{2}.
#' @param sep A single character string used as a separator when constructing
#'   the \code{pairs} identifier column. Default is \code{"-"}.
#' @param out_type A character string specifying the class of each nested
#'   object: \code{"dt"} (data.table, default) or \code{"df"} (data.frame).
#'
#' @details
#' The columns specified in \code{cols} are renamed to \code{value1},
#' \code{value2}, ... within each nested subset. The original column names are
#' preserved in the \code{pairs} column (e.g., \code{"Sepal.Length-Sepal.Width"}),
#' ensuring full traceability for downstream iterative analyses such as genetic
#' correlation estimation.
#'
#' Columns that belong to neither \code{cols} nor \code{by} (referred to
#' internally as "extra columns") are retained inside the nested subsets so
#' that covariates or ID fields remain accessible. Grouping columns (\code{by})
#' are \emph{not} duplicated inside the nested data because they are already
#' present as outer key columns in the returned table.
#'
#' When the number of requested combinations exceeds 500 a message is emitted;
#' above 5000 a warning is raised, as memory usage grows linearly with the
#' combination count.
#'
#' The names \code{value1}, \code{value2}, ..., \code{pairs} and
#' \code{data} are reserved: \code{data} must not contain other columns
#' with these names. The input object is never modified.
#'
#' @return A \code{data.table} with columns:
#' \describe{
#'   \item{pairs}{Character. The column-combination identifier, e.g.
#'     \code{"Sepal.Length-Sepal.Width"}.}
#'   \item{...}{Any \code{by} grouping columns, one per variable.}
#'   \item{data}{List-column. Each cell holds a data.table (or data.frame when
#'     \code{out_type = "df"}) containing \code{value1}, \code{value2}, ...,
#'     plus any extra columns that were neither in \code{cols} nor
#'     \code{by}.}
#' }
#'
#' @seealso \code{\link[utils]{combn}} for the underlying combination generator.
#'
#' @import data.table
#' @importFrom utils combn
#' @export
#' @examples
#' # Example data preparation: Define column names for combination
#' col_names <- c("Sepal.Length", "Sepal.Width", "Petal.Length")
#'
#' # Example 1: Basic column-to-pairs nesting with custom separator
#' c2p_nest(
#'   iris,                   # Input iris dataset
#'   cols = col_names,       # Columns to be combined as pairs
#'   pairs_n = 2,            # Create pairs of 2 columns
#'   sep = "&"               # Custom separator for pair names
#' )
#' # Returns a nested data.table where:
#' # - pairs: combined column names (e.g., "Sepal.Length&Sepal.Width")
#' # - data: list column containing data.tables with value1, value2 columns
#'
#' # Example 2: Column-to-pairs nesting with numeric indices and grouping
#' c2p_nest(
#'   iris,                   # Input iris dataset
#'   cols = 1:3,             # First 3 columns to be combined
#'   pairs_n = 2,            # Create pairs of 2 columns
#'   by = 5                  # Group by 5th column (Species)
#' )
#' # Returns a nested data.table where:
#' # - pairs: combined column names
#' # - Species: grouping variable
#' # - data: list column containing data.tables grouped by Species
c2p_nest <- function(data,
                     cols,
                     by       = NULL,
                     pairs_n  = 2L,
                     sep      = "-",
                     out_type = "dt") {
  pairs <- NULL

  # -- 1. Validate inputs -----------------------------------------------------
  if (!is.data.frame(data))
    stop("`data` must be a data.table or data.frame.", call. = FALSE)
  # Read-only use below, so a data.table input needs no copy.
  dt <- if (data.table::is.data.table(data)) data else data.table::as.data.table(data)

  cols <- .resolve_cols(cols, names(dt), "cols")   # also de-duplicates
  by        <- .resolve_cols(by, names(dt), "by", allow_null = TRUE)

  overlap <- intersect(cols, by)
  if (length(overlap) > 0L)
    stop("Column(s) appear in both `cols` and `by`: ",
         paste(overlap, collapse = ", "), call. = FALSE)

  pairs_n <- .check_count(pairs_n, "pairs_n", 2L)
  if (pairs_n > length(cols))
    stop(sprintf("`pairs_n` (%d) cannot exceed the number of `cols` columns (%d).",
                 pairs_n, length(cols)), call. = FALSE)
  if (!is.character(sep) || length(sep) != 1L || is.na(sep))
    stop("`sep` must be a single character string.", call. = FALSE)
  .check_choice(out_type, c("dt", "df"), "out_type")

  extra_cols  <- setdiff(names(dt), c(cols, by))
  value_names <- paste0("value", seq_len(pairs_n))

  # Reserved names would collide with the renamed / generated columns.
  clash <- c(intersect(extra_cols, value_names),
             intersect(c(by, extra_cols), c("pairs", "data")))
  if (length(clash) > 0L)
    stop("`data` contains column(s) whose names are reserved by c2p_nest(): ",
         paste(unique(clash), collapse = ", "), ". Please rename them first.",
         call. = FALSE)

  # -- 2. Combination count guard ---------------------------------------------
  n_combs <- choose(length(cols), pairs_n)
  if (n_combs > 5000) {
    warning(sprintf(paste0("%.0f combinations requested. Memory usage will be high - ",
                           "consider reducing `cols` or `pairs_n`."), n_combs),
            call. = FALSE)
  } else if (n_combs > 500) {
    message(sprintf("Note: generating %.0f combinations - this may take a moment.",
                    n_combs))
  }

  # -- 3. One nested table per combination ------------------------------------
  comb_list <- utils::combn(cols, pairs_n, simplify = FALSE)

  nested_list <- lapply(comb_list, function(comb) {
    # Column selection with `with = FALSE` already returns a new table, so
    # renaming it never touches `dt`; no extra copy() is needed.
    dt_sub <- dt[, c(by, extra_cols, comb), with = FALSE]
    data.table::setnames(dt_sub, comb, value_names)
    res <- .nest_by_group(dt_sub, group_by = by,
                          sd_cols = setdiff(names(dt_sub), by),
                          out_type = out_type)
    res[, pairs := paste(comb, collapse = sep)]
    res
  })

  # -- 4. Combine; order: pairs, by..., data ----------------------------------
  result <- data.table::rbindlist(nested_list, use.names = TRUE)
  data.table::setcolorder(result, c("pairs", by, "data"))
  result[]
}