From 6712658ea81942fda96238042c316cb44a45c1b6 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 22 Oct 2023 15:27:51 +0200 Subject: [PATCH] [WIP] add wb_add_slicers (#822) * [slicer] create slicer items * [slicers] add a wb_add_slicer function and some basic functionality * fix typos * updates and tests * fix lintr * make the interface more consistent * `pivot_table` is always the name of the pivot table * `slicer` is always a name of a slicer variable * set a default value to control the position of the slicer. if a single cell is provided, create a cell range. use editAs = "oneCell". Similar to what redmonds spreadsheet software uses. * fix typo * update NEWS --- NAMESPACE | 1 + NEWS.md | 2 + R/class-workbook-wrappers.R | 91 ++++- R/class-workbook.R | 311 +++++++++++++++++- R/helper-functions.R | 77 +++-- man/base_font-wb.Rd | 1 + man/col_widths-wb.Rd | 2 + man/creators-wb.Rd | 1 + man/filter-wb.Rd | 1 + man/grouping-wb.Rd | 3 + man/named_region-wb.Rd | 1 + man/row_heights-wb.Rd | 2 + man/wbWorkbook.Rd | 46 ++- man/wb_add_chartsheet.Rd | 1 + man/wb_add_conditional_formatting.Rd | 1 + man/wb_add_data.Rd | 2 + man/wb_add_data_table.Rd | 2 + man/wb_add_formula.Rd | 2 + man/wb_add_pivot_table.Rd | 10 +- man/wb_add_slicer.Rd | 90 +++++ man/wb_add_thread.Rd | 1 + man/wb_add_worksheet.Rd | 1 + man/wb_clone_worksheet.Rd | 1 + man/wb_copy_cells.Rd | 1 + man/wb_freeze_pane.Rd | 2 + man/wb_merge_cells.Rd | 2 + man/wb_save.Rd | 1 + man/wb_set_last_modified_by.Rd | 1 + man/wb_workbook.Rd | 1 + tests/testthat/test-class-workbook-wrappers.R | 7 + tests/testthat/test-write.R | 68 ++++ 31 files changed, 676 insertions(+), 57 deletions(-) create mode 100644 man/wb_add_slicer.Rd diff --git a/NAMESPACE b/NAMESPACE index 59b68b624..56777eca7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,6 +66,7 @@ export(wb_add_page_break) export(wb_add_person) export(wb_add_pivot_table) export(wb_add_plot) +export(wb_add_slicer) export(wb_add_sparklines) export(wb_add_style) export(wb_add_thread) diff --git a/NEWS.md b/NEWS.md index 9bdad113d..d3ca5e148 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,8 @@ * New set of function `wb_get_properties()`/`wb_set_properties()` to view and modify workbook properties. [782](https://github.com/JanMarvin/openxlsx2/pull/782) This was subsequently improved to handle more workbook properties like `company` and `manager`. ([799](https://github.com/JanMarvin/openxlsx2/pull/799), @olivroy) +* Basic (experimental) support to add slicers to pivot tables created by `openxlsx2`. [822](https://github.com/JanMarvin/openxlsx2/pull/822) + ## Fixes * Removing the worksheet that is the active tab does no longer result in warnings in spreadsheet software. [792](https://github.com/JanMarvin/openxlsx2/pull/792) diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index c49b46b42..82dfc34d2 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -317,6 +317,8 @@ wb_add_data_table <- function( #' @param data The column name(s) of `x` used as data #' @param fun A vector of functions to be used with `data` #' @param params A list of parameters to modify pivot table creation. +#' @param pivot_table An optional name for the pivot table +#' @param slicer a character object with names used as slicer #' @seealso [wb_data()] #' @examples #' wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_data(x = mtcars) @@ -340,30 +342,87 @@ wb_add_pivot_table <- function( cols, data, fun, - params + params, + pivot_table, + slicer ) { assert_workbook(wb) - if (missing(filter)) filter <- substitute() - if (missing(rows)) rows <- substitute() - if (missing(cols)) cols <- substitute() - if (missing(data)) data <- substitute() - if (missing(fun)) fun <- substitute() - if (missing(params)) params <- substitute() + if (missing(filter)) filter <- substitute() + if (missing(rows)) rows <- substitute() + if (missing(cols)) cols <- substitute() + if (missing(data)) data <- substitute() + if (missing(fun)) fun <- substitute() + if (missing(params)) params <- substitute() + if (missing(pivot_table)) pivot_table <- substitute() + if (missing(slicer)) slicer <- substitute() wb$clone()$add_pivot_table( - x = x, - sheet = sheet, - dims = dims, - filter = filter, - rows = rows, - cols = cols, - data = data, - fun = fun, - params = params + x = x, + sheet = sheet, + dims = dims, + filter = filter, + rows = rows, + cols = cols, + data = data, + fun = fun, + params = params, + pivot_table = pivot_table, + slicer = slicer ) } +#' Add a slicer to a pivot table +#' +#' Add a slicer to a previously created pivot table. This function is still experimental and might be changed/improved in upcoming releases. +#' +#' @param wb A Workbook object containing a #' worksheet. +#' @param x A `data.frame` that inherits the [`wb_data`][wb_data()] class. +#' @param sheet A worksheet containing a #' +#' @param dims The worksheet cell where the pivot table is placed +#' @param pivot_table the name of a pivot table on the selected sheet +#' @param slicer a variable used as slicer for the pivot table +#' @param params a list of parameters to modify pivot table creation +#' @family workbook wrappers +#' @family worksheet content functions +#' @details This assumes that the slicer variable initialization has happened before. Unfortunately, it is unlikely that we can guarantee this for loaded workbooks, and we *strictly* discourage users from attempting this. If the variable has not been initialized properly, this may cause the spreadsheet software to crash. +#' +#' For the time being, the slicer needs to be placed on the slide with the pivot table. +#' @examples +#' wb <- wb_workbook() %>% +#' wb_add_worksheet() %>% wb_add_data(x = mtcars) +#' +#' df <- wb_data(wb, sheet = 1) +#' +#' wb <- wb %>% +#' wb_add_pivot_table( +#' df, dims = "A3", slicer = "vs", rows = "cyl", cols = "gear", data = "disp", +#' pivot_table = "mtcars" +#' ) %>% +#' wb_add_slicer(x = df, slicer = "vs", pivot_table = "mtcars") +#' @export +wb_add_slicer <- function( + wb, + x, + dims = "A1", + sheet = current_sheet(), + pivot_table, + slicer, + params +) { + assert_workbook(wb) + if (missing(params)) params <- substitute() + + wb$clone()$add_slicer( + x = x, + sheet = sheet, + dims = dims, + pivot_table = pivot_table, + slicer = slicer, + params = params + ) + +} #' Add a formula to a cell range in a worksheet #' diff --git a/R/class-workbook.R b/R/class-workbook.R index 22a845105..adecd4a74 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -1323,6 +1323,8 @@ wbWorkbook <- R6::R6Class( #' @param data a character object with names used as data #' @param fun a character object of functions to be used with the data #' @param params a list of parameters to modify pivot table creation + #' @param pivot_table a character object with a name for the pivot table + #' @param slicer a character object with names used as slicer #' @details #' `fun` can be either of AVERAGE, COUNT, COUNTA, MAX, MIN, PRODUCT, STDEV, #' STDEVP, SUM, VAR, VARP @@ -1336,22 +1338,25 @@ wbWorkbook <- R6::R6Class( cols, data, fun, - params + params, + pivot_table, + slicer ) { if (missing(x)) stop("x cannot be missing in add_pivot_table") assert_class(x, "wb_data") - add_sheet <- is_waiver(sheet) + add_sheet <- is_waiver(sheet) && sheet == "next_sheet" sheet <- private$get_sheet_index(sheet) - if (missing(filter)) filter <- substitute() - if (missing(rows)) rows <- substitute() - if (missing(cols)) cols <- substitute() - if (missing(data)) data <- substitute() - if (missing(fun)) fun <- substitute() - if (missing(params)) params <- NULL + if (missing(filter)) filter <- substitute() + if (missing(rows)) rows <- substitute() + if (missing(cols)) cols <- substitute() + if (missing(data)) data <- substitute() + if (missing(fun)) fun <- substitute() + if (missing(pivot_table)) pivot_table <- NULL + if (missing(params)) params <- NULL if (!missing(fun) && !missing(data)) { if (length(fun) < length(data)) { @@ -1381,6 +1386,9 @@ wbWorkbook <- R6::R6Class( } } + if (is.null(params$name) && !is.null(pivot_table)) + params$name <- pivot_table + pivot_table <- create_pivot_table( x = x, dims = dims, @@ -1398,11 +1406,16 @@ wbWorkbook <- R6::R6Class( if (missing(rows)) rows <- "" if (missing(cols)) cols <- "" if (missing(data)) data <- "" + if (missing(slicer)) slicer <- "" self$append("pivotTables", pivot_table) - self$append("pivotDefinitions", pivot_def_xml(x, filter, rows, cols, data)) - cacheId <- length(self$pivotTables) + self$worksheets[[sheet]]$relships$pivotTable <- append( + self$worksheets[[sheet]]$relships$pivotTable, + cacheId + ) + + self$append("pivotDefinitions", pivot_def_xml(x, filter, rows, cols, data, slicer, cacheId)) self$append("pivotDefinitionsRels", pivot_def_rel(cacheId)) self$append("pivotRecords", pivot_rec_xml(x)) @@ -1422,13 +1435,7 @@ wbWorkbook <- R6::R6Class( self$workbook$pivotCaches <- xml_node_create("pivotCaches", xml_children = pivotCache) } - if (length(self$worksheets_rels[[sheet]])) { - rlshp <- rbindlist(xml_attr(self$worksheets_rels[[sheet]], "Relationship")) - rlshp$id <- as.integer(gsub("\\D+", "", rlshp$Id)) - next_id <- paste0("rId", max(rlshp$id) + 1L) - } else { - next_id <- "rId1" - } + next_id <- get_next_id(self$worksheets_rels[[sheet]]) self$worksheets_rels[[sheet]] <- c( self$worksheets_rels[[sheet]], @@ -1460,6 +1467,271 @@ wbWorkbook <- R6::R6Class( invisible(self) }, + #' @description add pivot table + #' @param x a wb_data object + #' @param dims the worksheet cell where the pivot table is placed + #' @param pivot_table the name of a pivot table on the selected sheet + #' @param slicer a variable used as slicer for the pivot table + #' @param params a list of parameters to modify pivot table creation + #' @return The `wbWorkbook` object + add_slicer = function(x, dims = "A1", sheet = current_sheet(), pivot_table, slicer, params) { + + if (!grepl(":", dims)) { + ddims <- dims_to_rowcol(dims, as_integer = TRUE) + + dims <- rowcol_to_dims( + row = c(ddims[[2]], ddims[[2]] + 12L), + col = c(ddims[[1]], ddims[[1]] + 1L) + ) + } + + if (missing(x)) + stop("x cannot be missing in add_slicer") + + assert_class(x, "wb_data") + if (missing(params)) params <- NULL + + sheet <- private$get_sheet_index(sheet) + + pt <- rbindlist(xml_attr(self$pivotTables, "pivotTableDefinition")) + sel <- which(pt$name == pivot_table) + cid <- pt$cacheId[sel] + + uni_name <- paste0(slicer, cid) + + ### slicer_cache + sortOrder <- NULL + if (!is.null(params$sortOrder)) + sortOrder <- params$sortOrder + + showMissing <- NULL + if (!is.null(params$showMissing)) + showMissing <- params$showMissing + + crossFilter <- NULL + if (!is.null(params$crossFilter)) + crossFilter <- params$crossFilter + + # TODO we might be able to initialize the field from here. Something like + # get_item(...) and insert it to the pivotDefinition + + # test that slicer is initalized in wb$pivotDefinitions. + pt <- self$worksheets[[sheet]]$relships$pivotTable + ptl <- rbindlist(xml_attr(self$pivotTables[pt], "pivotTableDefinition")) + pt <- pt[which(ptl$name == pivot_table)] + + fields <- xml_node(self$pivotDefinitions[pt], "pivotCacheDefinition", "cacheFields", "cacheField") + names(fields) <- vapply(xml_attr(fields, "cacheField"), function(x) x[["name"]], "") + + if (is.na(xml_attr(fields[slicer], "cacheField", "sharedItems")[[1]]["count"])) { + stop("slicer was not initialized in pivot table!") + } + + tab_xml <- xml_node_create( + "tabular", + xml_attributes = c( + pivotCacheId = cid, + sortOrder = sortOrder, + showMissing = showMissing, + crossFilter = crossFilter + ), + xml_children = get_items(x, which(names(x) == slicer), NULL, slicer = TRUE) + ) + + slicer_cache <- read_xml(sprintf( + ' + + + + + %s + + ', + uni_name, + slicer, + sheet, + pivot_table, + tab_xml + ), pointer = FALSE) + + # we need the slicer cache + self$append( + "slicerCaches", + slicer_cache + ) + + # and the actual slicer + if (length(self$worksheets[[sheet]]$relships$slicer) == 0) { + self$append( + "slicers", + '' + ) + self$worksheets[[sheet]]$relships$slicer <- length(self$slicers) + } + + caption <- slicer + if (!is.null(params$caption)) + caption <- params$caption + + row_height <- 230716 + if (!is.null(params$rowHeight)) + row_height <- params$rowHeight + + column_count <- NULL + if (!is.null(params$columnCount)) + column_count <- params$columnCount + + style <- NULL + if (!is.null(params$style)) + style <- params$style + + slicer_xml <- xml_node_create( + "slicer", + xml_attributes = c( + name = uni_name, + `xr10:uid` = st_guid(), + cache = paste0("Slicer_", uni_name), + caption = caption, + rowHeight = as_xml_attr(row_height), + columnCount = as_xml_attr(column_count), + style = style + ) + ) + + sel <- self$worksheets[[sheet]]$relships$slicer + self$slicers[sel] <- xml_add_child(self$slicers[sel], xml_child = slicer_xml) + + slicer_id <- length(self$slicerCaches) + # append it to the workbook.xml.rels + self$append( + "workbook.xml.rels", + sprintf("", + 100000 + slicer_id, slicer_id) + ) + + # add this defined name + self$workbook$definedNames <- append( + self$workbook$definedNames, + sprintf("#N/A", uni_name) + ) + + # add the workbook extension list + if (is.null(self$workbook$extLst)) { + self$workbook$extLst <- ' + + + + + + ' + } else if (!grepl("", self$workbook$extLst)) { + self$workbook$extLst <- xml_add_child( + self$workbook$extLst, + level = "ext", + xml_child = xml_node_create("x14:slicerCaches") + ) + } + + self$workbook$extLst <- xml_add_child( + self$workbook$extLst, + xml_child = sprintf('', 100000 + slicer_id), + level = c("ext", "x14:slicerCaches") + ) + + # add a drawing for the slicer + drawing_xml <- read_xml(sprintf(' + + + + + + + + + + + + + + + + + + This shape represents a slicer. Slicers are supported in Excel 2010 or later.\n\nIf the shape was modified in an earlier version of Excel, or if the workbook was saved in Excel 2003 or earlier, the slicer cannot be used. + + + + + ', uni_name, uni_name + ), pointer = FALSE) + + + edit_as <- "oneCell" + if (!is.null(params$edit_as)) + edit_as <- params$edit_as + + # place the drawing + self$add_drawing(dims = dims, sheet = sheet, xml = drawing_xml, edit_as = edit_as) + + + next_id <- get_next_id(self$worksheets_rels[[sheet]]) + + # add the pivot table and the drawing to the worksheet + if (!any(grepl(sprintf("Target=\"../slicers/slicer%s.xml\"", self$worksheets[[sheet]]$relships$slicer), self$worksheets_rels[[sheet]]))) { + + slicer_list_xml <- sprintf( + '', + next_id + ) + + # add the extension list to the worksheet + if (length(self$worksheets[[sheet]]$extLst) == 0) { + self$worksheets[[sheet]]$extLst <- sprintf( + " + %s + ", slicer_list_xml + ) + } else if (!grepl("", self$worksheets[[sheet]]$extLst)) { + self$worksheets[[sheet]]$extLst <- xml_add_child( + self$worksheets[[sheet]]$extLst, + xml_children = slicer_list_xml + ) + } + + self$worksheets_rels[[sheet]] <- append( + self$worksheets_rels[[sheet]], + sprintf( + "", + next_id, self$worksheets[[sheet]]$relships$slicer + ) + ) + + } + + slicer_xml <- sprintf( + "", + self$worksheets[[sheet]]$relships$slicer + ) + + if (!any(self$Content_Types == slicer_xml)) { + self$append( + "Content_Types", + slicer_xml + ) + } + + value <- sprintf( + "", + slicer_id + ) + + self$append( + "Content_Types", value + ) + + invisible(self) + }, + #' @description Add formula #' @param x x #' @param start_col startCol @@ -4561,7 +4833,9 @@ wbWorkbook <- R6::R6Class( ... ) { + edit_as <- NULL standardize_case_names(...) + if (!is.null(list(...)$edit_as)) edit_as <- list(...)$edit_as sheet <- private$get_sheet_index(sheet) @@ -4666,6 +4940,9 @@ wbWorkbook <- R6::R6Class( grpSp, grFrm, clDt + ), + xml_attributes = c( + editAs = as_xml_attr(edit_as) ) ) diff --git a/R/helper-functions.R b/R/helper-functions.R index e94eac201..501d6c10e 100644 --- a/R/helper-functions.R +++ b/R/helper-functions.R @@ -488,14 +488,14 @@ distinct <- function(x) { unis[dups == FALSE] } -cacheFields <- function(wbdata, filter, rows, cols, data) { +cacheFields <- function(wbdata, filter, rows, cols, data, slicer) { sapply( names(wbdata), function(x) { dat <- wbdata[[x]] - vars <- c(filter, rows, cols, data) + vars <- c(filter, rows, cols, data, slicer) is_vars <- x %in% vars is_data <- x %in% data && @@ -604,7 +604,7 @@ cacheFields <- function(wbdata, filter, rows, cols, data) { ) } -pivot_def_xml <- function(wbdata, filter, rows, cols, data) { +pivot_def_xml <- function(wbdata, filter, rows, cols, data, slicer, pcid) { ref <- dataframe_to_dims(attr(wbdata, "dims")) sheet <- attr(wbdata, "sheet") @@ -614,8 +614,13 @@ pivot_def_xml <- function(wbdata, filter, rows, cols, data) { sprintf('', nrow(wbdata)), '', '', - paste0(cacheFields(wbdata, filter, rows, cols, data), collapse = ""), + paste0(cacheFields(wbdata, filter, rows, cols, data, slicer), collapse = ""), '', + '', + '', + sprintf('', pcid), + '', + '', '' ) } @@ -632,7 +637,7 @@ pivot_def_rel <- function(n) sprintf("", n) -get_items <- function(data, x, item_order) { +get_items <- function(data, x, item_order, slicer = FALSE) { x <- abs(x) # check length, otherwise a certain spreadsheet software simply dies @@ -649,22 +654,34 @@ get_items <- function(data, x, item_order) { order(distinct(data[[x]])) } - item <- sapply( - c(item_order - 1L, "default"), - # # TODO this sets the order of the pivot elements - # c(seq_along(unique(data[[x]])) - 1L, "default"), - function(val) { - if (val == "default") - xml_node_create("item", xml_attributes = c(t = val)) - else - xml_node_create("item", xml_attributes = c(x = val)) - }, - USE.NAMES = FALSE - ) + if (slicer) { + item <- sapply( + as.character(item_order - 1L), + function(val) { + xml_node_create("i", xml_attributes = c(x = val, s = "1")) + }, + USE.NAMES = FALSE + ) + } else { + item <- sapply( + c(item_order - 1L, "default"), + # # TODO this sets the order of the pivot elements + # c(seq_along(unique(data[[x]])) - 1L, "default"), + function(val) { + if (val == "default") + xml_node_create("item", xml_attributes = c(t = val)) + else + xml_node_create("item", xml_attributes = c(x = val)) + }, + USE.NAMES = FALSE + ) + } + items <- xml_node_create( "items", xml_attributes = c(count = as.character(length(item))), xml_children = item ) + items } @@ -903,9 +920,9 @@ create_pivot_table <- function( ) ) - name <- "PivotStyleLight16" - if (!is.null(params$name)) - name <- params$name + table_style <- "PivotStyleLight16" + if (!is.null(params$table_style)) + table_style <- params$table_style dataCaption <- "Values" if (!is.null(params$dataCaption)) @@ -934,7 +951,7 @@ create_pivot_table <- function( pivotTableStyleInfo <- xml_node_create( "pivotTableStyleInfo", xml_attributes = c( - name = name, + name = table_style, showRowHeaders = showRowHeaders, showColHeaders = showColHeaders, showRowStripes = showRowStripes, @@ -1005,6 +1022,10 @@ create_pivot_table <- function( if (!is.null(params$applyWidthHeightFormats)) applyWidthHeightFormats <- params$applyWidthHeightFormats + pivot_table_name <- sprintf("PivotTable%s", n) + if (!is.null(params$name)) + pivot_table_name <- params$name + xml_node_create( "pivotTableDefinition", xml_attributes = c( @@ -1012,7 +1033,7 @@ create_pivot_table <- function( `xmlns:mc` = "http://schemas.openxmlformats.org/markup-compatibility/2006", `mc:Ignorable` = "xr", `xmlns:xr` = "http://schemas.microsoft.com/office/spreadsheetml/2014/revision", - name = sprintf("PivotTable%s", n), + name = pivot_table_name, cacheId = as.character(n), applyNumberFormats = applyNumberFormats, applyBorderFormats = applyBorderFormats, @@ -1179,6 +1200,18 @@ to_string <- function(x) { chr } +# get the next free relationship id +get_next_id <- function(x) { + if (length(x)) { + rlshp <- rbindlist(xml_attr(x, "Relationship")) + rlshp$id <- as.integer(gsub("\\D+", "", rlshp$Id)) + next_id <- paste0("rId", max(rlshp$id) + 1L) + } else { + next_id <- "rId1" + } + next_id +} + #' create a guid string #' @keywords internal #' @noRd diff --git a/man/base_font-wb.Rd b/man/base_font-wb.Rd index dc78865ed..6baa8095a 100644 --- a/man/base_font-wb.Rd +++ b/man/base_font-wb.Rd @@ -66,6 +66,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/col_widths-wb.Rd b/man/col_widths-wb.Rd index 55d5b87a5..d9cb8f187 100644 --- a/man/col_widths-wb.Rd +++ b/man/col_widths-wb.Rd @@ -83,6 +83,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -102,6 +103,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/creators-wb.Rd b/man/creators-wb.Rd index 5f5cde99b..2ef6a219f 100644 --- a/man/creators-wb.Rd +++ b/man/creators-wb.Rd @@ -57,6 +57,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/filter-wb.Rd b/man/filter-wb.Rd index 9632bbad8..0f83ebb17 100644 --- a/man/filter-wb.Rd +++ b/man/filter-wb.Rd @@ -74,6 +74,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/grouping-wb.Rd b/man/grouping-wb.Rd index 33ec249ba..23bd7d817 100644 --- a/man/grouping-wb.Rd +++ b/man/grouping-wb.Rd @@ -97,6 +97,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -116,6 +117,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} @@ -130,6 +132,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/named_region-wb.Rd b/man/named_region-wb.Rd index b00ad119a..f63b2685d 100644 --- a/man/named_region-wb.Rd +++ b/man/named_region-wb.Rd @@ -120,6 +120,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/row_heights-wb.Rd b/man/row_heights-wb.Rd index 2396bb0c0..66eb1fad5 100644 --- a/man/row_heights-wb.Rd +++ b/man/row_heights-wb.Rd @@ -60,6 +60,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -79,6 +80,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index 7917dd8df..cff51100b 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -113,6 +113,7 @@ worksheet names.} \item \href{#method-wbWorkbook-add_data}{\code{wbWorkbook$add_data()}} \item \href{#method-wbWorkbook-add_data_table}{\code{wbWorkbook$add_data_table()}} \item \href{#method-wbWorkbook-add_pivot_table}{\code{wbWorkbook$add_pivot_table()}} +\item \href{#method-wbWorkbook-add_slicer}{\code{wbWorkbook$add_slicer()}} \item \href{#method-wbWorkbook-add_formula}{\code{wbWorkbook$add_formula()}} \item \href{#method-wbWorkbook-add_style}{\code{wbWorkbook$add_style()}} \item \href{#method-wbWorkbook-to_df}{\code{wbWorkbook$to_df()}} @@ -596,7 +597,9 @@ add pivot table cols, data, fun, - params + params, + pivot_table, + slicer )}\if{html}{\out{}} } @@ -620,6 +623,10 @@ add pivot table \item{\code{fun}}{a character object of functions to be used with the data} \item{\code{params}}{a list of parameters to modify pivot table creation} + +\item{\code{pivot_table}}{a character object with a name for the pivot table} + +\item{\code{slicer}}{a character object with names used as slicer} } \if{html}{\out{}} } @@ -628,6 +635,43 @@ add pivot table STDEVP, SUM, VAR, VARP } +\subsection{Returns}{ +The \code{wbWorkbook} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-add_slicer}{}}} +\subsection{Method \code{add_slicer()}}{ +add pivot table +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$add_slicer( + x, + dims = "A1", + sheet = current_sheet(), + pivot_table, + slicer, + params +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{x}}{a wb_data object} + +\item{\code{dims}}{the worksheet cell where the pivot table is placed} + +\item{\code{sheet}}{The name of the sheet} + +\item{\code{pivot_table}}{the name of a pivot table on the selected sheet} + +\item{\code{slicer}}{a variable used as slicer for the pivot table} + +\item{\code{params}}{a list of parameters to modify pivot table creation} +} +\if{html}{\out{
}} +} \subsection{Returns}{ The \code{wbWorkbook} object } diff --git a/man/wb_add_chartsheet.Rd b/man/wb_add_chartsheet.Rd index 800597c4b..879fa2c63 100644 --- a/man/wb_add_chartsheet.Rd +++ b/man/wb_add_chartsheet.Rd @@ -45,6 +45,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/wb_add_conditional_formatting.Rd b/man/wb_add_conditional_formatting.Rd index ef81c80b3..fafda7b32 100644 --- a/man/wb_add_conditional_formatting.Rd +++ b/man/wb_add_conditional_formatting.Rd @@ -111,6 +111,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/wb_add_data.Rd b/man/wb_add_data.Rd index 04839a850..723c89411 100644 --- a/man/wb_add_data.Rd +++ b/man/wb_add_data.Rd @@ -140,6 +140,7 @@ Other workbook wrappers: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -159,6 +160,7 @@ Other worksheet content functions: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/wb_add_data_table.Rd b/man/wb_add_data_table.Rd index 1d607dfba..24b651043 100644 --- a/man/wb_add_data_table.Rd +++ b/man/wb_add_data_table.Rd @@ -101,6 +101,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} @@ -115,6 +116,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/wb_add_formula.Rd b/man/wb_add_formula.Rd index 4457f879d..da66a159e 100644 --- a/man/wb_add_formula.Rd +++ b/man/wb_add_formula.Rd @@ -81,6 +81,7 @@ Other workbook wrappers: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_data}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -100,6 +101,7 @@ Other worksheet content functions: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_data}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/wb_add_pivot_table.Rd b/man/wb_add_pivot_table.Rd index 3b825d655..f8005ab01 100644 --- a/man/wb_add_pivot_table.Rd +++ b/man/wb_add_pivot_table.Rd @@ -14,7 +14,9 @@ wb_add_pivot_table( cols, data, fun, - params + params, + pivot_table, + slicer ) } \arguments{ @@ -37,6 +39,10 @@ wb_add_pivot_table( \item{fun}{A vector of functions to be used with \code{data}} \item{params}{A list of parameters to modify pivot table creation.} + +\item{pivot_table}{An optional name for the pivot table} + +\item{slicer}{a character object with names used as slicer} } \description{ Add a pivot table to a worksheet. The data must be specified using \code{\link[=wb_data]{wb_data()}} @@ -71,6 +77,7 @@ Other workbook wrappers: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -90,6 +97,7 @@ Other worksheet content functions: \code{\link{wb_add_data_table}()}, \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} diff --git a/man/wb_add_slicer.Rd b/man/wb_add_slicer.Rd new file mode 100644 index 000000000..4e3e9be8c --- /dev/null +++ b/man/wb_add_slicer.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-workbook-wrappers.R +\name{wb_add_slicer} +\alias{wb_add_slicer} +\title{Add a slicer to a pivot table} +\usage{ +wb_add_slicer( + wb, + x, + dims = "A1", + sheet = current_sheet(), + pivot_table, + slicer, + params +) +} +\arguments{ +\item{wb}{A Workbook object containing a #' worksheet.} + +\item{x}{A \code{data.frame} that inherits the \code{\link[=wb_data]{wb_data}} class.} + +\item{dims}{The worksheet cell where the pivot table is placed} + +\item{sheet}{A worksheet containing a #'} + +\item{pivot_table}{the name of a pivot table on the selected sheet} + +\item{slicer}{a variable used as slicer for the pivot table} + +\item{params}{a list of parameters to modify pivot table creation} +} +\description{ +Add a slicer to a previously created pivot table. This function is still experimental and might be changed/improved in upcoming releases. +} +\details{ +This assumes that the slicer variable initialization has happened before. Unfortunately, it is unlikely that we can guarantee this for loaded workbooks, and we \emph{strictly} discourage users from attempting this. If the variable has not been initialized properly, this may cause the spreadsheet software to crash. + +For the time being, the slicer needs to be placed on the slide with the pivot table. +} +\examples{ +wb <- wb_workbook() \%>\% + wb_add_worksheet() \%>\% wb_add_data(x = mtcars) + +df <- wb_data(wb, sheet = 1) + +wb <- wb \%>\% + wb_add_pivot_table( + df, dims = "A3", slicer = "vs", rows = "cyl", cols = "gear", data = "disp", + pivot_table = "mtcars" + ) \%>\% + wb_add_slicer(x = df, slicer = "vs", pivot_table = "mtcars") +} +\seealso{ +Other workbook wrappers: +\code{\link{base_font-wb}}, +\code{\link{col_widths-wb}}, +\code{\link{creators-wb}}, +\code{\link{grouping-wb}}, +\code{\link{row_heights-wb}}, +\code{\link{wb_add_chartsheet}()}, +\code{\link{wb_add_data_table}()}, +\code{\link{wb_add_data}()}, +\code{\link{wb_add_formula}()}, +\code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_worksheet}()}, +\code{\link{wb_clone_worksheet}()}, +\code{\link{wb_copy_cells}()}, +\code{\link{wb_freeze_pane}()}, +\code{\link{wb_merge_cells}()}, +\code{\link{wb_save}()}, +\code{\link{wb_set_last_modified_by}()}, +\code{\link{wb_workbook}()} + +Other worksheet content functions: +\code{\link{col_widths-wb}}, +\code{\link{filter-wb}}, +\code{\link{grouping-wb}}, +\code{\link{named_region-wb}}, +\code{\link{row_heights-wb}}, +\code{\link{wb_add_conditional_formatting}()}, +\code{\link{wb_add_data_table}()}, +\code{\link{wb_add_data}()}, +\code{\link{wb_add_formula}()}, +\code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_thread}()}, +\code{\link{wb_freeze_pane}()}, +\code{\link{wb_merge_cells}()} +} +\concept{workbook wrappers} +\concept{worksheet content functions} diff --git a/man/wb_add_thread.Rd b/man/wb_add_thread.Rd index 7a125be0e..7f6c2b538 100644 --- a/man/wb_add_thread.Rd +++ b/man/wb_add_thread.Rd @@ -69,6 +69,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_freeze_pane}()}, \code{\link{wb_merge_cells}()} } diff --git a/man/wb_add_worksheet.Rd b/man/wb_add_worksheet.Rd index df4fc7c13..c5711bea5 100644 --- a/man/wb_add_worksheet.Rd +++ b/man/wb_add_worksheet.Rd @@ -142,6 +142,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, \code{\link{wb_freeze_pane}()}, diff --git a/man/wb_clone_worksheet.Rd b/man/wb_clone_worksheet.Rd index 1abb6d161..03c69b724 100644 --- a/man/wb_clone_worksheet.Rd +++ b/man/wb_clone_worksheet.Rd @@ -71,6 +71,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_copy_cells}()}, \code{\link{wb_freeze_pane}()}, diff --git a/man/wb_copy_cells.Rd b/man/wb_copy_cells.Rd index 7dbe991b4..4f0443120 100644 --- a/man/wb_copy_cells.Rd +++ b/man/wb_copy_cells.Rd @@ -61,6 +61,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_freeze_pane}()}, diff --git a/man/wb_freeze_pane.Rd b/man/wb_freeze_pane.Rd index 63e728c55..03d32f876 100644 --- a/man/wb_freeze_pane.Rd +++ b/man/wb_freeze_pane.Rd @@ -60,6 +60,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -79,6 +80,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_merge_cells}()} } diff --git a/man/wb_merge_cells.Rd b/man/wb_merge_cells.Rd index 145685e69..a3f54ede0 100644 --- a/man/wb_merge_cells.Rd +++ b/man/wb_merge_cells.Rd @@ -66,6 +66,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, @@ -85,6 +86,7 @@ Other worksheet content functions: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_thread}()}, \code{\link{wb_freeze_pane}()} } diff --git a/man/wb_save.Rd b/man/wb_save.Rd index 9fead7a51..713ea460a 100644 --- a/man/wb_save.Rd +++ b/man/wb_save.Rd @@ -43,6 +43,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/wb_set_last_modified_by.Rd b/man/wb_set_last_modified_by.Rd index f12dc4c21..793565f63 100644 --- a/man/wb_set_last_modified_by.Rd +++ b/man/wb_set_last_modified_by.Rd @@ -32,6 +32,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/man/wb_workbook.Rd b/man/wb_workbook.Rd index 8e77bd353..16f6d7d9f 100644 --- a/man/wb_workbook.Rd +++ b/man/wb_workbook.Rd @@ -68,6 +68,7 @@ Other workbook wrappers: \code{\link{wb_add_data}()}, \code{\link{wb_add_formula}()}, \code{\link{wb_add_pivot_table}()}, +\code{\link{wb_add_slicer}()}, \code{\link{wb_add_worksheet}()}, \code{\link{wb_clone_worksheet}()}, \code{\link{wb_copy_cells}()}, diff --git a/tests/testthat/test-class-workbook-wrappers.R b/tests/testthat/test-class-workbook-wrappers.R index 096522810..29ee7d18b 100644 --- a/tests/testthat/test-class-workbook-wrappers.R +++ b/tests/testthat/test-class-workbook-wrappers.R @@ -361,6 +361,13 @@ test_that("wb_add_pivot_table() is a wrapper", { expect_wrapper("add_pivot_table", wb = wb, params = list(x = df, data = "disp")) }) +test_that("wb_add_slicer() is a wrapper", { + wb <- wb_workbook()$add_worksheet()$add_data(x = mtcars) + df <- wb_data(wb) + wb$add_pivot_table(x = df, data = "disp", slicer = "vs", pivot_table = "pivot1") + expect_wrapper("add_slicer", wb = wb, params = list(x = df, slicer = "vs", pivot_table = "pivot1")) +}) + test_that("wb_add_formula() is a wrapper", { wb <- wb_workbook()$add_worksheet(1) expect_wrapper("add_formula", wb = wb, params = list(sheet = 1, x = "=TODAY()")) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 7954fd3d0..859b8a665 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -485,6 +485,74 @@ test_that("writing pivot with escaped characters works", { }) +test_that("writing slicers works", { + + wb <- wb_workbook() %>% + ### Sheet 1 + wb_add_worksheet() %>% + wb_add_data(x = mtcars) + + df <- wb_data(wb, sheet = 1) + + varname <- c("vs", "drat") + + ### Sheet 2 + wb$ + # first pivot + add_pivot_table( + df, dims = "A3", slicer = varname, rows = "cyl", cols = "gear", data = "disp", + pivot_table = "mtcars" + )$ + add_slicer(x = df, sheet = current_sheet(), slicer = "vs", pivot_table = "mtcars")$ + add_slicer(x = df, dims = "B18:D24", sheet = current_sheet(), slicer = "drat", pivot_table = "mtcars", + params = list(columnCount = 5))$ + # second pivot + add_pivot_table( + df, dims = "G3", sheet = current_sheet(), slicer = varname, rows = "gear", cols = "carb", data = "mpg", + pivot_table = "mtcars2" + )$ + add_slicer(x = df, dims = "G12:I16", slicer = "vs", pivot_table = "mtcars2", + params = list(sortOrder = "descending", caption = "Wow!")) + + ### Sheet 3 + wb$ + add_pivot_table( + df, dims = "A3", slicer = varname, rows = "gear", cols = "carb", data = "mpg", + pivot_table = "mtcars3" + )$ + add_slicer(x = df, dims = "A12:D16", slicer = "vs", pivot_table = "mtcars3") + + # test a few conditions + expect_equal(2L, length(wb$slicers)) + expect_equal(4L, length(wb$slicerCaches)) + expect_equal(xml_node_name(wb$workbook$extLst, "extLst", "ext"), "x14:slicerCaches") + expect_equal(1L, wb$worksheets[[2]]$relships$slicer) + expect_equal(2L, wb$worksheets[[3]]$relships$slicer) + expect_equal(25L, grep("slicer2.xml", wb$Content_Types)) + + ## test error + wb <- wb_workbook() %>% + wb_add_worksheet() %>% + wb_add_data(x = mtcars) + + df <- wb_data(wb, sheet = 1) + + varname <- c("vs", "drat") + + wb$ + # first pivot + add_pivot_table( + df, dims = "A3", rows = "cyl", cols = "gear", data = "disp", + params = list(name = "mtcars") + ) + + expect_error( + wb$add_slicer(x = df, sheet = current_sheet(), slicer = "vs", pivot_table = "mtcars"), + "slicer was not initialized in pivot table!" + ) + +}) + test_that("writing na.strings = NULL works", { # write na.strings = na_strings()