[pt] calculate pivot table field with formula

JanMarvin · Jan 13, 2024 · b8b1fe2 · b8b1fe2
1 parent 6ed65bf
commit b8b1fe2
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 2 deletions.
diff --git a/R/class-workbook.R b/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,

diff --git a/R/helper-functions.R b/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,19 @@ cacheFields <- function(wbdata, filter, rows, cols, data, slicer) {
         xml_children = sharedItem
       )
 
+      formula <- NULL
+      databaseField <- NULL
+
+      # <cacheField name="Field1" numFmtId="0" formula="mpg /cyl" databaseField="0"/>
+      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 +826,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 +886,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)