Skip to content

Commit

Permalink
[experimental] Pivot table improvements (#669)
Browse files Browse the repository at this point in the history 
* fix typo

* add numfmts param option

* provide sort solution

* Sort column and row decreasing / ascending

* check sort position
  • Loading branch information
@JanMarvin
JanMarvin committed Jun 29, 2023
1 parent 4680281 commit 7a37393
Show file tree
Hide file tree
Showing 3 changed files with 148 additions and 18 deletions.
36 changes: 27 additions & 9 deletions R/class-workbook.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1226,16 +1226,34 @@ wbWorkbook <- R6::R6Class(
self$add_worksheet()
}

numfmts <- NULL
if (!is.null(numfmt <- params$numfmt)) {
if (length(numfmt) != length(data))
stop("length of numfmt and data does not match")

for (i in seq_along(numfmt)) {
if (names(numfmt)[i] == "formatCode") {
numfmt_i <- self$styles_mgr$next_numfmt_id()
sty_i <- create_numfmt(numfmt_i, formatCode = numfmt[i])
self$add_style(sty_i, sty_i)
numfmts <- c(numfmts, self$styles_mgr$get_numfmt_id(sty_i))
} else {
numfmts <- c(numfmts, as_xml_attr(numfmt[[i]]))
}
}
}

pivot_table <- create_pivot_table(
x = x,
dims = dims,
filter = filter,
rows = rows,
cols = cols,
data = data,
n = length(self$pivotTables) + 1L,
fun = fun,
params = params
x = x,
dims = dims,
filter = filter,
rows = rows,
cols = cols,
data = data,
n = length(self$pivotTables) + 1L,
fun = fun,
params = params,
numfmts = numfmts
)

if (missing(filter)) filter <- ""
Expand Down
56 changes: 47 additions & 9 deletions R/helperFunctions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -706,7 +706,8 @@ create_pivot_table <- function(
data,
n,
fun,
params
params,
numfmts
) {

if (missing(filter)) {
Expand Down Expand Up @@ -754,13 +755,49 @@ create_pivot_table <- function(

dataField <- NULL
axis <- NULL
sort <- NULL
autoSortScope <- NULL

if (i %in% data_pos) dataField <- c(dataField = "1")
if (i %in% filter_pos) axis <- c(axis = "axisPage")
if (i %in% rows_pos) axis <- c(axis = "axisRow")
if (i %in% cols_pos) axis <- c(axis = "axisCol")

attrs <- c(axis, dataField, showAll = "0")
if (i %in% filter_pos) {
axis <- c(axis = "axisPage")
sort <- params$sort_page
}

if (i %in% rows_pos) {
axis <- c(axis = "axisRow")
sort <- params$sort_row
}

if (i %in% cols_pos) {
axis <- c(axis = "axisCol")
sort <- params$sort_col
}

if (!is.null(sort) && !is.character(sort)) {

if (abs(sort) == 0 || abs(sort) >= length(unique(x[[i]])))
warning("invalid sort position found")

autoSortScope <- read_xml(sprintf('
<autoSortScope>
<pivotArea dataOnly="0" outline="0" fieldPosition="0">
<references count="1">
<reference field="4294967294" count="1" selected="0">
<x v="%s" />
</reference>
</references>
</pivotArea>
</autoSortScope>
',
abs(sort) - 1L), pointer = FALSE)

if (sign(sort) == -1) sort <- "descending"
else sort <- "ascending"
}

attrs <- c(axis, dataField, showAll = "0", sortType = sort)

tmp <- xml_node_create(
"pivotField",
Expand All @@ -770,7 +807,7 @@ create_pivot_table <- function(
tmp <- xml_node_create(
"pivotField",
xml_attributes = attrs,
xml_children = paste0(get_items(x, i), collapse = ""))
xml_children = paste0(paste0(get_items(x, i), collapse = ""), autoSortScope))
}

pivotField <- c(pivotField, tmp)
Expand Down Expand Up @@ -834,7 +871,8 @@ create_pivot_table <- function(
fld = sprintf("%s", data_pos[i] - 1L),
subtotal = fun[i],
baseField = "0",
baseItem = "0"
baseItem = "0",
numFmtId = numfmts[i]
)
)
)
Expand Down Expand Up @@ -978,7 +1016,7 @@ create_pivot_table <- function(
applyPatternFormats = applyPatternFormats,
applyAlignmentFormats = applyAlignmentFormats,
applyWidthHeightFormats = applyWidthHeightFormats,
asteriskTotals = params$asterixTotals,
asteriskTotals = params$asteriskTotals,
autoFormatId = params$autoFormatId,
chartFormat = params$chartFormat,
dataCaption = dataCaption,
Expand Down Expand Up @@ -1016,7 +1054,7 @@ create_pivot_table <- function(
pageStyle = params$pageStyle,
pageWrap = params$pageWrap,
# pivotTableStyle
preserveFormattinn = params$preserveFormattin,
preserveFormatting = params$preserveFormatting,
printDrill = params$printDrill,
published = params$published,
rowGrandTotals = params$rowGrandTotals,
Expand Down
74 changes: 74 additions & 0 deletions tests/testthat/test-class-workbook.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -741,3 +741,77 @@ test_that("changing sheet names works with named regions", {
expect_equal(exp, got)

})

test_that("numfmt in pivot tables works", {

## example code
df <- data.frame(
Plant = c("A", "C", "C", "B", "B", "C", "C", "C", "A", "C"),
Location = c("E", "F", "E", "E", "F", "E", "E", "G", "E", "F"),
Status = c("good", "good", "good", "good", "good", "good", "good", "good", "good", "bad"),
Units = c(0.95, 0.95, 0.95, 0.95, 0.89, 0.89, 0.94, 0.94, 0.9, 0.9),
stringsAsFactors = FALSE
)

## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, startCol = 1, startRow = 2)

df <- wb_data(wb, 1, dims = "A2:D10")
wb$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units")$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
param = list(numfmts = c(formatCode = "#,###0"), sort_row = "ascending"))$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
param = list(numfmts = c(numfmt = 10), sort_row = "descending"))

exp <- c(
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"165\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"10\"/>"
)
got <- xml_node(wb$pivotTables, "pivotTableDefinition", "dataFields", "dataField")
expect_equal(exp, got)

## sort by column and row
df <- mtcars

## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, startCol = 1, startRow = 2)

df <- wb_data(wb)
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), param = list(sort_row = 1, sort_col = -2))

wb$add_pivot_table(df, dims = "A3", rows = "gear",
filter = c("cyl"), data = c("vs", "am"),
param = list(sort_row = "descending"))


exp <- c(
"<pivotField axis=\"axisRow\" showAll=\"0\" sortType=\"ascending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"0\"/></reference></references></pivotArea></autoSortScope></pivotField>",
"<pivotField axis=\"axisCol\" showAll=\"0\" sortType=\"descending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"1\"/></reference></references></pivotArea></autoSortScope></pivotField>"
)
got <- xml_node(wb$pivotTables[1], "pivotTableDefinition", "pivotFields", "pivotField")[c(2, 10)]
expect_equal(exp, got)

expect_warning(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), param = list(sort_row = 1, sort_col = -7)),
"invalid sort position found"
)

expect_error(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"),
param = list(numfmts = c(numfmt = 10))),
"length of numfmt and data does not match"
)

})

0 comments on commit 7a37393

Please sign in to comment.