FS2-4532: Support series-specific line type and markers in editable PPT export

.circleci/config.yml

@@ -7,7 +7,7 @@ parameters:
     default: ""
   remote-deps:
     type: string
-    default: Displayr/rhtmlCombinedScatter@1.0.14,Displayr/flipStandardCharts@1.32.4
+    default: Displayr/rhtmlCombinedScatter@1.2.1,Displayr/flipStandardCharts@1.32.15
   plugins-branch:
     type: string
     default: ""

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipChart
 Type: Package
 Title: Single function for calling charts - CChart
-Version: 1.12.12
+Version: 1.12.13
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Wrapper for other chart functions, such that they can be access via a
@@ -23,7 +23,7 @@ Imports:
     flipChartBasics,
     flipData (>= 1.2.7),
     flipFormat,
-    flipStandardCharts (>= 1.32.12),
+    flipStandardCharts (>= 1.32.15),
     flipStatistics,
     flipTables (>= 2.8.8),
     flipTime,

R/cchart.R

@@ -367,7 +367,9 @@ CChart <- function(chart.type, x, small.multiples = FALSE,
     result <- do.call(fun.and.pars$chart.function, eval(parse(text = args)))
     chart.warning <- attr(result, "ChartWarning")
     result <- addLabels(result, chart.type, user.args$title, categories.title, values.title, user.args$data.label.format)
-    chart.settings <- updateChartSettingsWithLabels(chart.settings, attr(result, "ChartLabels"), attr(result, "CustomPoints"))
+    chart.settings <- updateChartSettingsWithLabels(chart.settings, attr(result, "ChartLabels"),
+        attr(result, "CustomPoints"),
+        markers.at.every.point = identical(attr(result, "ChartType"), "Line Markers"))
 
     if (isScatter(chart.type))
     {
@@ -495,7 +497,8 @@ addLabels <- function(x, chart.type, chart.title, categories.title, values.title
     return(x)
 }
 
-updateChartSettingsWithLabels <- function(chart.settings, chart.labels, custom.points)
+updateChartSettingsWithLabels <- function(chart.settings, chart.labels, custom.points,
+                                          markers.at.every.point = FALSE)
 {
     if (!is.null(chart.labels))
     {
@@ -514,9 +517,29 @@ updateChartSettingsWithLabels <- function(chart.settings, chart.labels, custom.p
             chart.settings$TemplateSeries[[i]]$ShowDataLabels <- FALSE
     }
 
+    # Points numbered within their own series carry per-point marker visibility: the series
+    # turns its marker off and the points below switch it back on again. A globally numbered
+    # list is CombinedScatter's annotation borders, which say nothing about visibility, so it
+    # is left alone. A chart whose every point has a marker says so at series level instead,
+    # rather than repeating itself once per point.
+    # The absence of the attribute is how a flipStandardCharts without this feature presents,
+    # and it has to keep the old behaviour of a marker on every point.
+    per.series.markers <- identical(attr(custom.points, "IndexBase"), "series") &&
+                          !markers.at.every.point
+    series.marker.style <- list()
+    if (per.series.markers)
+        for (i in seq_along(chart.settings$TemplateSeries))
+        {
+            style.i <- chart.settings$TemplateSeries[[i]]$Marker$Style
+            series.marker.style[[i]] <- if (is.null(style.i)) NA_character_ else style.i
+            if (!is.null(chart.settings$TemplateSeries[[i]]$Marker))
+                chart.settings$TemplateSeries[[i]]$Marker$Style <- "None"
+        }
+
     # Update ChartSettings to incorporate annotation info from flipStandardCharts
     # that is stored in the CustomPoints attribute
-    # Currently this is only used to add annotation marker borders in CombinedScatter
+    # Used for annotation marker borders in CombinedScatter, and for per-point marker
+    # visibility in Line charts
     if (!is.null(custom.points) && any(sapply(custom.points, Negate(is.null))))
     {
         n.series <- min(length(chart.settings$TemplateSeries), length(custom.points))
@@ -550,6 +573,14 @@ updateChartSettingsWithLabels <- function(chart.settings, chart.labels, custom.p
                         chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$BackgroundColor <-
                         chart.settings$TemplateSeries[[i]]$BackgroundColor
                     }
+                    # The series' own symbol, which was replaced by "None" above so that only
+                    # the points listed here show a marker
+                    if (per.series.markers && !is.na(series.marker.style[[i]]) &&
+                        is.null(chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$Style))
+                    {
+                        chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$Style <-
+                        series.marker.style[[i]]
+                    }
                     k <- k + 1
                     next
                 }
@@ -564,6 +595,14 @@ updateChartSettingsWithLabels <- function(chart.settings, chart.labels, custom.p
                     chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$BackgroundColor <-
                     chart.settings$TemplateSeries[[i]]$Marker$BackgroundColor
                 }
+                # The series' own symbol, which was replaced by "None" above so that only
+                # the points listed here show a marker
+                if (per.series.markers && !is.na(series.marker.style[[i]]) &&
+                    is.null(chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$Style))
+                {
+                    chart.settings$TemplateSeries[[i]]$CustomPoints[[k]]$Marker$Style <-
+                    series.marker.style[[i]]
+                }
                 k <- k + 1
             }
         }
@@ -634,6 +673,17 @@ scatterAxisWarning <- function(data, user.args)
 }
 
 
+# Map plotly marker symbol names to PowerPoint marker styles
+# https://wiki.q-researchsoftware.com/wiki/PptMarkerSettings#Style
+markerSymbolToPPTStyle <- function(symbols)
+{
+    base <- sub("-open$", "", tolower(symbols))
+    lookup <- c(circle = "Circle", square = "Square", diamond = "Diamond")
+    out <- unname(lookup[base])
+    out[is.na(out)] <- "Circle"
+    out
+}
+
 getPPTSettings <- function(chart.type, args, data)
 {
     # Opacity is by default set to NULL in the javascript code
@@ -664,6 +714,14 @@ getPPTSettings <- function(chart.type, args, data)
     else if (!is.null(args$marker.border.opacity))
         tmp.line.style <- "Solid"
 
+    # Line type is per-series (comma-separated) for the charts whose line type is per series.
+    # Time Series takes one line type for the whole chart, so splitting it there would turn a
+    # single setting into a per-series one.
+    # Handle this separately in case args$line.type is null (from old gui controls)
+    if (chart.type %in% c("Line", "Radar"))
+        tmp.line.style <- ConvertCommaSeparatedStringToVector(tmp.line.style)
+    tmp.line.style <- rep(tmp.line.style, length = tmp.n)
+
     tmp.line.thickness <- 1
     if (chart.type %in% c("Line", "Radar", "Time Series"))
         tmp.line.thickness <- as.numeric(ConvertCommaSeparatedStringToVector(args$line.thickness))
@@ -682,6 +740,15 @@ getPPTSettings <- function(chart.type, args, data)
         tmp.line.color <- "#FFFFFF"
     tmp.line.color <- rep(tmp.line.color, length = tmp.n)
 
+    tmp.marker.size <- if (is.null(args$marker.size)) 6
+                       else as.numeric(ConvertCommaSeparatedStringToVector(args$marker.size))
+    tmp.marker.size <- rep(tmp.marker.size, length = tmp.n)
+
+    tmp.marker.symbols <- if (is.null(args$marker.symbols)) "Circle"
+                          else markerSymbolToPPTStyle(
+                              ConvertCommaSeparatedStringToVector(args$marker.symbols))
+    tmp.marker.symbols <- rep(tmp.marker.symbols, length = tmp.n)
+
     tmp.data.label.show <- isTRUE(args$data.label.show)
     tmp.data.label.show.category.labels <- FALSE
     if (isScatter(chart.type) && !isTRUE(args$scatter.labels.as.hovertext))
@@ -734,8 +801,8 @@ getPPTSettings <- function(chart.type, args, data)
         # When scatterplots use colors as a numerical scale
         # we can assume a single template series
         series.settings <- list(list(
-            CustomPoints = getColorsAsNumericScale(data, args$colors, tmp.opacity, args$marker.size),
-            Marker = list(Size = args$marker.size, OutlineStyle = "None"),
+            CustomPoints = getColorsAsNumericScale(data, args$colors, tmp.opacity, tmp.marker.size[1]),
+            Marker = list(Size = tmp.marker.size[1], OutlineStyle = "None"),
             ShowDataLabels = tmp.data.label.show,
             DataLabelsPosition = "Center",
             DataLabelsFont = list(family = args$data.label.font.family,
@@ -761,7 +828,7 @@ getPPTSettings <- function(chart.type, args, data)
             DataLabelsPosition = tmp.data.label.position,
             OutlineColor = tmp.line.color[1], # style is none if no border color defined
             OutlineWidth = tmp.line.thickness[1],
-            OutlineStyle = tmp.line.style))
+            OutlineStyle = tmp.line.style[1]))
 
     } else
         series.settings <- lapply(1:length(args$colors),
@@ -775,15 +842,20 @@ getPPTSettings <- function(chart.type, args, data)
             DataLabelsPosition = tmp.data.label.position,
             OutlineColor = tmp.line.color[i],
             OutlineWidth = tmp.line.thickness[i],
-            OutlineStyle = tmp.line.style)})
+            OutlineStyle = tmp.line.style[i])})
     tmp.n <- length(series.settings)
 
 
     if ((isScatter(chart.type) && isTRUE(args$scatter.colors.as.categorical)) || chart.type == "Line")
         for (i in 1:tmp.n)
