Merge origin/master into the charts branch

Brings in the constant_memory decision procedure (#135).

One conflict, in R/write_xlsx.R: both sides inserted at the same point in the
roxygen block, master adding the constant_memory and
constant_memory_threshold @PARAM entries and this branch adding
@family workbook settings.  Both are wanted, so both are kept, with the params
before the family tag as in every other file.

Checked rather than assumed: all 28 @family tags survive with their feature
groupings, none reverted to "writexl", and the merged files still carry the
constant_memory and allow_sheet work from master.

Author: billdenney

R/write_xlsx.R

@@ -28,12 +28,29 @@
 #'   \code{\link{xl_properties}(header_format = )}.
 #' @param use_zip64 use \href{https://en.wikipedia.org/wiki/Zip_(file_format)#ZIP64}{zip64}
 #' to enable support for 4GB+ xlsx files. Not all platforms can read this.
+#' @param constant_memory stream rows to disk instead of building the whole
+#'   workbook in memory. `NA` (the default) decides per workbook: on for large
+#'   data, off for small, and always off when a feature needs it off. `TRUE`
+#'   forces it on for a workbook that would otherwise be judged too small;
+#'   `FALSE` forces it off. Features that cannot be written while streaming ---
+#'   merged ranges, tables, embedded images and multi-cell array formulas ---
+#'   turn it off regardless, with a warning if `TRUE` was asked for, because
+#'   the alternative is a file that opens cleanly and is missing cells.
+#' @param constant_memory_threshold how much extra memory not streaming would
+#'   have to cost, in bytes, before streaming is worth it. Default 128 MiB.
+#'   The cost is *estimated* from the number of cells in the workbook, using a
+#'   fixed per-cell figure calibrated against a range of data; the true cost
+#'   varies with the data, and is lowest for text that repeats. Streaming saves
+#'   memory but produces slightly larger files, so it is not used for workbooks
+#'   small enough that the saving would not be noticed.
 #' @family workbook settings
 #' @examples # Roundtrip example with single excel sheet named 'mysheet'
 #' tmp <- write_xlsx(list(mysheet = iris))
 #' readxl::read_xlsx(tmp)
 write_xlsx <- function(x, path = tempfile(fileext = ".xlsx"), col_names = TRUE,
-                       format_headers = TRUE, use_zip64 = FALSE){
+                       format_headers = TRUE, use_zip64 = FALSE,
+                       constant_memory = NA,
+                       constant_memory_threshold = 128 * 1024^2){
   # Resolve the input to an xl_workbook.  A bare data frame / xl_sheet / list
   # is wrapped in a workbook with default properties; an explicit xl_workbook
   # overrides col_names/format_headers.
@@ -78,7 +95,8 @@ write_xlsx <- function(x, path = tempfile(fileext = ".xlsx"), col_names = TRUE,
   # Ordering matters to libxlsxwriter's drawing numbering, so this spans the
   # whole workbook rather than any one sheet
   .check_drawing_order(sheets, names(dfs))
-  cm <- .resolve_constant_memory(dfs, props, sheets)
+  cm <- .resolve_constant_memory(dfs, props, sheets, constant_memory,
+                                 constant_memory_threshold)
   ret <- .Call(C_write_data_frame_list, dfs, path, col_names, format_headers,
                use_zip64, reg$table, sheets, header_id,
                .properties_payload(props, cm$on))

R/xl_range.R

@@ -21,6 +21,18 @@
 #     or indexes columns of the sheet's data frame and `rows` gives 1-based
 #     *data* row indices (row 1 is the first data row, ignoring the header).
 #
+# Either spelling may name a sheet -- "Data!A1:B5", "'My Sheet'!A1:B5", or a
+# `sheet` element in the list form -- but almost nothing wants one.  An
+# autofilter, a merge, a validation, a conditional format, a table, an image
+# anchor and a print area all apply to the sheet they are on; a sheet name
+# there is a misunderstanding, not a refinement.  Only a chart series can
+# genuinely point at another sheet.
+#
+# So the sheet is *parsed* centrally and *allowed* selectively: callers opt in
+# with allow_sheet = TRUE, and everything else reports the mistake instead of
+# ignoring it.  Parsing it in one place keeps the quoting rules (and their
+# error messages) from being reinvented per feature.
+#
 # The header offset is applied here, so C never has to know whether a header
 # row was written.
 # -----------------------------------------------------------------------------
@@ -206,21 +218,64 @@
   .check_range_span(c(first_row, cols[1L] - 1L, last_row, cols[2L] - 1L), arg)
 }
 
+# Split a sheet qualifier off a range string.  Excel quotes a sheet name that
+# contains spaces or punctuation, and doubles an apostrophe inside it:
+#   Data!A1:B5      'My Sheet'!A1:B5      'It''s'!A1
+.split_sheet_ref <- function(x) {
+  if (startsWith(x, "'")) {
+    m <- regmatches(x, regexec("^'((?:[^']|'')*)'!(.*)$", x))[[1L]]
+    if (length(m) == 3L)
+      return(list(sheet = gsub("''", "'", m[2L], fixed = TRUE), rest = m[3L]))
+    return(list(sheet = NULL, rest = x))
+  }
+  i <- regexpr("!", x, fixed = TRUE)
+  if (i > 0L)
+    return(list(sheet = substr(x, 1L, i - 1L), rest = substring(x, i + 1L)))
+  list(sheet = NULL, rest = x)
+}
+
+# Reject a sheet qualifier where one cannot mean anything.
+.reject_sheet <- function(sheet, arg) {
+  if (is.null(sheet)) return(invisible(NULL))
+  stop(sprintf(paste0("`%s` may not name a sheet (got \"%s!\"): it applies to ",
+                      "the sheet it is on. Drop the sheet name."),
+               arg, sheet), call. = FALSE)
+}
+
 # Resolve any accepted range spelling to 0-based
 # c(first_row, first_col, last_row, last_col).
 #
 # `arg` names the calling argument in every error message.  `df` and
 # `header_offset` supply the sheet context needed by the data-frame-relative
 # and whole-column/whole-row forms.  `allow_cell = FALSE` rejects a bare cell
 # reference for arguments documented as taking a rectangle.
+# `allow_sheet = TRUE` accepts a sheet qualifier and returns it as the "sheet"
+# attribute of the quad; otherwise a sheet name is an error.  See the note at
+# the top of this file for why it is opt-in.
 .xl_resolve_range <- function(x, arg = "range", df = NULL, header_offset = 1L,
-                              allow_cell = TRUE) {
-  if (is.list(x) && !is.data.frame(x))
-    return(.resolve_range_spec(x, arg, df, header_offset))
-  if (is.character(x) && length(x) == 1L && !is.na(x))
-    return(.resolve_range_string(x, arg, df, header_offset, allow_cell))
-  stop(sprintf(paste0('`%s` must be an Excel range string like "A1:D51" or a ',
-                      "list(rows = , cols = ) spec"), arg), call. = FALSE)
+                              allow_cell = TRUE, allow_sheet = FALSE) {
+  sheet <- NULL
+  if (is.list(x) && !is.data.frame(x)) {
+    if (!is.null(x[["sheet"]])) {
+      sheet <- x[["sheet"]]
+      if (!is.character(sheet) || length(sheet) != 1L || is.na(sheet))
+        stop(sprintf("`%s$sheet` must be a single sheet name", arg),
+             call. = FALSE)
+      x <- x[setdiff(names(x), "sheet")]
+    }
+    if (!allow_sheet) .reject_sheet(sheet, arg)
+    out <- .resolve_range_spec(x, arg, df, header_offset)
+  } else if (is.character(x) && length(x) == 1L && !is.na(x)) {
+    sp <- .split_sheet_ref(x)
+    sheet <- sp$sheet
+    if (!allow_sheet) .reject_sheet(sheet, arg)
+    out <- .resolve_range_string(sp$rest, arg, df, header_offset, allow_cell)
+  } else {
+    stop(sprintf(paste0('`%s` must be an Excel range string like "A1:D51" or a ',
+                        "list(rows = , cols = ) spec"), arg), call. = FALSE)
+  }
+  if (allow_sheet && !is.null(sheet)) attr(out, "sheet") <- sheet
+  out
 }
 
 # Parse an Excel range ("A1:D51") into 0-based c(first_row, first_col,

R/xl_table.R

@@ -359,6 +359,17 @@ print.xl_table <- function(x, ...) {
 # _write_column_function() and a calculated column in _write_column_formula() --
 # and never to data already written by the row loop.  Left to it, setting a
 # format on an ordinary column would do nothing at all, silently.
+#
+# This is by design, not a bug: the other ports take the table's data as a
+# parameter, so the library writes the cells and can format them, while
+# libxlsxwriter's caller writes them first (jmcnamara/libxlsxwriter#520).  The
+# recommended fix is exactly this -- put the format on the column.
+#
+# BOTH paths are needed and neither is redundant.  The column plan formats the
+# data cells; the format_id passed through .table_columns_payload() becomes the
+# table part's dataDxfId, which upstream says is required "for strict
+# correctness with Excel".  A test asserts both survive, because after the
+# column plan lands the dataDxfId looks like the removable one.
 .table_column_formats <- function(el, df) {
   out <- vector("list", length(df))
   if (!inherits(el, "xl_sheet")) return(out)

R/xl_workbook.R

@@ -187,7 +187,30 @@ print.xl_workbook <- function(x, ...) {
 # Resolve the constant-memory flag for a workbook, from the sheets it is about
 # to write.  Returns the C-side integer flag plus the reasons (if any) the mode
 # had to be turned off.
-.resolve_constant_memory <- function(dfs, props, sheets = NULL) {
+# The extra memory libxlsxwriter uses per cell when it is NOT streaming, in
+# bytes.  Measured against nycflights13 at several sizes and column mixes: 37
+# B/cell for highly repetitive text (the shared-string table deduplicates it)
+# rising to 112 for mixed columns at ~10M cells.  The high end is used, so the
+# estimate errs towards keeping streaming on -- which at scale is also the
+# faster path, not just the leaner one.
+.CM_BYTES_PER_CELL <- 110
+
+# Decide whether to stream rows to disk.
+#
+#   1. constant_memory = FALSE  -> off, without even looking at the rest.
+#   2. a blacklisted feature    -> off.  Nothing overrides this: each of these
+#      either fails outright under streaming or, for a multi-cell array range,
+#      writes a file that opens cleanly and is quietly missing cells.
+#   3. constant_memory = TRUE   -> on, overriding the size estimate.
+#   4. estimated extra memory below `threshold` -> off.  Streaming only pays
+#      for itself on large data, and not streaming also yields a smaller file,
+#      since repeated strings are shared rather than written inline.
+#   5. otherwise -> on.
+.resolve_constant_memory <- function(dfs, props, sheets = NULL, request = NA,
+                                     threshold = 128 * 1024^2) {
+  request <- .val_flag(request, "constant_memory")
+  if (identical(request, FALSE))
+    return(list(on = 0L, reasons = "constant_memory = FALSE"))
   reasons <- character(0)
   # A multi-cell array formula range is padded by libxlsxwriter, and it skips
   # that padding entirely when row streaming is on -- silently, returning
@@ -228,7 +251,36 @@ print.xl_workbook <- function(x, ...) {
     reasons <- c(reasons, sprintf(
       paste0("%d embedded image(s): an embedded image writes a cell, which ",
              "row streaming does not allow above the current row"), n_embed))
-  list(on = as.integer(!length(reasons)), reasons = reasons)
+  # Cells are counted across the whole workbook: libxlsxwriter holds every
+  # sheet's cell table until the file is closed, not one sheet at a time.
+  cells <- sum(vapply(dfs, function(df)
+    as.numeric(nrow(df)) * as.numeric(ncol(df)), numeric(1)))
+  est <- cells * .CM_BYTES_PER_CELL
+
+  if (length(reasons)) {
+    if (isTRUE(request))
+      warning("`constant_memory = TRUE` cannot be honoured: ", reasons[1L],
+              ". Row streaming is off.", call. = FALSE)
+    # The suggestion is emitted here rather than handed back: this is the only
+    # place that knows both why streaming was refused and what it cost, and a
+    # caller could only re-derive that.  It is worth saying only when streaming
+    # would have saved enough to notice -- below that there is nothing for the
+    # reader to act on.
+    if (est >= threshold)
+      message(sprintf(
+        paste0("Row streaming is off because of %s. This workbook is ",
+               "estimated to use about %.0f MB more memory as a result."),
+        reasons[1L], est / 1024^2))
+    return(list(on = 0L, reasons = reasons))
+  }
+  if (isTRUE(request))
+    return(list(on = 1L, reasons = character(0)))
+  if (est < threshold)
+    return(list(on = 0L, reasons = sprintf(
+      paste0("an estimated %.0f MB of extra memory, below the %.0f MB ",
+             "threshold at which row streaming starts to pay"),
+      est / 1024^2, threshold / 1024^2)))
+  list(on = 1L, reasons = character(0))
 }
 
 # Break a Date/POSIXct out into the fields lxw_datetime carries.  The value has

man/write_xlsx.Rd

@@ -552,10 +552,10 @@ sheet_data <- function(path) {
 }
 
 # A one-formula sheet: column A holds data, column B the formula cell.
-array_sheet <- function(...) {
+array_sheet <- function(..., .cm = NA) {
   df <- data.frame(x = 1:2)
   df$f <- xl_cell_general(formula = c("=SUM(A1:A2)", NA), ...)
-  write_tmp(df)
+  write_tmp(df, constant_memory = .cm)
 }
 
 test_that("a single-cell array formula is stored as an array over its own cell", {
@@ -615,7 +615,9 @@ test_that("a multi-cell range turns row streaming off, and says why", {
   # observable end to end: with streaming off, strings move to the shared table
   expect_false(is.null(xlsx_part(write_tmp(df), "xl/sharedStrings.xml")))
   # a single-cell array formula leaves streaming on
-  expect_true(is.null(xlsx_part(array_sheet(array = TRUE),
+  # asked for explicitly: a frame this small would not stream on size alone
+  expect_true(is.null(xlsx_part(array_sheet(array = TRUE,
+                                            .cm = TRUE),
                                 "xl/sharedStrings.xml")))
 })
 

tests/testthat/test-cell-general.R

@@ -151,8 +151,12 @@ test_that("de-hardcoded defaults match the previous behavior (regression)", {
 
 # --- constant memory --------------------------------------------------------
 
-test_that("constant memory resolves to on", {
-  cm <- .resolve_constant_memory(list(data.frame(a = 1)), xl_properties())
+test_that("constant memory is off for small data, on when asked for", {
+  # a one-cell frame saves nothing by streaming, so the default is off; the
+  # request is what separates "nothing forbids it" from "it is worth it"
+  small <- list(data.frame(a = 1))
+  expect_equal(.resolve_constant_memory(small, xl_properties())$on, 0L)
+  cm <- .resolve_constant_memory(small, xl_properties(), request = TRUE)
   expect_equal(cm$on, 1L)
   expect_equal(cm$reasons, character(0))
   expect_equal(.properties_payload(xl_properties())$constant_memory, 1L)
@@ -166,7 +170,8 @@ test_that("workbooks write the same content with constant memory on and off", {
                    flag = c(TRUE, FALSE, NA),
                    when = as.Date("2020-01-01") + 0:2,
                    stringsAsFactors = FALSE)
-  on_path <- write_tmp(list(D = xl_sheet(df, autofilter = TRUE, freeze = "A2")))
+  on_path <- write_tmp(list(D = xl_sheet(df, autofilter = TRUE, freeze = "A2")),
+                       constant_memory = TRUE)
   # No feature writexl writes today turns the mode off, so drive the off path by
   # mocking the resolver.  It must stay exercised: the C side and libxlsxwriter
   # behave differently with row streaming disabled, and a phase that needs the
@@ -276,3 +281,76 @@ test_that("the other custom property types are unaffected", {
   expect_match(cust, "<vt:bool>true")
   expect_match(cust, "<vt:filetime>2020-01-02T00:00:00Z", fixed = TRUE)
 })
+
+test_that("the constant_memory decision follows its five rules in order", {
+  small <- list(data.frame(a = 1:5))
+  # ~1.4M cells, comfortably past the default threshold at 110 B/cell
+  big <- list(data.frame(matrix(1, nrow = 130000, ncol = 12)))
+  blocked <- list(list(merges = list(1)))
+  clear <- list(list(merges = NULL))
+
+  # 1. FALSE wins outright, without consulting anything else
+  # FALSE returns before the blacklist is even consulted, so it is silent too
+  expect_silent(r <- .resolve_constant_memory(big, list(), blocked, FALSE))
+  expect_equal(r$on, 0L)
+  expect_match(r$reasons, "constant_memory = FALSE")
+
+  # 2. the blacklist is absolute -- TRUE cannot override it, only be told.
+  # (These also emit the size suggestion, which its own test covers.)
+  expect_equal(suppressMessages(
+    .resolve_constant_memory(big, list(), blocked))$on, 0L)
+  expect_warning(r <- suppressMessages(
+    .resolve_constant_memory(big, list(), blocked, TRUE)), "cannot be honoured")
+  expect_equal(r$on, 0L)
+
+  # 3. TRUE overrides the size estimate
+  expect_equal(.resolve_constant_memory(small, list(), clear, TRUE)$on, 1L)
+
+  # 4. size decides when nothing else does
+  expect_equal(.resolve_constant_memory(small, list(), clear)$on, 0L)
+  expect_match(.resolve_constant_memory(small, list(), clear)$reasons,
+               "below the .* threshold")
+  expect_equal(.resolve_constant_memory(big, list(), clear)$on, 1L)
+  # ... and the threshold is what moves that line
+  expect_equal(.resolve_constant_memory(big, list(), clear, NA,
+                                        threshold = 4 * 1024^3)$on, 0L)
+})
+
+test_that("cells are counted across the whole workbook", {
+  # libxlsxwriter holds every sheet's cell table until close, so two sheets of
+  # half the size must decide the same way as one of the full size
+  half <- data.frame(matrix(1, nrow = 65000, ncol = 12))
+  clear <- list(list(merges = NULL))
+  expect_equal(.resolve_constant_memory(list(half), list(), clear)$on, 0L)
+  expect_equal(.resolve_constant_memory(list(half, half), list(), clear)$on, 1L)
+})
+
+test_that("the suggestion appears only when streaming would have mattered", {
+  small <- list(data.frame(a = 1:5))
+  big <- list(data.frame(matrix(1, nrow = 130000, ncol = 12)))
+  blocked <- list(list(merges = list(1)))
+  # a small workbook blocked by a feature has nothing to act on, so says nothing
+  expect_silent(.resolve_constant_memory(small, list(), blocked))
+  # a large one is told what it cost, and why
+  expect_message(.resolve_constant_memory(big, list(), blocked), "merged range")
+  expect_message(.resolve_constant_memory(big, list(), blocked),
+                 "MB more memory")
+})
+
+test_that("the decision is silent whenever there is nothing to report", {
+  # write_xlsx() is called constantly on small frames; a message on every one
+  # would be noise, so only a refusal that cost something speaks
+  small <- list(data.frame(a = 1:5))
+  clear <- list(list(merges = NULL))
+  expect_silent(.resolve_constant_memory(small, list(), clear))
+  expect_silent(.resolve_constant_memory(small, list(), clear, TRUE))
+  expect_silent(.resolve_constant_memory(small, list(), clear, FALSE))
+  big <- list(data.frame(matrix(1, nrow = 130000, ncol = 12)))
+  expect_silent(.resolve_constant_memory(big, list(), clear))
+})
+
+test_that("an invalid constant_memory request is refused", {
+  expect_error(.resolve_constant_memory(list(data.frame(a = 1)), list(), NULL,
+                                        "yes"),
+               "must be a single logical")
+})