diff --git a/.circleci/config.yml b/.circleci/config.yml index a8965b0..53b39eb 100644 --- a/.circleci/config.yml +++ b/.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: "" diff --git a/DESCRIPTION b/DESCRIPTION index 3d8ca98..614abf4 100644 --- a/DESCRIPTION +++ b/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 Maintainer: Displayr 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, diff --git a/R/cchart.R b/R/cchart.R index 03d6cf4..34cc97c 100644 --- a/R/cchart.R +++ b/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 diff --git a/tests/testthat/test-chartsettings.R b/tests/testthat/test-chartsettings.R index c4248e3..3c0d612 100644 --- a/tests/testthat/test-chartsettings.R +++ b/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 +}) diff --git a/tests/testthat/test-markerppt.R b/tests/testthat/test-markerppt.R new file mode 100644 index 0000000..7dcf04f --- /dev/null +++ b/tests/testthat/test-markerppt.R @@ -0,0 +1,74 @@ +context("Per-point markers in the PPT export") + +# flipStandardCharts reports which points of a Line chart show a marker, in the CustomPoints +# attribute. These check that the export turns that into per-point PptMarkerSettings rather +# than putting a marker on every point. + +set.seed(12345) +dat.2d <- matrix(rnorm(5 * 2), 5, 2, dimnames = list(letters[1:5], c("A", "B"))) +col.2d <- c("#5C9AD3", "#ED7D31") + +seriesOf <- function(...) + attr(CChart("Line", dat.2d, append.data = TRUE, colors = col.2d, ...), + "ChartSettings")$TemplateSeries + +indicesOf <- function(s) vapply(s$CustomPoints, function(p) p$Index, numeric(1)) +stylesOf <- function(s) vapply(s$CustomPoints, function(p) p$Marker$Style, character(1)) + +test_that("Markers everywhere stay a series-level setting", { + ts <- seriesOf(marker.show = TRUE, marker.size = 8) + expect_equal(ts[[1]]$Marker$Style, "Circle") + expect_equal(ts[[1]]$Marker$Size, 8) + expect_length(ts[[1]]$CustomPoints, 0) + expect_length(ts[[2]]$CustomPoints, 0) +}) + +test_that("A Line chart with no markers turns them off at series level", { + ts <- seriesOf(marker.show = FALSE) + expect_equal(ts[[1]]$Marker$Style, "None") + expect_equal(ts[[2]]$Marker$Style, "None") + expect_length(ts[[1]]$CustomPoints, 0) +}) + +test_that("Markers at ends are off by default and switched on at the end points", { + ts <- seriesOf(marker.show.at.ends = TRUE, marker.size = 8) + expect_equal(ts[[1]]$Marker$Style, "None") + expect_equal(indicesOf(ts[[1]]), c(0, 4)) + expect_equal(stylesOf(ts[[1]]), c("Circle", "Circle")) + expect_equal(ts[[1]]$CustomPoints[[1]]$Marker$Size, 8) + + # Numbered within the series, so series 2 repeats 0 and 4 rather than continuing + expect_equal(indicesOf(ts[[2]]), c(0, 4)) +}) + +test_that("Markers at the last end switch on a single point per series", { + ts <- seriesOf(marker.show.at.last.end = TRUE, marker.size = 8) + expect_equal(ts[[1]]$Marker$Style, "None") + expect_equal(indicesOf(ts[[1]]), 4) + expect_equal(indicesOf(ts[[2]]), 4) +}) + +test_that("Each series keeps its own marker symbol on its custom points", { + ts <- seriesOf(marker.show.at.ends = TRUE, marker.symbols = "circle,square") + expect_equal(stylesOf(ts[[1]]), c("Circle", "Circle")) + expect_equal(stylesOf(ts[[2]]), c("Square", "Square")) +}) + +test_that("A chart from an older flipStandardCharts keeps markers on every point", { + # No CustomPoints attribute at all is how a build without this feature presents, and it + # must not be read as "no markers anywhere" + settings <- list(TemplateSeries = list( + list(Marker = list(Style = "Circle", Size = 6), BackgroundColor = "#5C9AD3"))) + out <- updateChartSettingsWithLabels(settings, NULL, NULL) + expect_equal(out$TemplateSeries[[1]]$Marker$Style, "Circle") +}) + +test_that("Globally numbered custom points are left alone", { + # CombinedScatter numbers its points across the chart and has no per-point marker + # visibility; only a list marked as series-numbered drives markers off at series level. + settings <- list(TemplateSeries = list( + list(Marker = list(Style = "Circle", Size = 6), BackgroundColor = "#5C9AD3"))) + scatter.points <- list(list(list(Index = 2, OutlineColor = "#FF0000", OutlineWidth = 2))) + out <- updateChartSettingsWithLabels(settings, NULL, scatter.points) + expect_equal(out$TemplateSeries[[1]]$Marker$Style, "Circle") +})