-            series.settings[[i]]$Marker = list(Size = args$marker.size,
+        {
+            marker.i <- list(Size = tmp.marker.size[i],
                 OutlineStyle = "None",
                 BackgroundColor = getHexCode(args$colors[i], tmp.opacity))
+            if (chart.type == "Line")   # FS2-4532: per-series marker symbol (Line only)
+                marker.i$Style <- tmp.marker.symbols[i]
+            series.settings[[i]]$Marker <- marker.i
+        }
 
     # Initialise return output
     res <- list()
@@ -901,7 +973,15 @@ getPPTSettings <- function(chart.type, args, data)
             res$GapWidth = min(5.0, args$bar.gap / (1 - args$bar.gap)) * 100
     }
     if (chart.type == "Line")
-        res$Smooth = isTRUE(args$shape == "Curved")
+    {
+        # The shape can name one per series, so the whole-chart setting PowerPoint takes is
+        # decided by the first series, as the other collapsed settings here are. Comparing
+        # the argument as it arrived would read "Curved,Curved" as no series curved at all.
+        # Curved is what the controls send and spline is plotly's own name for it; the chart
+        # draws either as a curve, so the export has to treat them the same way.
+        tmp.shape <- ConvertCommaSeparatedStringToVector(args$shape)
+        res$Smooth = isTRUE(tolower(tmp.shape[1]) %in% c("curved", "spline"))
+    }
     if (chart.type %in% c("BarMultiColor", "ColumnMultiColor", "Pyramid", "Bar Pictograph") ||
         (isScatter(chart.type) && !isTRUE(args$scatter.colors.as.categorical)))
         res$ShowLegend <- FALSE

