R/rows_to_names.R

In gershomtripp/gttoolkit: Gershom Tripp's Toolkit

#' Flexibly use row values as column names
#'
#' Use a vector of integers, corresponding to row numbers, to use row values as
#' column names. This is similar to janitor::row_to_names, except that it
#' allows more flexibility in how the row values are handled, e.g. the number
#' of rows to be included, preprocessing of row values, etc.
#'
#' @param .data any "square" data, i.e. data frames and matrices.
#' @param name_fn a function to be applied to each collection of rows.
#' @param ... additional arguments to be passed to name_fn.
#' @param row_nums an integer or vector of integers corresponding to rows.
#' @param sep a string used to separate combined rows.
#' @param drop_rows a logical indicating if header rows should be dropped.
#' @param merge_current a logical indicating if new headers should be merged with existing headers.
#'
#' @return An object of the same type as .data.
#' @export
#'
#' @examples
#' # Example data.
#' df <- as.data.frame(list(c("h11x", "h12y", "1"), c("h21x", "h22y", "2")))
#'
#' # The first row is used as column names by default.
#' rows_to_names(df)
#'
#' # Choose more rows using an integer vector.
#' rows_to_names(df, row_nums = 1:2)
#'
#' # Set merge_current to TRUE to include existing column names. The following
#' # leads to the same results as above.
#' rows_to_names(rows_to_names(df), merge_current = TRUE)
#'
#' # Use name_fn to process row values before they are combined.
#' rows_to_names(
#'     df,
#'     name_fn = sub,
#'     pattern = "x|y",
#'     replacement = "",
#'     row_nums = 1:2
#' )
rows_to_names <-
    function(.data,
             name_fn = NULL,
             ...,
             row_nums = 1,
             sep = "<<=>>",
             drop_rows = TRUE,
             merge_current = FALSE) {
        if (!is.numeric(row_nums)) {
            stop("row_nums must be an integer or a vector of integers.")
        }

        names_vec <- sapply(.data[row_nums,], function(x) {
            x <- if (is.function(name_fn)) {name_fn(x, ...)} else {x}
            paste(x, collapse = sep)
        })

        if (isTRUE(merge_current)) {
            colnames(.data) <- paste(names(.data), names_vec, sep = sep)
        } else {
            colnames(.data) <- names_vec
        }

        if (isTRUE(drop_rows)) {
            .data[-(row_nums),]
        } else {
            .data
        }
    }