R/export_list.R

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

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

#' Export a List of Data Frames with Hierarchical Directory Management
#'
#' @description
#' Exports every element of a named (or unnamed) \code{list} of \code{data.frame} /
#' \code{data.table} objects to \code{txt} or \code{csv} files.  Element names may
#' contain forward-slashes (\code{/}) to encode arbitrary subdirectory depth, e.g.
#' \code{"group_a/subject_01/results"} writes
#' \code{<path>/group_a/subject_01/results.txt}.
#' Unnamed elements are automatically labelled \code{split_<i>}.
#'
#' @param data        A non-empty \code{list} whose elements are \code{data.frame},
#'   \code{data.table}, or any object coercible via \code{data.table::as.data.table()}.
#' @param path        Single character string - the root export directory.
#'   Created recursively if absent. Defaults to \code{tempdir()}.
#' @param file_type   \code{"txt"} (tab-separated, default) or \code{"csv"}
#'   (comma-separated). Case-insensitive.
#' @param na          Single string written for missing values. Default \code{"NA"}.
#'   Use e.g. \code{"-9999"} for DMU.
#' @param quote       Passed to \code{\link[data.table]{fwrite}}. Default
#'   \code{FALSE}: with a non-empty \code{na}, \code{fwrite}'s \code{"auto"}
#'   would quote every header and character field, which command-line
#'   breeding programs (HIBLUP, DMU, ...) cannot parse. Use \code{"auto"} if
#'   values may contain the separator.
#' @param ...         Further arguments passed to \code{\link[data.table]{fwrite}}
#'   (e.g. \code{col.names = FALSE}).
#'
#' @return An invisible named \code{character} vector of the file paths
#'   written, with length equal to the number of successfully exported elements.
#'   The total count is accessible via \code{length()} on the return value.
#'
#' @details
#' **Performance design:**
#' \itemize{
#'   \item All element names are resolved and path components split in a single
#'     vectorised pass \emph{before} the write loop, so no string work occurs
#'     inside the hot path.
#'   \item Unique subdirectories are collected and created in one batch
#'     (\code{k} \code{dir.create()} syscalls, where \code{k} \eqn{\le} \code{n}).
#'   \item The field separator is resolved once at function entry.
#'   \item \code{as.data.table()} on an existing \code{data.table} is a
#'     reference-pass (no copy).
#' }
#'
#' **Name handling:** each \code{/}-separated component of an element name is
#' sanitised separately (invalid characters become \code{_}; \code{..} cannot
#' escape \code{path}). If two elements map to the same file
#' (compared case-insensitively), the function stops instead of overwriting.
#'
#' **Error handling:**
#' Individual element failures emit a \code{warning} and are skipped; the
#' remaining elements continue to be processed.
#'
#' @seealso \code{\link[data.table]{fwrite}}
#'
#' @importFrom data.table is.data.table as.data.table fwrite
#' @export
#' @examples
#' # Example: Export split data to files
#' out_dir <- file.path(tempdir(), "mintyr_export_list")
#'
#' # Step 1: Create split data structure
#' dt_split <- w2l_split(
#'   data = iris,              # Input iris dataset
#'   cols = 1:2,               # Columns to be split
#'   by = "Species"            # Grouping variable
#' )
#'
#' # Step 2: Export split data to files
#' files <- export_list(
#'   data = dt_split,          # Input list of data.tables
#'   path = out_dir
#' )
#' # Returns (invisibly) a named vector of the written file paths
#' files
#'
#' # Clean up
#' unlink(out_dir, recursive = TRUE)
export_list <- function(data,
                        path      = tempdir(),
                        file_type = "txt",
                        na        = "NA",
                        quote     = FALSE,
                        ...) {
  split_dt    <- data
  export_path <- path

  # -- 1. Validation (fail fast) ------------------------------------------------
  # A data.frame is a list too; without this check each column would be
  # written as a separate file.
  if (!is.list(split_dt) || is.data.frame(split_dt))
    stop("`data` must be a list of data.frame / data.table objects ",
         "(wrap a single table in list()).", call. = FALSE)
  if (length(split_dt) == 0L) {
    message("[ export_list ] `data` is empty - nothing to export.")
    return(invisible(character(0L)))
  }
  not_df <- !vapply(split_dt, is.data.frame, logical(1L))
  if (any(not_df))
    stop("All elements of `data` must be data.frames or data.tables. ",
         "Invalid element(s) at index: ", paste(which(not_df), collapse = ", "),
         call. = FALSE)
  if (!is.character(export_path) || length(export_path) != 1L || is.na(export_path))
    stop("`path` must be a single non-NA character string.", call. = FALSE)
  if (!is.character(na) || length(na) != 1L || is.na(na))
    stop("`na` must be a single character string, e.g. \"NA\" or \"-9999\".",
         call. = FALSE)
  file_type <- .check_choice(tolower(trimws(file_type)), c("txt", "csv"), "file_type")
  sep  <- if (file_type == "txt") "\t" else ","
  dots <- list(...)
  .check_fwrite_dots(dots, "export_list")

  # -- 2. Element names -> sanitised relative paths -----------------------------
  n         <- length(split_dt)
  raw_names <- names(split_dt)
  if (is.null(raw_names)) raw_names <- rep("", n)
  raw_names[is.na(raw_names)] <- ""
  elem_names <- ifelse(nzchar(raw_names), raw_names, paste0("split_", seq_len(n)))

  # "/" in a name encodes sub-directories; each component is sanitised on its
  # own, and empty components ("a//b", leading "/") are dropped.
  rel_paths <- vapply(strsplit(elem_names, "/", fixed = TRUE), function(p) {
    p <- p[nzchar(p)]
    if (length(p) == 0L) p <- "unnamed"
    paste(.safe_path_segment(p), collapse = "/")
  }, character(1L))
  full_paths <- file.path(export_path, paste0(rel_paths, ".", file_type))

  dup <- duplicated(tolower(full_paths))
  if (any(dup))
    stop("Several list elements map to the same output file and would ",
         "overwrite each other:\n  ",
         paste(utils::head(unique(full_paths[dup]), 5L), collapse = "\n  "),
         "\nMake the list names unique.", call. = FALSE)

  # -- 3. Directories (one call per unique directory) ---------------------------
  all_dirs <- unique(c(export_path, dirname(full_paths)))
  for (d in all_dirs) dir.create(d, showWarnings = FALSE, recursive = TRUE)
  not_created <- all_dirs[!dir.exists(all_dirs)]
  if (length(not_created) > 0L)
    stop("Could not create directory/directories:\n  ",
         paste(not_created, collapse = "\n  "), call. = FALSE)

  # -- 4. Write ---------------------------------------------------------------
  written <- rep(FALSE, n)
  for (i in seq_len(n)) {
    elem <- split_dt[[i]]
    if (nrow(elem) == 0L) next                         # nothing to write
    written[i] <- tryCatch({
      do.call(data.table::fwrite,
              c(list(x = elem, file = full_paths[i], sep = sep, na = na, quote = quote),
                dots))
      TRUE
    }, error = function(e) {
      warning(sprintf("[ export_list ] Failed to export element %d ('%s'): %s",
                      i, elem_names[i], conditionMessage(e)), call. = FALSE)
      FALSE
    })
  }

  out <- stats::setNames(full_paths[written], elem_names[written])
  message(sprintf("[ export_list ] Export complete. %d / %d file(s) written to: %s",
                  sum(written), n, export_path))
  invisible(out)
}