diff --git a/.circleci/config.yml b/.circleci/config.yml index 3a47253..36a54c4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -7,7 +7,7 @@ parameters: default: "" remote-deps: type: string - default: Displayr/rhtmlCombinedScatter@1.2.2,Displayr/flipStandardCharts@1.32.15 + default: Displayr/rhtmlCombinedScatter@1.2.2,Displayr/flipStandardCharts@1.32.18 plugins-branch: type: string default: "" diff --git a/DESCRIPTION b/DESCRIPTION index bf8d67e..c654afe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flipChart Type: Package Title: Single function for calling charts - CChart -Version: 1.12.15 +Version: 1.12.16 Author: Displayr Maintainer: Displayr Description: Wrapper for other chart functions, such that they can be access via a diff --git a/R/cchart.R b/R/cchart.R index c75d9fe..df9b1bf 100644 --- a/R/cchart.R +++ b/R/cchart.R @@ -939,6 +939,9 @@ getPPTSettings <- function(chart.type, args, data) categories.axis.line <- if (!isTRUE(args$values.zero.line.width > 0)) list(width = args$categories.line.width, color = args$categories.line.color, crosses = default.cross) else list(width = args$values.zero.line.width, color = args$values.zero.line.color, dash = args$values.zero.line.dash, crosses = "AutoZero") + category.label.position <- categoryAxisLabelPosition(chart.type, args, data, + categories.axis.line$crosses) + res$PrimaryAxis = list(LabelsFont = list(color = args$categories.tick.font.color, family = args$categories.tick.font.family, size = px2pt(args$categories.tick.font.size)), @@ -954,7 +957,7 @@ 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)), - LabelPosition = "Low") + LabelPosition = category.label.position) if (any(nzchar(args$categories.bounds.maximum))) res$PrimaryAxis$Maximum <- args$categories.bounds.maximum if (any(nzchar(args$categories.bounds.minimum))) @@ -1068,6 +1071,52 @@ getPPTSettings <- function(chart.type, args, data) } +# Where the category axis tick labels go in a PowerPoint export. +# +# PowerPoint draws "NextTo" labels against the axis line, which sits at value 0 whenever the axis +# crosses AutoZero, so anything reaching below zero runs over them. "Low" pins them to the low end +# instead, as Q does for its negative stacked plots (PptChartSettingsAndLabels). Values can reach +# below the axis without appearing in the data, so each test below errs towards "Low" when it +# cannot tell: that is the behaviour this replaced, and it cannot cause the overlap. +categoryAxisLabelPosition <- function(chart.type, args, data, crosses) +{ + # Anywhere else the axis line is already at the low end, so the two agree. + if (!identical(crosses, "AutoZero")) + return("NextTo") + + # data can be a list - grouped distribution charts, link-to-multiple-tables inputs - so + # flatten it rather than coerce. Dates go first; they unlist to day counts. + plotted <- if (inherits(data, c("Date", "POSIXt"))) NULL + else if (is.data.frame(data)) data[!vapply(data, inherits, logical(1), what = c("Date", "POSIXt"))] + else data + # Only the primary (first) plane is drawn as bars/markers - flipStandardCharts uses the later + # planes for annotations - so nothing outside plane 1 can reach below the axis. The later + # planes are still exported (removeSignifAndCharData keeps them for those annotations), so + # read plane 1 rather than the whole array. + if (length(dim(plotted)) == 3) + { + plotted <- plotted[, , 1] + } + plotted.values <- suppressWarnings(as.numeric(unlist(plotted, use.names = FALSE))) + + # Read the bound as the chart does - charToNumeric strips spaces and thousands separators, and + # treats NA, "" and unparseable text as unset. Test the parsed number, never the text: a blank + # box arrives as NA, and nzchar(NA) is TRUE, so text would read as a floor. The arg is a single + # text box (NULL or length 1), so isTRUE() on the parsed number is enough - the any(nzchar()) + # calls in getPPTSettings() are there to survive length 0, not to handle longer vectors. + values.minimum <- suppressWarnings(as.numeric(gsub("[ ,]", "", as.character(args$values.bounds.minimum)))) + # setScatterAxesBounds runs after this and pads the floor below zero for plenty of positive Y + # ranges - [5, 95] gives -10 - so an unpinned scatter floor could be anywhere. + scatter.floor.unknown <- isScatter(chart.type) && !isTRUE(values.minimum >= 0) + # StackedColumnWithStatisticalSignificance negates the first n columns itself, so those values + # sit below the axis without ever appearing in the data seen here. + categories.below.axis <- isTRUE(args$num.categories.below.axis > 0) + + plots.below.axis <- isTRUE(values.minimum < 0) || scatter.floor.unknown || categories.below.axis || + (any(plotted.values < 0, na.rm = TRUE) && !isTRUE(values.minimum >= 0)) + if (plots.below.axis) "Low" else "NextTo" +} + getLineStyle <- function (line) { if (is.null(line$width) || line$width <= 0) return ("None") diff --git a/tests/testthat/test-chartsettings.R b/tests/testthat/test-chartsettings.R index 46d2b5e..0f0037a 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"), LabelPosition = "Low")) + Width = 0, Style = "None"), LabelPosition = "NextTo")) 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"), LabelPosition = "Low")) + Width = 0, Style = "None"), LabelPosition = "NextTo")) expect_equal(attr(res, "ChartSettings")$ValueAxis, list( LabelsFont = list(color = NULL, family = NULL, size = numeric(0)), ShowTitle = FALSE, @@ -529,3 +529,99 @@ test_that("Every plotly family PowerPoint has a style for is mapped", { "y-up", "line-ew", "arrow-up")), rep("Circle", 7)) }) + +test_that("Category axis labels drop to the low end when the plot goes below the axis", +{ + # The category axis crosses at zero, so "NextTo" labels would sit on top of anything + # drawn below it. dat.2d is rnorm and straddles zero; abs() of it does not. + negative <- CChart("Column", dat.2d, append.data = TRUE, colors = col.2d) + expect_equal(attr(negative, "ChartSettings")$PrimaryAxis$Crosses, "AutoZero") + expect_equal(attr(negative, "ChartSettings")$PrimaryAxis$LabelPosition, "Low") + + positive <- CChart("Column", abs(dat.2d), append.data = TRUE, colors = col.2d) + expect_equal(attr(positive, "ChartSettings")$PrimaryAxis$LabelPosition, "NextTo") + + # A user-set minimum below zero drops the plot below the axis even when the data doesn't. + stretched <- CChart("Column", abs(dat.2d), append.data = TRUE, colors = col.2d, + values.bounds.minimum = -3) + expect_equal(attr(stretched, "ChartSettings")$PrimaryAxis$LabelPosition, "Low") + + # ... and a minimum at or above zero clips the plot there, so negatives never reach below it. + clipped <- CChart("Column", dat.2d, append.data = TRUE, colors = col.2d, + values.bounds.minimum = 0) + expect_equal(attr(clipped, "ChartSettings")$PrimaryAxis$LabelPosition, "NextTo") + + # Distribution charts split by a group hand getPPTSettings a list of unequal-length vectors, + # which as.matrix turns into a list-matrix that as.numeric cannot coerce - an error, not a + # warning, so it would take CChart down with it rather than just the export settings. + grouped <- CChart("Histogram", list(x = 1:10, y = c(-1, 2, 3)), append.data = TRUE) + expect_equal(attr(grouped, "ChartSettings")$PrimaryAxis$LabelPosition, "Low") + + # The bound is read the way the chart reads it, so a thousands separator still counts as a + # floor below the axis. Plain as.numeric would give NA here and leave the labels in the plot. + separated <- CChart("Column", abs(dat.2d), append.data = TRUE, colors = col.2d, + values.bounds.minimum = "-5,000") + expect_equal(attr(separated, "ChartSettings")$PrimaryAxis$LabelPosition, "Low") + + # A blank bound box arrives as NA, and nzchar(NA) is TRUE, so testing the text rather than the + # parsed number would treat every blank bound as a floor and leave the labels at the low end. + blank <- CChart("Column", abs(dat.2d), append.data = TRUE, colors = col.2d, + values.bounds.minimum = NA) + expect_equal(attr(blank, "ChartSettings")$PrimaryAxis$LabelPosition, "NextTo") + + # The chart discards a bound it cannot parse and ranges from the data, so treat it as not set. + unreadable <- CChart("Column", abs(dat.2d), append.data = TRUE, colors = col.2d, + values.bounds.minimum = "not a number") + expect_equal(attr(unreadable, "ChartSettings")$PrimaryAxis$LabelPosition, "NextTo") + + + # StackedColumnWithStatisticalSignificance requires all-positive input and negates the first n + # columns itself, so the values that end up below the axis are never visible in the data the + # axis guard inspects - only in the ChartData the chart function exports. Asserting on that + # ChartData is what ties the two together: if the argument stopped reaching the chart, the + # negatives would disappear and this would fail rather than quietly still passing. + below.axis <- CChart("StackedColumnWithStatisticalSignificance", abs(dat.2d), + append.data = TRUE, num.categories.below.axis = 2) + expect_true(any(attr(below.axis, "ChartData") < 0, na.rm = TRUE)) + expect_equal(attr(below.axis, "ChartSettings")$PrimaryAxis$LabelPosition, "Low") + + none.below.axis <- CChart("StackedColumnWithStatisticalSignificance", abs(dat.2d), + append.data = TRUE, num.categories.below.axis = 0) + expect_false(any(attr(none.below.axis, "ChartData") < 0, na.rm = TRUE)) + expect_equal(attr(none.below.axis, "ChartSettings")$PrimaryAxis$LabelPosition, "NextTo") +}) + +test_that("Category axis label position handles the shapes data arrives in", +{ + position <- function(data, minimum = NULL, chart.type = "Column", below = NULL) + flipChart:::categoryAxisLabelPosition(chart.type, + list(values.bounds.minimum = minimum, num.categories.below.axis = below), + data, "AutoZero") + + # A list of unequal-length vectors, as grouped distribution charts supply. + expect_equal(position(list(x = 1:10, y = c(-1, 2, 3))), "Low") + expect_equal(position(list(x = 1:10, y = c(1, 2, 3))), "NextTo") + + # Dates unlist to day counts, negative before 1970, and say nothing about the value axis. + expect_equal(position(data.frame(d = as.Date(c("1960-01-01", "1985-06-01")), v = c(1, 2))), "NextTo") + expect_equal(position(as.Date("1960-01-01")), "NextTo") + + # Only the first plane of a multi-statistic table is plotted; z-Statistic is not. + stats <- array(c(10, 20, 30, 40, -1.5, 2, -0.3, 1.1), dim = c(2, 2, 2), + dimnames = list(c("r1", "r2"), c("c1", "c2"), c("Column %", "z-Statistic"))) + expect_equal(position(stats), "NextTo") + + # The bound is read as the chart reads it, and anything it cannot read counts as unset. + expect_equal(position(matrix(1:6, 2), "-5,000"), "Low") + expect_equal(position(matrix(1:6, 2), "5 000"), "NextTo") + expect_equal(position(matrix(1:6, 2), NA), "NextTo") + expect_equal(position(matrix(1:6, 2), "abc"), "NextTo") + expect_equal(position(matrix(c(1, -2, 3, 4, 5, 6), 2), 0), "NextTo") + + # An unpinned scatter floor is padded below zero later, so it cannot be ruled out. + expect_equal(position(data.frame(x = c(1, 2), y = c(5, 95)), NA, "Scatter"), "Low") + expect_equal(position(data.frame(x = c(1, 2), y = c(5, 95)), 0, "Scatter"), "NextTo") + + # An axis the chart draws elsewhere is already at the low end, so the two agree. + expect_equal(flipChart:::categoryAxisLabelPosition("Column", list(), matrix(c(-1, 2), 1), "Minimum"), "NextTo") +})