[pt] calculate pivot table field with formula

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: openxlsx2
 Title: Read, Write and Edit 'xlsx' Files
-Version: 1.3
+Version: 1.3.0.9000
 Language: en-US
 Authors@R: c(
   person("Jordan Mark", "Barbone", email = "[email protected]", role = "aut", comment = c(ORCID = "0000-0001-9788-3628")),

NEWS.md

@@ -1,3 +1,13 @@
+# openxlsx2 (development version)
+
+## New features
+
+* Experimental support for calculation of pivot table fields. [892](https://github.com/JanMarvin/openxlsx2/pull/892)
+
+
+***************************************************************************
+
+
 # openxlsx2 1.3
 
 ## Documentation improvement

R/class-workbook-wrappers.R

@@ -327,6 +327,10 @@ wb_add_data_table <- function(
 #' `show_data_as` can be any of `normal`, `difference`, `percent`, `percentDiff`,
 #' `runTotal`, `percentOfRow`, `percentOfCol`, `percentOfTotal`, `index`.
 #'
+#' It is possible to calculate data fields if the formula is assigned as a
+#' variable name for the field to calculate. This would look like this:
+#' `data = c("am", "disp/cyl" = "New")`
+#'
 #' Possible `params` arguments are listed below. Pivot tables accepts more
 #' parameters, but they were either not tested or misbehaved (probably because
 #' we misunderstood how the parameter should be used).

R/class-workbook.R

@@ -1420,6 +1420,22 @@ wbWorkbook <- R6::R6Class(
       if (is.null(params$name) && !is.null(pivot_table))
         params$name <- pivot_table
 
+      # not sure if rows & cols can be formulas too
+      if (any(sel <- !data %in% names(x))) {
+
+        varfun <- data[sel]
+
+        for (var in varfun) {
+          if (all(grepl("^=", names(varfun)))) {
+            x[[var]] <- names(varfun[varfun == var])
+            class(x[[var]]) <- c("is_formula", "character")
+          } else {
+            stop("missing variable found in pivot table: data object. Formula names must begin with '='.")
+          }
+        }
+
+      }
+
       pivot_table <- create_pivot_table(
         x       = x,
         dims    = dims,

R/helper-functions.R

@@ -508,7 +508,9 @@ cacheFields <- function(wbdata, filter, rows, cols, data, slicer) {
         dat <- format(dat, format = "%Y-%m-%dT%H:%M:%S")
       }
 
-      if (is_vars && !is_data) {
+      is_formula <- inherits(wbdata[[x]], what = "is_formula")
+
+      if (is_vars && !is_data && !is_formula) {
         sharedItem <- vapply(
           distinct(dat),
           function(uni) {
@@ -594,9 +596,18 @@ cacheFields <- function(wbdata, filter, rows, cols, data, slicer) {
         xml_children = sharedItem
       )
 
+      formula <- NULL
+      databaseField <- NULL
+
+      if (is_formula) {
+        formula       <- gsub("^=", "", names(vars[vars == x]))
+        databaseField <- "0"
+        sharedItems   <- NULL
+      }
+
       xml_node_create(
         "cacheField",
-        xml_attributes = c(name = x, numFmtId = "0"),
+        xml_attributes = c(name = x, numFmtId = "0", formula = formula, databaseField = databaseField),
         xml_children = sharedItems
       )
     },
@@ -814,6 +825,7 @@ create_pivot_table <- function(
     axis <- NULL
     sort <- NULL
     autoSortScope <- NULL
+    is_formula <- inherits(x[[i]], "is_formula")
 
     if (i %in% data_pos)    dataField <- c(dataField = "1")
 
@@ -873,6 +885,17 @@ create_pivot_table <- function(
       compact = as_xml_attr(compact), outline = as_xml_attr(outline)
     )
 
+    if (is_formula) {
+        attrs <- c(
+          dataField       = "1",
+          dragToRow       = "0",
+          dragToCol       = "0",
+          dragToPage      = "0",
+          showAll         = "0",
+          defaultSubtotal = "0"
+        )
+    }
+
     tmp <- xml_node_create(
       "pivotField",
       xml_attributes = attrs)