tests/testthat/test-chartsettings.R

@@ -130,7 +130,8 @@ test_that("Chart settings",
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[2]]$OutlineWidth, 1.5)
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[3]]$OutlineWidth, 2.25)
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[2]]$Marker,
-           list(Size = 10, OutlineStyle = "None", BackgroundColor = "#ED7D31FF"))
+           list(Size = 10, OutlineStyle = "None", BackgroundColor = "#ED7D31FF",
+                Style = "Circle"))
 
     res <- CChart("Radar", dat.2d, append.data = TRUE, colors = col.2d, line.thickness = 2)
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[1]]$BackgroundColor, "#5C9AD366")
@@ -143,6 +144,50 @@ test_that("Chart settings",
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[1]]$ShowCategoryNames, FALSE)
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[1]]$ShowDataLabels, FALSE)
 
+test_that("FS2-4532: Line PPT settings are per-series", {
+    res <- CChart("Line", dat.2d, append.data = TRUE, colors = col.2d,
+            line.type = "Solid,Dot", marker.show = TRUE,
+            marker.symbols = "circle,square", marker.size = "6,10,14")
+    ts <- attr(res, "ChartSettings")$TemplateSeries
+    expect_equal(ts[[1]]$OutlineStyle, "Solid")
+    expect_equal(ts[[2]]$OutlineStyle, "Dot")
+    expect_equal(ts[[3]]$OutlineStyle, "Solid")   # recycled
+    expect_equal(ts[[1]]$Marker$Style, "Circle")
+    expect_equal(ts[[2]]$Marker$Style, "Square")
+    expect_equal(ts[[3]]$Marker$Style, "Circle")  # recycled
+    expect_equal(ts[[1]]$Marker$Size, 6)
+    expect_equal(ts[[2]]$Marker$Size, 10)
+    expect_equal(ts[[3]]$Marker$Size, 14)
+})
+
+test_that("Radar PPT settings take a line type per series", {
+    # Radar reaches the OutlineStyle loop the same way Line does, so a comma-separated
+    # line type has to be split for it too rather than reaching PowerPoint as one string
+    res <- CChart("Radar", dat.2d, append.data = TRUE, colors = col.2d,
+                  line.type = "Solid,Dot")
+    ts <- attr(res, "ChartSettings")$TemplateSeries
+    expect_equal(ts[[1]]$OutlineStyle, "Solid")
+    expect_equal(ts[[2]]$OutlineStyle, "Dot")
+    expect_equal(ts[[3]]$OutlineStyle, "Solid")   # recycled
+})
+
+test_that("Radar line type reaches the chart as well as the export", {
+    # It used to be read for PowerPoint but dropped on the way to the chart, so a dotted
+    # radar exported dotted and rendered solid
+    expect_warning(CChart("Radar", dat.2d, append.data = TRUE, colors = col.2d,
+                          line.type = "Dot"), NA)
+})
+
+test_that("FS2-4532: scalar inputs still broadcast (old Plugins back-compat)", {
+    res <- CChart("Line", dat.2d, append.data = TRUE, colors = col.2d,
+            line.type = "Dash", marker.show = TRUE, marker.size = 8)
+    ts <- attr(res, "ChartSettings")$TemplateSeries
+    expect_equal(ts[[1]]$OutlineStyle, "Dash")
+    expect_equal(ts[[3]]$OutlineStyle, "Dash")
+    expect_equal(ts[[1]]$Marker$Size, 8)
+    expect_equal(ts[[3]]$Marker$Size, 8)
+})
+
     res <- CChart("Palm", abs(dat.2d), append.data = TRUE, colors = col.2d)
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[1]]$BackgroundColor, "#5C9AD366")
     expect_equal(attr(res, "ChartSettings")$TemplateSeries[[1]]$OutlineStyle, "Solid")
