RS-22971: Export a native date axis when category labels are dates

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
+}
+

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)
 {

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)
+})

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,