R/export_xlsx.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 Data to XLSX Files
#'
#' @description
#' The natural complement to \code{import_xlsx()}.  Accepts either a combined
#' \code{data.frame} (as produced by \code{import_xlsx()} with
#' \code{combine = TRUE}) **or a list of data.frames**, and writes the result
#' to disk.
#'
#' The output \strong{destination} is controlled by a single \code{path}
#' argument -- there are no separate modes to choose:
#'
#' \itemize{
#'   \item \strong{\code{path} ends in \code{.xlsx}} -- write
#'         \emph{everything into a single workbook}: one sheet per list
#'         element, or (for \code{data.frame} input) one sheet per
#'         \code{file_col} / \code{sheet_col} value.
#'   \item \strong{\code{path} is anything else} -- treat it as a
#'         \emph{directory} and write \emph{one \code{.xlsx} file per list
#'         element} or per \code{file_col} value.  For \code{data.frame}
#'         input that also has a \code{sheet_col} column, each file contains
#'         one sheet per \code{sheet_col} value, which reproduces the
#'         original file/sheet layout read by \code{import_xlsx()}.
#' }
#'
#' \subsection{List input}{
#'   \preformatted{res <- list(res1 = data1, res2 = data2, res3 = data3)
#'
#'   # Directory mode -- writes res1.xlsx, res2.xlsx, res3.xlsx
#'   export_xlsx(res, path = "output/")
#'
#'   # Single-file mode -- one workbook with sheets res1, res2, res3
#'   export_xlsx(res, path = "output/all.xlsx")}
#'
#'   Each element must be a \code{data.frame}, \code{data.table}, or
#'   \code{tibble}; types may be mixed and column sets may differ.  Missing
#'   names are filled in as \code{Sheet1}, \code{Sheet2}, ...; supplied names
#'   must be unique.
#' }
#'
#' @param data       A \code{data.frame} / \code{data.table} / \code{tibble},
#'                   \strong{or} a list of such objects.  For list input,
#'                   names become file names (directory mode) or sheet names
#'                   (single-file mode).
#' @param path       \code{character(1)}.  Output destination.  A path ending
#'                   in \code{.xlsx} (case-insensitive) is a
#'                   \strong{single workbook}; anything else is an
#'                   \strong{output directory}.  Missing directories are
#'                   created recursively.
#' @param file_col   \code{character(1)}.  Column identifying the source file
#'                   (\code{data.frame} input only).  Default
#'                   \code{"excel_name"}.
#' @param sheet_col  \code{character(1)}.  Column identifying the source sheet
#'                   (\code{data.frame} input only).  Default
#'                   \code{"sheet_name"}.
#' @param sheet_name \code{character(1)}.  Sheet name used when a
#'                   \code{data.frame} has neither tracking column.
#'                   Default \code{"Sheet1"}.
#' @param drop_cols  \code{logical(1)}.  If \code{TRUE} (default), the
#'                   tracking columns are removed from the exported sheets
#'                   (\code{data.frame} input only).
#' @param overwrite  \code{logical(1)}.  Allow overwriting existing files.
#'                   When \code{FALSE}, all targets are checked
#'                   \emph{before} anything is written, so a failure never
#'                   leaves a partial export behind.  Default \code{TRUE}.
#' @param verbose    \code{logical(1)}.  Print a message for every file and
#'                   sheet written.  Default \code{FALSE}.
#'
#' @details
#' \subsection{Why \pkg{writexl}?}{
#'   \pkg{writexl} writes \code{.xlsx} via a minimal C library with no Java or
#'   Perl dependency.  It is fast and produces small files, at the cost of no
#'   cell formatting, formulas, or styles.  For those, use \pkg{openxlsx2}.
#' }
#' \subsection{Name sanitisation}{
#'   Sheet names are limited to 31 characters, may not contain
#'   \code{[ ] * ? / \\ :}, and may not start or end with an apostrophe.
#'   File names have characters that are invalid on Windows replaced by
#'   \code{_}.  If sanitising or truncating makes two names collide
#'   (Excel compares sheet names case-insensitively), suffixes such as
#'   \code{_2}, \code{_3} are appended.
#' }
#' \subsection{Missing group values}{
#'   Rows with \code{NA} in \code{file_col} or \code{sheet_col} are not
#'   dropped: they are exported under the label \code{"NA"} and a warning
#'   is issued.
#' }
#' \subsection{Directory vs. file dispatch}{
#'   \code{path} is classified purely by its extension.  To use a directory
#'   whose name ends in \code{.xlsx}, append a trailing slash.
#' }
#'
#' @return Invisibly, a named \code{character} vector of written file paths.
#'   In directory mode it is named by list element / \code{file_col} value;
#'   in single-workbook mode it is named by \code{path}.
#'
#' @importFrom writexl write_xlsx
#' @export
#' @examples
#' # Example 1: A plain data.frame -> one workbook, one sheet
#' out_file <- file.path(tempdir(), "mtcars.xlsx")
#' export_xlsx(mtcars, path = out_file, sheet_name = "mtcars")
#' invisible(file.remove(out_file))
#'
#' # Example 2: data.table input works exactly the same way
#' out_file <- file.path(tempdir(), "mtcars_dt.xlsx")
#' export_xlsx(data.table::as.data.table(mtcars),
#'             path = out_file, sheet_name = "mtcars")
#' invisible(file.remove(out_file))
#'
#' # Example 3: One sheet per group in a single workbook
#' # Each Species value becomes a sheet; keep the Species column
#' out_file <- file.path(tempdir(), "iris_by_species.xlsx")
#' export_xlsx(iris, path = out_file, file_col = "Species", drop_cols = FALSE)
#' invisible(file.remove(out_file))
#'
#' # Example 4: One file per group (directory mode: no .xlsx extension)
#' out_dir <- file.path(tempdir(), "iris_by_species")
#' out_files <- export_xlsx(iris, path = out_dir, file_col = "Species")
#' basename(out_files)
#' unlink(out_dir, recursive = TRUE)
#'
#' # Example 5: Round-trip the layout produced by import_xlsx(combine = TRUE)
#' # Rows are routed back to their original file and sheet
#' combined <- data.frame(
#'   excel_name = c("sales", "sales", "costs"),
#'   sheet_name = c("2024",  "2025",  "2024"),
#'   amount     = c(100, 120, 80)
#' )
#' out_dir <- file.path(tempdir(), "roundtrip")
#' out_files <- export_xlsx(combined, path = out_dir)   # sales.xlsx, costs.xlsx
#' basename(out_files)
#' unlink(out_dir, recursive = TRUE)
#'
#' # Example 6: Named list -> single workbook, one sheet per element
#' out_file <- file.path(tempdir(), "combined.xlsx")
#' res <- list(res1 = iris, res2 = mtcars)
#' export_xlsx(res, path = out_file)
#' invisible(file.remove(out_file))
#'
#' # Example 7: Named list -> directory, one file per element
#' out_dir <- file.path(tempdir(), "combined")
#' out_files <- export_xlsx(res, path = out_dir)        # res1.xlsx, res2.xlsx
#' basename(out_files)
#' unlink(out_dir, recursive = TRUE)
export_xlsx <- function(data,
                        path,
                        file_col   = "excel_name",
                        sheet_col  = "sheet_name",
                        sheet_name = "Sheet1",
                        drop_cols  = TRUE,
                        overwrite  = TRUE,
                        verbose    = FALSE) {

  # -- 1. Argument validation --------------------------------------------------

  .check_string <- function(x, arg) {
    if (!is.character(x) || length(x) != 1L || is.na(x) || !nzchar(x))
      stop(sprintf("`%s` must be a single non-empty character string.", arg),
           call. = FALSE)
  }
  .check_flag <- function(x, arg) {
    if (!is.logical(x) || length(x) != 1L || is.na(x))
      stop(sprintf("`%s` must be a single TRUE or FALSE.", arg), call. = FALSE)
  }

  .check_string(path,       "path")
  .check_string(file_col,   "file_col")
  .check_string(sheet_col,  "sheet_col")
  .check_string(sheet_name, "sheet_name")
  .check_flag(drop_cols, "drop_cols")
  .check_flag(overwrite, "overwrite")
  .check_flag(verbose,   "verbose")

  if (identical(file_col, sheet_col))
    stop("`file_col` and `sheet_col` must name different columns.",
         call. = FALSE)

  is_list_input <- is.list(data) && !is.data.frame(data)
  if (!is_list_input && !is.data.frame(data))
    stop("`data` must be a data.frame, data.table, tibble, or a list of these.",
         call. = FALSE)

  if (grepl("\\.(xls|xlsm|xlsb|csv|txt)$", path, ignore.case = TRUE))
    stop("`path` must end in .xlsx (single workbook) or be a directory; ",
         "export_xlsx() only writes .xlsx files.", call. = FALSE)
  to_single_file <- grepl("\\.xlsx$", path, ignore.case = TRUE)
  if (!to_single_file && file.exists(path) && !dir.exists(path))
    stop(sprintf("`path` (\"%s\") is an existing file, not a directory.", path),
         call. = FALSE)

  # -- 2. Helpers --------------------------------------------------------------

  # `.make_unique()` and `.safe_path_segment()` are package-level helpers
  # shared with export_nest() / export_list().

  # Vectorised: sanitise a set of sheet names that will share one workbook.
  .safe_sheet <- function(x) {
    x <- as.character(x)
    x[is.na(x)] <- "NA"
    x <- gsub("[][*?/\\\\:]", "_", x)
    x <- gsub("^'+|'+$", "", x)
    x <- substr(x, 1L, 31L)
    x[!nzchar(x)] <- "Sheet"
    .make_unique(x, 31L)
  }

  # Vectorised: sanitise a set of file names that will share one directory.
  .safe_file <- function(x) .make_unique(.safe_path_segment(x), 200L)

  # Check every target up front, then create any missing directories.
  .prepare_targets <- function(files) {
    if (!overwrite) {
      exists <- file.exists(files)
      if (any(exists))
        stop(sprintf("File(s) already exist (overwrite = FALSE):\n  %s",
                     paste(files[exists], collapse = "\n  ")), call. = FALSE)
    }
    dirs <- unique(dirname(files))
    for (d in dirs[!dir.exists(dirs)]) dir.create(d, recursive = TRUE)
  }

  .write <- function(sheet_list, file) {
    # Excel holds at most 1,048,576 rows per sheet (one is the header).
    too_big <- vapply(sheet_list, nrow, integer(1L)) > 1048575L
    if (any(too_big))
      stop(sprintf(paste0("Sheet(s) %s exceed Excel's limit of 1,048,575 data ",
                          "rows. Split the data (e.g. via `sheet_col`) or use ",
                          "a text format such as data.table::fwrite()."),
                   paste0("'", names(sheet_list)[too_big], "'", collapse = ", ")),
           call. = FALSE)
    writexl::write_xlsx(sheet_list, path = file)
    if (verbose) {
      message(sprintf("Saved: %s", file))
      for (nm in names(sheet_list))
        message(sprintf("  Sheet '%s': %d rows", nm, nrow(sheet_list[[nm]])))
    }
  }

  # -- 3a. List input ----------------------------------------------------------

  if (is_list_input) {
    if (length(data) == 0L)
      stop("`data` is an empty list -- nothing to export.", call. = FALSE)

    nms <- names(data)
    if (is.null(nms)) nms <- rep("", length(data))
    nms[is.na(nms)] <- ""

    # Fill missing names with Sheet1, Sheet2, ... skipping names already used.
    missing <- !nzchar(nms)
    if (any(missing)) {
      taken   <- nms[!missing]
      counter <- 0L
      for (i in which(missing)) {
        repeat {
          counter   <- counter + 1L
          candidate <- paste0("Sheet", counter)
          if (!candidate %in% taken) break
        }
        nms[[i]] <- candidate
        taken    <- c(taken, candidate)
      }
    }

    if (anyDuplicated(nms))
      stop("List names must be unique (they become file / sheet names).",
           call. = FALSE)

    not_df <- !vapply(data, is.data.frame, logical(1L))
    if (any(not_df))
      stop(sprintf(paste0("All list elements must be a data.frame, ",
                          "data.table, or tibble. Non-conforming: %s"),
                   paste(nms[not_df], collapse = ", ")), call. = FALSE)

    data <- lapply(data, as.data.frame)

    if (to_single_file) {
      names(data) <- .safe_sheet(nms)
      .prepare_targets(path)
      .write(data, path)
      return(invisible(stats::setNames(path, path)))
    }

    out_paths <- file.path(path, paste0(.safe_file(nms), ".xlsx"))
    .prepare_targets(out_paths)
    for (i in seq_along(data))
      .write(stats::setNames(data[i], .safe_sheet(nms[[i]])), out_paths[[i]])
    return(invisible(stats::setNames(out_paths, nms)))
  }

  # -- 3b. data.frame input ----------------------------------------------------

  df         <- as.data.frame(data)
  has_file   <- file_col  %in% names(df)
  has_sheet  <- sheet_col %in% names(df)
  track_cols <- c(if (has_file) file_col, if (has_sheet) sheet_col)

  # Group keys as character; NA rows are kept under the label "NA".
  .key <- function(col) {
    k <- as.character(df[[col]])
    if (anyNA(k)) {
      warning(sprintf(paste0("%d row(s) have NA in `%s`; they are exported ",
                             "under the label \"NA\"."),
                      sum(is.na(k)), col), call. = FALSE)
      k[is.na(k)] <- "NA"
    }
    k
  }
  file_key  <- if (has_file)  .key(file_col)
  sheet_key <- if (has_sheet) .key(sheet_col)

  out_df <- if (drop_cols && length(track_cols))
    df[, setdiff(names(df), track_cols), drop = FALSE]
  else
    df

  # Split row indices by key, preserving order of first appearance.
  .split_rows <- function(key) split(seq_along(key), factor(key, levels = unique(key)))

  # Build a named sheet list for the given rows, one sheet per label.
  .sheets_by <- function(rows, labels) {
    idx <- .split_rows(labels)
    out <- lapply(idx, function(j) out_df[rows[j], , drop = FALSE])
    names(out) <- .safe_sheet(names(idx))
    out
  }

  all_rows <- seq_len(nrow(df))
  fallback <- stats::setNames(list(out_df), .safe_sheet(sheet_name))

  ## (1) Single workbook
  if (to_single_file) {
    sheet_list <- if (has_file && has_sheet)
      .sheets_by(all_rows, paste(file_key, sheet_key, sep = "_"))
    else if (has_file)
      .sheets_by(all_rows, file_key)
    else if (has_sheet)
      .sheets_by(all_rows, sheet_key)
    else
      fallback
    if (!length(sheet_list)) sheet_list <- fallback   # zero-row input

    .prepare_targets(path)
    .write(sheet_list, path)
    return(invisible(stats::setNames(path, path)))
  }

  ## (2) Directory: one file per file_col value
  if (!has_file)
    stop(sprintf(paste0("`path` (\"%s\") is a directory, but `data` has no ",
                        "`%s` column to split files by.\n",
                        "  Pass a path ending in .xlsx to write a single ",
                        "workbook instead."),
                 path, file_col), call. = FALSE)

  file_groups <- .split_rows(file_key)
  if (!length(file_groups)) {
    warning("`data` has no rows -- nothing was written.", call. = FALSE)
    return(invisible(stats::setNames(character(0), character(0))))
  }

  out_paths <- file.path(path, paste0(.safe_file(names(file_groups)), ".xlsx"))
  .prepare_targets(out_paths)

  for (i in seq_along(file_groups)) {
    rows <- file_groups[[i]]
    sheet_list <- if (has_sheet)
      .sheets_by(rows, sheet_key[rows])
    else
      stats::setNames(list(out_df[rows, , drop = FALSE]),
                      .safe_sheet(names(file_groups)[[i]]))
    .write(sheet_list, out_paths[[i]])
  }

  invisible(stats::setNames(out_paths, names(file_groups)))
}