@@ -253,6 +298,21 @@ test_that("Chart settings",
     expect_equal(attr(res, "ChartSettings")$ValueAxis$Crosses, "Minimum")
 })
 
+test_that("FS2-4532: line type is only split per-series for the charts that support it", {
+    # Line and Radar both take a line type per series, so a comma-separated value is split
+    # across them. Time Series takes one line type for the whole chart, and splitting it
+    # there would turn a single setting into a per-series one.
+    dat <- matrix(1:6, 3, 2, dimnames = list(letters[1:3], c("A", "B")))
+    args <- list(colors = c("#FF0000", "#00AA00"), line.type = "Solid,Dot")
+    stylesFor <- function(chart.type)
+        vapply(getPPTSettings(chart.type, args, dat)$TemplateSeries,
+               function(s) s$OutlineStyle, character(1))
+
+    expect_equal(stylesFor("Line"), c("Solid", "Dot"))
+    expect_equal(stylesFor("Radar"), c("Solid", "Dot"))
+    expect_equal(stylesFor("Time Series"), c("Solid,Dot", "Solid,Dot"))
+})
+
 test_that("Scatter axes bounds",
 {
     dat1 <- structure(list(` ` = c(16.5292618516667, 0.479370604963302, 19.8251578509455,
@@ -381,3 +441,51 @@ test_that("getGridLineStyle handles missing/NA widths (RS-22447)",
     expect_equal(getGridLineStyle(NA, NULL), "Solid")
     expect_equal(getGridLineStyle(NULL, "Dot"), "Dot")
 })
+
+test_that("Smooth follows the first series' shape, whatever form the shape arrives in", {
+    dat <- matrix(1:6, 3, 2, dimnames = list(letters[1:3], c("A", "B")))
+    smoothFor <- function(shape) {
+        args <- list(colors = c("#FF0000", "#00AA00"))
+        if (!is.null(shape)) args$shape <- shape
+        getPPTSettings("Line", args, dat)$Smooth
+    }
+
+    # PowerPoint takes one setting for the whole chart, so a per-series shape has to pick
+    # one; the first series is the same series other chart-wide settings are taken from.
+    expect_true(smoothFor("Curved"))
+    expect_false(smoothFor("Straight"))
+
+    # The per-series forms: comma-separated as the Plugins send it, or a vector
+    expect_true(smoothFor("Curved,Curved"))
+    expect_true(smoothFor("Curved, Straight"))
+    expect_false(smoothFor("Straight,Curved"))
+    expect_true(smoothFor(c("Curved", "Straight")))
+    expect_false(smoothFor(c("Straight", "Curved")))
+
+    # Unset stays unsmoothed, and case does not matter
+    expect_false(smoothFor(NULL))
+    expect_true(smoothFor("curved"))
+
+    # Curved and Straight are what the controls send, but the chart also takes plotly's own
+    # names, and a chart drawn curved has to export curved whichever name asked for it
+    expect_true(smoothFor("spline"))
+    expect_true(smoothFor("Spline"))
+    expect_false(smoothFor("linear"))
+    expect_true(smoothFor("spline,linear"))
+    expect_false(smoothFor("linear,spline"))
+})
+
+test_that("Numeric series settings export from every form a chart may have been saved with", {
+    # The controls used to be a text box taking "6, 10, 14", and are now numeric ones, so a
+    # deck exported today may come from either. Both have to keep working.
+    dat <- matrix(1:9, 3, 3, dimnames = list(letters[1:3], c("A", "B", "C")))
+    sizesFor <- function(v)
+        vapply(getPPTSettings("Line", list(colors = c("#F00", "#0A0", "#00F"),
+                                           marker.size = v), dat)$TemplateSeries,
+               function(s) s$Marker$Size, numeric(1))
+
+    expect_equal(sizesFor("6,10,14"), c(6, 10, 14))       # old text box, per series
+    expect_equal(sizesFor(c(6, 10, 14)), c(6, 10, 14))    # new numeric controls, per series
+    expect_equal(sizesFor(10), c(10, 10, 10))             # new numeric control, chart wide
+    expect_equal(sizesFor("10"), c(10, 10, 10))           # old text box, chart wide
+})