diff --git a/R/cchart.R b/R/cchart.R index 03d6cf4..e5b8613 100644 --- a/R/cchart.R +++ b/R/cchart.R @@ -126,6 +126,7 @@ #' \item{\code{categories.tick.format}}{ A string representing a d3 formatting code. See \url{https://github.com/mbostock/d3/wiki/Formatting#numbers}.} #' \item{\code{categories.hovertext.format}}{ A string representing a d3 formatting code. See \url{https://github.com/mbostock/d3/wiki/Formatting#numbers}.} #' \item{\code{categories.tick.angle}}{ categories-axis tick label angle in degrees. 90 = vertical; 0 = horizontal.} +#' \item{\code{categories.axis.number.type}}{ Only used for PowerPoint exporting. The categories-axis number type, e.g. \code{"Automatic"} (default) or \code{"Category"}. When \code{"Category"}, date row labels are exported as plain string categories rather than a native PowerPoint date axis.} #' \item{\code{categories.tick.font.color}}{ categories-axis tick label font color as a named color in character format (e.g. "black") or hex code.} #' \item{\code{categories.tick.font.family}}{ Character; categories-axis tick label font family.} #' \item{\code{categories.tick.font.size}}{ Integer; categories-axis tick label font size.} @@ -846,12 +847,38 @@ getPPTSettings <- function(chart.type, args, data) MajorGridLine = list(Color = args$categories.grid.color, Width = px2pt(args$categories.grid.width), Style = getGridLineStyle(args$categories.grid.width, args$categories.grid.dash)), - RotateLabels = isTRUE(args$categories.tick.angle == 90), LabelPosition = "Low") if (any(nzchar(args$categories.bounds.maximum))) res$PrimaryAxis$Maximum <- args$categories.bounds.maximum if (any(nzchar(args$categories.bounds.minimum))) res$PrimaryAxis$Minimum <- args$categories.bounds.minimum + # AxisType = "Date" and LabelsRotation are only parseable by Q from file format 28.08 (Displayr/q#26940); + # older versions throw and fail the whole export (AxisType via Enum.Parse, LabelsRotation as an int). + # So only send them to 28.08+. (category.dates itself is safe on any Q - unknown ChartData attributes + # are ignored.) Q bumps the format version by 0.02, so internal builds that predate the change report + # 28.07; use >= 28.08 to exclude them. + q.can.parse.date.axis <- isTRUE(suppressWarnings(as.numeric(get0("QFileFormatVersion", envir = .GlobalEnv, ifnotfound = NA))) >= 28.08) + + # Also skip the horizontal/Automatic default angle (0), which needs no rotation. + if (q.can.parse.date.axis && isTRUE(args$categories.tick.angle != 0)) + res$PrimaryAxis$LabelsRotation <- as.numeric(args$categories.tick.angle) + + # Export a native PowerPoint date axis when PrepareData captured the underlying dates (transformTable), + # unless the user set the categories axis number type to "Category" (i.e. treat the date labels as + # plain categories). Defaults to "Automatic", so date labels still get a date axis. + # The serials themselves ride on ChartData's "category.dates" attr and are read by Q. Prefer the + # user's categories.tick.format (a d3 date format) when they set one, converting it to a PowerPoint + # date code; otherwise fall back to the format PrepareData chose from the date labels. + categories.axis.number.type <- if (is.null(args$categories.axis.number.type)) "Automatic" + else args$categories.axis.number.type + if (q.can.parse.date.axis && !is.null(attr(data, "category.dates")) && !isScatter(chart.type) + && !identical(categories.axis.number.type, "Category")) + { + res$PrimaryAxis$AxisType <- "Date" + ppt.date.format <- convertToPPTDateFormat(args$categories.tick.format) + res$PrimaryAxis$NumberFormat <- if (!is.null(ppt.date.format)) ppt.date.format + else attr(data, "category.date.format") + } res$ValueAxis = list(LabelsFont = list(color = args$values.tick.font.color, family = args$values.tick.font.family, size = px2pt(args$values.tick.font.size)), @@ -1347,3 +1374,27 @@ convertToPPTNumFormat <- function(d3format) return("General") } +# Convert a d3/strftime date format (as produced by flipChartBasics::ChartNumberFormat for "Date/Time" +# types, e.g. "%d %b %Y", "%Y", "%H:%M") to a PowerPoint/Excel date format code. Returns NULL when the +# input is not a date format (empty, or a numeric/percentage d3 format), so callers can fall back. +convertToPPTDateFormat <- function(d3format) +{ + # strftime tokens are "%" followed by a letter; a percentage d3 format ("%", ".0%") never is. + if (length(d3format) != 1 || is.na(d3format) || !grepl("%[A-Za-z]", d3format)) + return(NULL) + # Excel disambiguates "mm" (month vs minute) and "hh" (12/24 hr, via AM/PM) by context, which matches + # how the strftime tokens are ordered, so a direct token substitution is sufficient. + tokens <- c("%Y" = "yyyy", "%y" = "yy", "%B" = "mmmm", "%b" = "mmm", "%m" = "mm", "%d" = "dd", + "%A" = "dddd", "%a" = "ddd", "%H" = "hh", "%I" = "hh", "%M" = "mm", "%S" = "ss", + "%p" = "AM/PM") + result <- d3format + for (token in names(tokens)) + result <- gsub(token, tokens[[token]], result, fixed = TRUE) + # A leftover "%" means an unmapped strftime token (e.g. %e, %j, %-d, or a user-typed custom format). In + # an Excel number-format code "%" multiplies the value by 100, which would corrupt the axis (OADate x + # 100), so treat any incomplete conversion as not-a-date and let the caller fall back to a safe format. + if (grepl("%", result, fixed = TRUE)) + return(NULL) + result +} + diff --git a/R/preparedata.R b/R/preparedata.R index eea14d5..ef2d768 100644 --- a/R/preparedata.R +++ b/R/preparedata.R @@ -583,6 +583,10 @@ PrepareData <- function(chart.type, if (!is.null(input.data.table)) attr(data, "footerhtml") <- attr(input.data.table, "footerhtml", exact = TRUE) + # Runs on the final labels, so it covers every input path (tables, raw variables, pasted). + if (!multiple.tables) + data <- addCategoryDateAxisAttributes(data, date.format) + list(data = data, weights = weights, values.title = values.title, @@ -1497,6 +1501,35 @@ transformTable <- function(data, return(data) } +# Retain the underlying category dates so PowerPoint can export a native date axis. The category labels +# themselves stay as strings (R always renders them as strings); the numeric date serials are attached as +# the "category.dates" attribute (with "category.date.format") and read by Q. Called on the final prepared +# data so it covers every input path (tables, raw variables, pasted), and handles the common "Automatic" +# case by auto-detecting the label format. See getPPTSettings. +addCategoryDateAxisAttributes <- function(data, date.format) +{ + if (grepl("^No date", date.format) || !is.null(attr(data, "category.dates"))) + return(data) + + labels <- if (!is.null(rownames(data)) && IsDateTime(rownames(data))) rownames(data) + else if (IsDateTime(names(data))) names(data) + else return(data) + + # Under Automatic let AsDate infer US/International; otherwise honour the user's choice. + dates <- if (date.format == "Automatic") suppressWarnings(AsDate(labels)) + else { + us.format <- !grepl("International", date.format) + parsed <- try(suppressWarnings(AsDate(labels, us.format = us.format)), silent = TRUE) + if (inherits(parsed, "try-error")) suppressWarnings(AsDate(labels)) else parsed + } + if (all(is.na(dates))) + return(data) + + attr(data, "category.dates") <- as.numeric(dates) + attr(data, "category.date.format") <- if (grepl("International", date.format)) "dd mmm yyyy" else "mmm dd yyyy" + data +} + convertPercentages <- function(data, as.percentages, hide.percent.symbol, chart.type, multiple.tables, table.counter = 1) { diff --git a/tests/testthat/test-chartsettings-dateaxis.R b/tests/testthat/test-chartsettings-dateaxis.R new file mode 100644 index 0000000..cc7fee3 --- /dev/null +++ b/tests/testthat/test-chartsettings-dateaxis.R @@ -0,0 +1,186 @@ +context("ChartSettings date axis") + +# A native PowerPoint date axis is requested by attaching "category.dates" (numeric date serials) and +# "category.date.format" to the data; PrepareData does this when the category labels are dates. The +# ChartSettings$PrimaryAxis then reports AxisType = "Date" so Q can export a c:dateAx. See preparedata.R +# (transformTable) and cchart.R (getPPTSettings). + +test_that("category.dates makes PrimaryAxis a date axis for categorical charts", +{ + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + on.exit(suppressWarnings(rm("QFileFormatVersion", envir = .GlobalEnv))) + + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + attr(dat, "category.dates") <- as.numeric(as.Date("2020-01-01") + 0:4) + attr(dat, "category.date.format") <- "mmm dd yyyy" + + for (chart.type in c("Column", "Area", "Line", "Bar")) + { + res <- suppressWarnings(CChart(chart.type, dat, append.data = TRUE)) + settings <- attr(res, "ChartSettings") + expect_equal(settings$PrimaryAxis$AxisType, "Date", info = chart.type) + expect_equal(settings$PrimaryAxis$NumberFormat, "mmm dd yyyy", info = chart.type) + } +}) + +test_that("Absence of category.dates leaves a normal category axis", +{ + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$AxisType) +}) + +test_that("Pie charts never get a category date axis", +{ + dat <- structure(1:5, .Names = LETTERS[1:5]) + attr(dat, "category.dates") <- as.numeric(as.Date("2020-01-01") + 0:4) + res <- suppressWarnings(CChart("Pie", dat, append.data = TRUE)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$AxisType) +}) + +test_that("Date row labels flow through PrepareData to a native date axis (end to end)", +{ + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + on.exit(suppressWarnings(rm("QFileFormatVersion", envir = .GlobalEnv))) + + serials <- as.numeric(as.Date("2020-01-01") + 0:4) + tbl <- matrix(1:10, ncol = 2, + dimnames = list(as.character(as.Date("2020-01-01") + 0:4), c("A", "B"))) + + pd <- suppressWarnings(PrepareData("Column", input.data.table = tbl)) + expect_equal(attr(pd$data, "category.dates"), serials) + + res <- suppressWarnings(CChart("Column", pd$data, append.data = TRUE)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$AxisType, "Date") + expect_equal(attr(attr(res, "ChartData"), "category.dates"), serials) +}) + +test_that("Date variable (raw data) flows through to a native date axis (end to end)", +{ + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + on.exit(suppressWarnings(rm("QFileFormatVersion", envir = .GlobalEnv))) + + serials <- as.numeric(as.Date("2020-01-01") + 0:4) + input <- list(X = list(Date = as.Date("2020-01-01") + 0:4, Score = 1:5)) + + pd <- suppressWarnings(PrepareData("Column", input.data.raw = input)) + expect_equal(attr(pd$data, "category.dates"), serials) + + res <- suppressWarnings(CChart("Column", pd$data, append.data = TRUE)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$AxisType, "Date") + expect_equal(attr(attr(res, "ChartData"), "category.dates"), serials) +}) + +test_that("Non-date row labels do not trigger a date axis", +{ + tbl <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + pd <- suppressWarnings(PrepareData("Column", input.data.table = tbl)) + expect_null(attr(pd$data, "category.dates")) +}) + +test_that("convertToPPTDateFormat maps d3 date formats and rejects non-date formats", +{ + expect_equal(convertToPPTDateFormat("%Y"), "yyyy") + expect_equal(convertToPPTDateFormat("%d %b %Y"), "dd mmm yyyy") + expect_equal(convertToPPTDateFormat("%m %d %y"), "mm dd yy") + expect_equal(convertToPPTDateFormat("%B %d %Y"), "mmmm dd yyyy") + expect_equal(convertToPPTDateFormat("%H:%M"), "hh:mm") + expect_null(convertToPPTDateFormat("")) # Automatic / no format + expect_null(convertToPPTDateFormat(".0%")) # percentage, not a date + expect_null(convertToPPTDateFormat(",.0f")) # number, not a date + # Unmapped strftime tokens leave a stray "%" (which Excel reads as x100), so bail out to the fallback. + expect_null(convertToPPTDateFormat("%e %b %Y")) # %e (space-padded day) not mapped + expect_null(convertToPPTDateFormat("%-d %b %Y")) # %-d (no-pad day) not mapped + expect_null(convertToPPTDateFormat("%j")) # %j (day of year) not mapped +}) + +test_that("A user-set date categories.tick.format is preserved on the date axis, else falls back", +{ + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + on.exit(suppressWarnings(rm("QFileFormatVersion", envir = .GlobalEnv))) + + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + attr(dat, "category.dates") <- as.numeric(as.Date("2020-01-01") + 0:4) + attr(dat, "category.date.format") <- "mmm dd yyyy" # PrepareData's fallback + + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.format = "%Y")) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$NumberFormat, "yyyy") + + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.format = "%d %b %Y")) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$NumberFormat, "dd mmm yyyy") + + # No user-set format -> the fallback PrepareData chose from the labels. + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$NumberFormat, "mmm dd yyyy") +}) + +test_that("LabelsRotation is only sent to Q versions that can parse it (28.08+)", +{ + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + on.exit(if (exists("QFileFormatVersion", envir = .GlobalEnv)) rm("QFileFormatVersion", envir = .GlobalEnv)) + + # New enough Q + a non-horizontal angle -> sent as a double, so fractional angles survive. + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.angle = 90)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$LabelsRotation, 90) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.angle = 45.5)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$LabelsRotation, 45.5) + + # Older Q -> not sent, so it can't error the export. + assign("QFileFormatVersion", 28.06, envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.angle = 90)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$LabelsRotation) + + # New Q but horizontal/default angle -> not sent (nothing to rotate). + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.angle = 0)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$LabelsRotation) + + # No version info at all -> not sent. + rm("QFileFormatVersion", envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.tick.angle = 90)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$LabelsRotation) +}) + +test_that("categories.axis.number.type = 'Category' exports date labels as plain categories", +{ + assign("QFileFormatVersion", 28.08, envir = .GlobalEnv) + on.exit(suppressWarnings(rm("QFileFormatVersion", envir = .GlobalEnv))) + + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + attr(dat, "category.dates") <- as.numeric(as.Date("2020-01-01") + 0:4) + attr(dat, "category.date.format") <- "mmm dd yyyy" + + # Default -> date axis. + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE)) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$AxisType, "Date") + + # Explicit "Automatic" -> date axis. + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.axis.number.type = "Automatic")) + expect_equal(attr(res, "ChartSettings")$PrimaryAxis$AxisType, "Date") + + # "Category" -> no date axis (plain string categories). + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE, categories.axis.number.type = "Category")) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$AxisType) +}) + +test_that("Date-axis ChartSettings are withheld from Q versions that cannot parse them", +{ + dat <- matrix(1:10, ncol = 2, dimnames = list(LETTERS[1:5], c("A", "B"))) + attr(dat, "category.dates") <- as.numeric(as.Date("2020-01-01") + 0:4) + attr(dat, "category.date.format") <- "mmm dd yyyy" + on.exit(if (exists("QFileFormatVersion", envir = .GlobalEnv)) rm("QFileFormatVersion", envir = .GlobalEnv)) + + # Old Q, and internal builds that predate the change and report 28.07 (28.06 + 0.01), can't parse + # AxisType = "Date" and would error the whole export - so it must not be sent. + for (v in c(28.06, 28.07)) { + assign("QFileFormatVersion", v, envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$AxisType, info = v) + } + + # No version info at all -> also withheld. + rm("QFileFormatVersion", envir = .GlobalEnv) + res <- suppressWarnings(CChart("Column", dat, append.data = TRUE)) + expect_null(attr(res, "ChartSettings")$PrimaryAxis$AxisType) +}) diff --git a/tests/testthat/test-chartsettings.R b/tests/testthat/test-chartsettings.R index c4248e3..68c578d 100644 --- a/tests/testthat/test-chartsettings.R +++ b/tests/testthat/test-chartsettings.R @@ -64,7 +64,7 @@ test_that("Chart settings", NumberFormat = "General", AxisLine = list(Color = "#0000FF", Width = 1.5, Style = "Solid"), Crosses = "AutoZero", MajorGridLine = list(Color = "#BBBBBB", - Width = 0, Style = "None"), RotateLabels = FALSE, LabelPosition = "Low")) + Width = 0, Style = "None"), LabelPosition = "Low")) expect_equal(attr(res, "ChartSettings")$ValueAxis, list( LabelsFont = list(color = NULL, family = NULL, size = numeric(0)), ShowTitle = FALSE, @@ -101,7 +101,7 @@ test_that("Chart settings", NumberFormat = "General", AxisLine = list(Color = "#222222", Width = 1.5, Style = "Solid"), Crosses = "AutoZero", MajorGridLine = list(Color = "#BBBBBB", - Width = 0, Style = "None"), RotateLabels = TRUE, LabelPosition = "Low")) + Width = 0, Style = "None"), LabelPosition = "Low")) expect_equal(attr(res, "ChartSettings")$ValueAxis, list( LabelsFont = list(color = NULL, family = NULL, size = numeric(0)), ShowTitle = FALSE,