From c1c64254c6c51512b0d7e922d1888bb54cf8f470 Mon Sep 17 00:00:00 2001 From: fpnaji Date: Mon, 19 Oct 2026 19:17:14 +0200 Subject: [PATCH 1/2] Bar stack/fill: one bar per cell in x order when no two values share an x 1.0.18 collapsed a cell into one stacked bar only without an x axis. With an x axis that gives every value its own position (e.g. the colour factor on x), stack and fill still drew separate bars, as ggplot had nothing to stack at any x. Collapse in that case too, ordering the stack by the x axis. When values share an x position, stacking per x is unchanged. Co-Authored-By: Claude Opus 5.5 --- utils.R | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/utils.R b/utils.R index 8290501..2477451 100644 --- a/utils.R +++ b/utils.R @@ -394,12 +394,17 @@ generate_plot <- ) } if (type == "ChartBar") { - if (!ctx$hasXAxis && input.par$bar.position %in% c("stack", "fill")) { - # No x axis: every value of a cell sits at its own crosstab - # position, so there is nothing at a shared x to stack or fill. - # Put the whole cell on one bar and stack it in crosstab order - # (first crosstab position at the bottom). - df_plot <- df_plot %>% mutate(.stack_level = .x, .x = 1) + # Stack and fill need values that share an x position. Without an + # x axis, or when the x axis gives every value of a cell its own + # position (e.g. the colour factor on x), nothing shares one: draw + # the whole cell as one bar instead, in x order (crosstab order + # without an x axis), the first position at the bottom. When values + # do share an x, ggplot stacks them per x position as before. + one_value_per_x <- !ctx$hasXAxis || + all(dplyr::count(df_plot, .ri, .ci, .x)$n == 1) + if (one_value_per_x && input.par$bar.position %in% c("stack", "fill")) { + df_plot <- df_plot %>% + mutate(.stack_level = as.integer(factor(.x)), .x = 1) stack_pos <- if (input.par$bar.position == "fill") { position_fill(reverse = TRUE) } else { From a23701d0c00b3832a95d8a9a568ada4bcb831aee Mon Sep 17 00:00:00 2001 From: fpnaji Date: Mon, 19 Oct 2026 19:35:03 +0200 Subject: [PATCH 2/2] Unit tests for bar placement, run in the operator image on every PR - utils.R: the bar placement moves into pure functions (crosstab_x_position, collapse_bars, stack_cells, bar_layer) so it can be tested without a Tercen context. The output is unchanged: 12 Studio projections (customer and synthetic data, x and no x, dodge/stack/fill) are pixel-identical before and after. - unit_tests/run.R: base-R checks (no testthat in the image) that build the bar layer and read back what ggplot computes: one bar per cell, stack order (crosstab order without x, x order with the colour on x), fill to 1, and plain ggplot behaviour when values share an x. Verified to fail on the 1.0.17 read order, the 1.0.18 no-x-only rule and an upside-down stack. - .github/workflows/unit-tests.yml: builds the image and runs the tests in it on pull requests and pushes to master. - README: how bar.position behaves, and how to run the tests. Co-Authored-By: Claude Opus 5.5 --- .github/workflows/unit-tests.yml | 24 ++++++ README.md | 20 +++++ unit_tests/run.R | 130 +++++++++++++++++++++++++++++++ utils.R | 130 +++++++++++++++++++------------ 4 files changed, 256 insertions(+), 48 deletions(-) create mode 100644 .github/workflows/unit-tests.yml create mode 100644 unit_tests/run.R diff --git a/.github/workflows/unit-tests.yml b/.github/workflows/unit-tests.yml new file mode 100644 index 0000000..2623007 --- /dev/null +++ b/.github/workflows/unit-tests.yml @@ -0,0 +1,24 @@ +name: Unit tests + +# Functional tests of the plotting logic (unit_tests/run.R), run inside the +# operator image built from this commit, so they use the same R and package +# versions a release ships. +on: + pull_request: + push: + branches: ['main', 'master'] + +jobs: + unit-tests: + runs-on: ubuntu-latest + steps: + - name: Checkout repository + uses: actions/checkout@v4 + - name: Build the operator image + run: docker build -t plot_operator:test . + - name: Run unit tests in the operator image + run: | + docker run --rm \ + -v "$PWD/unit_tests:/operator/unit_tests:ro" \ + --entrypoint R plot_operator:test \ + --no-save --slave -f unit_tests/run.R diff --git a/README.md b/README.md index 80c9191..f08d1ab 100644 --- a/README.md +++ b/README.md @@ -26,3 +26,23 @@ Output data|. ##### Details The operator maps the input data projected in Tercen to a ggplot chart. + +**Bar charts.** `bar.position` sets how the bars of a cell are drawn: + +* `dodge`: one bar per value, side by side. +* `stack` and `fill`: values that share an x position are stacked; `fill` scales each stack to 1. + When no two values of a cell share an x position (no x axis, or the colour factor on x), the + whole cell is drawn as one stacked bar, first position at the bottom. + +The order of the bars, and of the layers of a stacked cell, is the x axis order. Without an x +axis it is the crosstab order, by magnitude. + +##### Unit tests + +`unit_tests/run.R` checks the bar placement (order, stacking, fill) by building the bar layer and +reading back what ggplot computes. It runs in the operator image, on every pull request +(`.github/workflows/unit-tests.yml`) and locally: + + docker build -t plot_operator:test . + docker run --rm -v "$PWD/unit_tests:/operator/unit_tests:ro" \ + --entrypoint R plot_operator:test --no-save --slave -f unit_tests/run.R diff --git a/unit_tests/run.R b/unit_tests/run.R new file mode 100644 index 0000000..6fb3d4c --- /dev/null +++ b/unit_tests/run.R @@ -0,0 +1,130 @@ +# Unit tests for the bar placement in utils.R. +# +# Run inside the operator image, from /operator: +# docker build -t plot_operator:test . +# docker run --rm -v "$PWD/unit_tests:/operator/unit_tests:ro" \ +# --entrypoint R plot_operator:test --no-save --slave -f unit_tests/run.R +# +# Base R only (no testthat), so the production image needs nothing extra. Each +# test builds the bar layer the operator draws and reads back what ggplot +# computed (ggplot_build): positions, groups and stacked heights. +suppressPackageStartupMessages({ + library(dplyr) + library(ggplot2) +}) +source("utils.R") + +failures <- character() +check <- function(desc, expr) { + ok <- tryCatch(isTRUE(expr), error = function(e) { + message(" error: ", conditionMessage(e)) + FALSE + }) + cat(if (ok) "PASS " else "FAIL ", desc, "\n", sep = "") + if (!ok) failures <<- c(failures, desc) +} + +# Two cells, three labels each, values that do not sum to 1, in a scrambled read +# order. `xl` is the crosstab's .xLevels: ascending value within the cell. +cells <- data.frame( + .ri = c(0, 0, 0, 0, 0, 0), + .ci = c(0, 0, 0, 1, 1, 1), + label = c("C", "A", "B", "B", "C", "A"), + .y = c(5, 2, 9, 1, 4, 7), + xl = c(1, 0, 2, 0, 1, 2), + .axisIndex = 0L +) + +# The bars ggplot computes for the operator's bar layer, as generate_plot sets it +# up: the same global mapping and one panel per crosstab cell. +bars <- function(df, has_x_axis, bar_position, dodge_width = 0.8) { + collapsed <- collapse_bars(df, has_x_axis, bar_position) + if (collapsed) df <- stack_cells(df) + p <- suppressWarnings(ggplot(mapping = aes_string( + x = ".x", y = ".y", fill = "label", group = "label", order = "label" + ))) + + suppressWarnings(bar_layer(df, collapsed, bar_position, dodge_width, size = 0.5, color = "black")) + + facet_grid(.ri ~ .ci) + d <- suppressWarnings(layer_data(p, 1)) + d$height <- d$ymax - d$ymin + d +} + +# Labels of one panel from bottom to top, identified by their height (the test +# values are distinct within a cell). For fill, heights are shares of the total. +stack_order <- function(d, panel, df, ci, fill = FALSE) { + cell <- df[df$.ci == ci, ] + d <- d[d$PANEL == panel, ] + d <- d[order(d$ymin), ] + h <- if (fill) d$height * sum(cell$.y) else d$height + vapply(h, function(v) cell$label[which.min(abs(cell$.y - v))], "") +} + +no_x <- crosstab_x_position(cells, cells$xl) + +cat("-- x position without an x axis\n") +check("uses the crosstab position (.xLevels + 1)", identical(no_x$.x, as.integer(cells$xl) + 1L)) +fallback <- crosstab_x_position(cells) +check("falls back to read order per cell without .xLevels", + identical(fallback$.x, c(1L, 2L, 3L, 1L, 2L, 3L))) + +cat("-- when cells are drawn as one bar\n") +check("no x axis, stack: one bar per cell", collapse_bars(no_x, FALSE, "stack")) +check("no x axis, fill: one bar per cell", collapse_bars(no_x, FALSE, "fill")) +check("no x axis, dodge: separate bars", !collapse_bars(no_x, FALSE, "dodge")) +x_label <- mutate(cells, .x = label) +check("x = colour factor (one value per x), stack: one bar", collapse_bars(x_label, TRUE, "stack")) +check("x = colour factor, dodge: separate bars", !collapse_bars(x_label, TRUE, "dodge")) +by_day <- bind_rows(mutate(cells, .x = 1), mutate(cells, .x = 2, .y = .y + 1)) +check("numeric x with several values per x, stack: per-x stacking", !collapse_bars(by_day, TRUE, "stack")) +mixed <- bind_rows(mutate(cells[1:3, ], .x = 1), mutate(cells[4:6, ], .x = c(1, 2, 3))) +check("one cell with values sharing an x keeps per-x stacking", !collapse_bars(mixed, TRUE, "stack")) + +cat("-- no x axis\n") +d <- bars(no_x, FALSE, "stack") +check("stack: one bar per cell", all(table(d$PANEL) == 3) && all(tapply(d$x, d$PANEL, function(v) length(unique(v))) == 1)) +check("stack: bar height is the cell total", isTRUE(all.equal(as.vector(tapply(d$ymax, d$PANEL, max)), c(16, 12)))) +check("stack: smallest value at the bottom (crosstab order), cell 1", + identical(stack_order(d, 1, no_x, 0), c("A", "C", "B"))) +check("stack: smallest value at the bottom (crosstab order), cell 2", + identical(stack_order(d, 2, no_x, 1), c("B", "C", "A"))) +d <- bars(no_x, FALSE, "fill") +check("fill: every bar reaches 1", isTRUE(all.equal(as.vector(tapply(d$ymax, d$PANEL, max)), c(1, 1)))) +check("fill: same order as stack", identical(stack_order(d, 1, no_x, 0, fill = TRUE), c("A", "C", "B"))) +d <- bars(no_x, FALSE, "dodge") +p1 <- d[d$PANEL == 1, ] +check("dodge: one bar per value, ordered by magnitude", identical(p1$height[order(p1$x)], c(2, 5, 9))) + +cat("-- x axis = the colour factor\n") +d <- bars(x_label, TRUE, "stack") +check("stack: one bar per cell", all(tapply(d$x, d$PANEL, function(v) length(unique(v))) == 1)) +check("stack: in x-axis order, first at the bottom, cell 1", + identical(stack_order(d, 1, x_label, 0), c("A", "B", "C"))) +check("stack: in x-axis order, first at the bottom, cell 2", + identical(stack_order(d, 2, x_label, 1), c("A", "B", "C"))) +d <- bars(x_label, TRUE, "fill") +check("fill: every bar reaches 1, in x-axis order", + isTRUE(all.equal(as.vector(tapply(d$ymax, d$PANEL, max)), c(1, 1))) && + identical(stack_order(d, 2, x_label, 1, fill = TRUE), c("A", "B", "C"))) + +cat("-- x axis with values sharing an x: plain ggplot behaviour\n") +plain <- function(df, position) { + p <- suppressWarnings(ggplot(mapping = aes_string( + x = ".x", y = ".y", fill = "label", group = "label", order = "label" + ))) + + suppressWarnings(geom_bar(data = df, position = position, stat = "identity", size = 0.5, width = 0.5, color = "black")) + + facet_grid(.ri ~ .ci) + suppressWarnings(layer_data(p, 1)) +} +same_bars <- function(a, b) { + cols <- c("PANEL", "x", "xmin", "xmax", "ymin", "ymax", "group") + isTRUE(all.equal(a[cols], b[cols], check.attributes = FALSE)) +} +check("stack: one stacked bar per x, as ggplot", same_bars(bars(by_day, TRUE, "stack"), plain(by_day, "stack"))) +check("fill: as ggplot", same_bars(bars(by_day, TRUE, "fill"), plain(by_day, "fill"))) +check("dodge: as ggplot", same_bars(bars(by_day, TRUE, "dodge", 0.8), plain(by_day, position_dodge(width = 0.8)))) +check("dodge with x = colour factor: as ggplot", + same_bars(bars(x_label, TRUE, "dodge", 0.8), plain(x_label, position_dodge(width = 0.8)))) + +cat("\n", length(failures), " failed\n", sep = "") +if (length(failures)) quit(status = 1) diff --git a/utils.R b/utils.R index 2477451..9b5fee4 100644 --- a/utils.R +++ b/utils.R @@ -187,14 +187,11 @@ getValues <- function(ctx, is_2d_histogram = FALSE) { # view shows them (by magnitude). Counting rows here instead gave whatever # order the table was read in. qt_names <- unlist(lapply(ctx$schema$columns, "[[", "name")) + x_levels <- NULL if (!ctx$isPairwise && ".xLevels" %in% qt_names) { - data$.x <- as.integer(select(ctx, .xLevels)[[".xLevels"]]) + 1L - } else { - data <- data %>% - group_by(.ci, .ri) %>% - mutate(.x = row_number()) %>% - ungroup() + x_levels <- select(ctx, .xLevels)[[".xLevels"]] } + data <- crosstab_x_position(data, x_levels) } if (length(ctx$colors)) @@ -258,6 +255,75 @@ getValues <- function(ctx, is_2d_histogram = FALSE) { +##### +### Bar placement +# Pure functions (a data frame in, a data frame or a ggplot layer out) so that +# unit_tests/ can check them without a Tercen context. + +# x position of each value when the projection has no x axis. `x_levels` is the +# crosstab's own position per cell (`.xLevels`, 0-based, by magnitude), so the +# bars follow the crosstab view. Without it (pairwise projections), values are +# numbered in read order within each cell. +crosstab_x_position <- function(data, x_levels = NULL) { + if (!is.null(x_levels)) { + data$.x <- as.integer(x_levels) + 1L + return(data) + } + data %>% + group_by(.ci, .ri) %>% + mutate(.x = row_number()) %>% + ungroup() +} + +# Stack and fill need values that share an x position. Without an x axis, or +# when the x axis gives every value of a cell its own position (e.g. the colour +# factor on x), nothing shares one: the whole cell is then drawn as one bar. +# When values do share an x, ggplot stacks them per x position. +collapse_bars <- function(df, has_x_axis, bar_position) { + if (!bar_position %in% c("stack", "fill")) return(FALSE) + !has_x_axis || all(dplyr::count(df, .ri, .ci, .x)$n == 1) +} + +# One bar per cell: stack in x order (crosstab order without an x axis). +stack_cells <- function(df) { + df %>% mutate(.stack_level = as.integer(factor(.x)), .x = 1) +} + +# The bar layer. A collapsed cell stacks its values first position at the +# bottom; otherwise the position is the bar.position setting. +bar_layer <- function(df, collapsed, bar_position, dodge_width, size, color) { + if (collapsed) { + pos <- if (bar_position == "fill") { + position_fill(reverse = TRUE) + } else { + position_stack(reverse = TRUE) + } + return(geom_bar( + data = df, + mapping = aes(group = .stack_level), + position = pos, + stat = "identity", + size = size, + width = 0.5, + color = color + )) + } + pos <- switch( + bar_position, + "dodge" = position_dodge(width = dodge_width), + "stack" = "stack", + "fill" = "fill" + ) + geom_bar( + data = df, + position = pos, + stat = "identity", + size = size, + width = 0.5, + color = color + ) +} + get_axis_labels <- function(ctx, lab, type) { nms <- switch( type, @@ -350,13 +416,6 @@ generate_plot <- ) ) - pos <- switch ( - input.par$bar.position, - "dodge" = position_dodge(width = input.par$dodge.width), - "stack" = "stack", - "fill" = "fill" - ) - for (j in seq_along(chart_types)) { type <- chart_types[j] df_plot <- df %>% filter(.axisIndex == j - 1L) @@ -394,41 +453,16 @@ generate_plot <- ) } if (type == "ChartBar") { - # Stack and fill need values that share an x position. Without an - # x axis, or when the x axis gives every value of a cell its own - # position (e.g. the colour factor on x), nothing shares one: draw - # the whole cell as one bar instead, in x order (crosstab order - # without an x axis), the first position at the bottom. When values - # do share an x, ggplot stacks them per x position as before. - one_value_per_x <- !ctx$hasXAxis || - all(dplyr::count(df_plot, .ri, .ci, .x)$n == 1) - if (one_value_per_x && input.par$bar.position %in% c("stack", "fill")) { - df_plot <- df_plot %>% - mutate(.stack_level = as.integer(factor(.x)), .x = 1) - stack_pos <- if (input.par$bar.position == "fill") { - position_fill(reverse = TRUE) - } else { - position_stack(reverse = TRUE) - } - plt <- plt + geom_bar( - data = df_plot, - mapping = aes(group = .stack_level), - position = stack_pos, - stat = "identity", - size = 0.5 * chart_sizes[j] / size_scale_factor, - width = 0.5, - color = default_color - ) - } else { - plt <- plt + geom_bar( - data = df_plot, - position = pos, - stat = "identity", - size = 0.5 * chart_sizes[j] / size_scale_factor, - width = 0.5, - color = default_color - ) - } + collapsed <- collapse_bars(df_plot, ctx$hasXAxis, input.par$bar.position) + if (collapsed) df_plot <- stack_cells(df_plot) + plt <- plt + bar_layer( + df_plot, + collapsed = collapsed, + bar_position = input.par$bar.position, + dodge_width = input.par$dodge.width, + size = 0.5 * chart_sizes[j] / size_scale_factor, + color = default_color + ) } if (type == "2D_Histogram") { plt <- plt + geom_rect(