From 976009548d55db581219319738ad1e64c6f22729 Mon Sep 17 00:00:00 2001 From: Faris Naji Date: Wed, 30 Sep 2026 12:24:44 +0200 Subject: [PATCH 1/4] Fix 1-D facet_wrap: use strip.position instead of defunct switch facet_wrap(switch=) was deprecated in ggplot2 2.2.0 and is defunct in the ggplot2 shipped in the 1.0.17 image, so every plot with a single facet dimension and wrap.1d=true (the default) fails with 'The `switch` argument of `facet_wrap()` ... is now defunct'. strip.position = "left" keeps the row labels on the left as before. Co-Authored-By: Claude Opus 5.5 --- utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils.R b/utils.R index 9b5fee4..aafe349 100644 --- a/utils.R +++ b/utils.R @@ -118,7 +118,7 @@ get_facet_formula <- function(ctx, wrap.1d, scales_mode) { ~ .ri + .ci, labeller = labeller(.ri = row_labs, .ci = col_labs), scales = scales_mode, - switch = "y", + strip.position = "left", # facet_wrap(switch=) is defunct since ggplot2 3.5 drop = TRUE ) } else { From a1485ac9a363406a389332200311dcf1db6ccdaa Mon Sep 17 00:00:00 2001 From: fpnaji Date: Mon, 19 Oct 2026 19:56:00 +0200 Subject: [PATCH 2/4] Unit tests for the facet layouts (wrapped 1-D facets draw) Builds the facet for a stand-in context and draws the whole chart, for columns only and rows only with wrap.1d, no wrap, and rows x columns. The wrapped cases fail on the defunct facet_wrap(switch=) with the error a customer hit on tercen.com, and pass with strip.position. Co-Authored-By: Claude Opus 5.5 --- unit_tests/run.R | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/unit_tests/run.R b/unit_tests/run.R index 6fb3d4c..2317715 100644 --- a/unit_tests/run.R +++ b/unit_tests/run.R @@ -126,5 +126,46 @@ check("dodge: as ggplot", same_bars(bars(by_day, TRUE, "dodge", 0.8), plain(by_d 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("-- facets\n") +# get_facet_formula needs only the factor names and the facet values of the +# context; a list stands in for it. +fake_ctx <- function(rnames, cnames, rows, cols) { + list( + rnames = as.list(rnames), cnames = as.list(cnames), + rselect = function(...) tibble::as_tibble(rows), + cselect = function(...) tibble::as_tibble(cols) + ) +} +# The facet for a context, or NULL when building it fails (reported, not fatal). +facet_for <- function(ctx, wrap, scales = "fixed") { + tryCatch(get_facet_formula(ctx, wrap.1d = wrap, scales_mode = scales), + error = function(e) { message(" error: ", conditionMessage(e)); NULL }) +} +# Draws the whole chart (build + gtable), so errors raised at draw time count. +draws <- function(facet, df) { + p <- suppressWarnings(ggplot(df, aes(x = .x, y = .y)) + geom_bar(stat = "identity") + facet) + if (is.null(facet)) return(FALSE) + ok <- tryCatch({ suppressWarnings(ggplot_gtable(ggplot_build(p))); TRUE }, + error = function(e) { message(" error: ", conditionMessage(e)); FALSE }) + ok +} +cols_only <- fake_ctx("", c("Donor", "Sample"), data.frame(), + data.frame(Donor = c("D1", "D1", "D2"), Sample = c("S1", "S2", "S1"))) +df_1d <- data.frame(.ri = 0, .ci = c(0, 1, 2), .x = 1, .y = c(1, 2, 3)) +f <- facet_for(cols_only, TRUE) +check("columns only, wrap.1d: wrapped panels", inherits(f, "FacetWrap")) +check("columns only, wrap.1d: the chart draws", draws(f, df_1d)) +check("columns only, wrap.1d: strips on the left", identical(f$params$strip.position, "left")) +rows_only <- fake_ctx("Sample", "", data.frame(Sample = c("S1", "S2", "S3")), data.frame()) +df_rows <- data.frame(.ri = c(0, 1, 2), .ci = 0, .x = 1, .y = c(1, 2, 3)) +check("rows only, wrap.1d: the chart draws", + draws(facet_for(rows_only, TRUE, "free_y"), df_rows)) +check("columns only, no wrap: a grid that draws", + draws(facet_for(cols_only, FALSE), df_1d)) +both <- fake_ctx("Group", "Sample", data.frame(Group = c("G1", "G2")), data.frame(Sample = c("S1", "S2"))) +df_2d <- data.frame(.ri = c(0, 0, 1, 1), .ci = c(0, 1, 0, 1), .x = 1, .y = 1:4) +f <- facet_for(both, TRUE) +check("rows and columns: a grid that draws", inherits(f, "FacetGrid") && draws(f, df_2d)) + cat("\n", length(failures), " failed\n", sep = "") if (length(failures)) quit(status = 1) From b2c15f53e5dcc2491283790b9d7509c638b465f4 Mon Sep 17 00:00:00 2001 From: fpnaji Date: Mon, 19 Oct 2026 20:00:33 +0200 Subject: [PATCH 3/4] Default theme: minimal (was light) Plus a unit test that every EnumeratedProperty default is one of its values and every theme value is a ggplot2 theme. Co-Authored-By: Claude Opus 5.5 --- operator.json | 2 +- unit_tests/run.R | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/operator.json b/operator.json index 63b91d7..7308afc 100644 --- a/operator.json +++ b/operator.json @@ -113,7 +113,7 @@ { "kind": "EnumeratedProperty", "name": "theme", - "defaultValue": "light", + "defaultValue": "minimal", "values": [ "gray", "bw", diff --git a/unit_tests/run.R b/unit_tests/run.R index 2317715..c2c331e 100644 --- a/unit_tests/run.R +++ b/unit_tests/run.R @@ -167,5 +167,16 @@ df_2d <- data.frame(.ri = c(0, 0, 1, 1), .ci = c(0, 1, 0, 1), .x = 1, .y = 1:4) f <- facet_for(both, TRUE) check("rows and columns: a grid that draws", inherits(f, "FacetGrid") && draws(f, df_2d)) +cat("-- operator.json settings\n") +props <- jsonlite::read_json("operator.json")$properties +enum <- Filter(function(p) p$kind == "EnumeratedProperty", props) +for (p in enum) { + check(paste0(p$name, ": the default is one of its values"), p$defaultValue %in% unlist(p$values)) +} +theme <- Find(function(p) p$name == "theme", props) +check("theme: minimal by default", identical(theme$defaultValue, "minimal")) +check("theme: every value is a ggplot2 theme", + all(vapply(unlist(theme$values), function(t) exists(paste0("theme_", t), mode = "function"), TRUE))) + cat("\n", length(failures), " failed\n", sep = "") if (length(failures)) quit(status = 1) From e36f21d0a3bde67b7c830a945b98d2ba8d3f371e Mon Sep 17 00:00:00 2001 From: fpnaji Date: Mon, 19 Oct 2026 20:06:30 +0200 Subject: [PATCH 4/4] Output file name: __plot by default file.name.prefix now defaults to empty, which names the image (and the zip of a multi-image run) after the step: __plot, with spaces, slashes and other unsafe characters as '_'. The old default Tercen_Plot, which every existing step stores, is treated the same way; a prefix set by the user is kept. Unit tests for the naming. Co-Authored-By: Claude Opus 5.5 --- README.md | 5 +++++ main.R | 4 +++- operator.json | 4 ++-- unit_tests/run.R | 15 +++++++++++++++ utils.R | 33 +++++++++++++++++++++++++++++++-- 5 files changed, 56 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index f08d1ab..70a536f 100644 --- a/README.md +++ b/README.md @@ -37,6 +37,11 @@ The operator maps the input data projected in Tercen to a ggplot chart. 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. +**Output file name.** The image is named `__plot.png`. Spaces, slashes +and other characters that do not belong in a file name become `_`. Set `file.name.prefix` to use +your own name instead. With several images (`split_cells`, or a page factor) each image is +`__.png` and all of them are also in `.zip`. + ##### Unit tests `unit_tests/run.R` checks the bar placement (order, stacking, fill) by building the bar layer and diff --git a/main.R b/main.R index bc38dbd..16955fc 100644 --- a/main.R +++ b/main.R @@ -24,7 +24,9 @@ is_2d_histogram <- lapply(ctx$schema$columns, "[[", "name") %>% `%in%`(c(".histogram_count", ".x_bin_size", ".y_bin_size"), .) %>% all() -ds <- get_data_step(ctx) +wf <- get_workflow(ctx) +ds <- get_data_step(ctx, wf) +input.par$file.name.prefix <- plot_file_prefix(input.par$file.name.prefix, wf$name, ds$name) df <- getValues(ctx, is_2d_histogram) pl <- get_palettes(ds) diff --git a/operator.json b/operator.json index 7308afc..d27fb01 100644 --- a/operator.json +++ b/operator.json @@ -30,8 +30,8 @@ { "kind": "StringProperty", "name": "file.name.prefix", - "defaultValue": "Tercen_Plot", - "description": "Plot output file name prefix." + "defaultValue": "", + "description": "Plot output file name prefix. Empty (default): __plot." }, { "kind": "StringProperty", diff --git a/unit_tests/run.R b/unit_tests/run.R index c2c331e..3d4a355 100644 --- a/unit_tests/run.R +++ b/unit_tests/run.R @@ -178,5 +178,20 @@ check("theme: minimal by default", identical(theme$defaultValue, "minimal")) check("theme: every value is a ggplot2 theme", all(vapply(unlist(theme$values), function(t) exists(paste0("theme_", t), mode = "function"), TRUE))) +cat("-- output file name\n") +check("default: __plot", + identical(plot_file_prefix("", "PTK analysis", "Plot bars"), "PTK_analysis_Plot_bars_plot")) +check("the old default Tercen_Plot (stored by existing steps) is treated as the default", + identical(plot_file_prefix("Tercen_Plot", "wf", "step"), "wf_step_plot")) +check("a prefix set by the user is kept", + identical(plot_file_prefix("my figure", "wf", "step"), "my figure")) +check("no slashes or unsafe characters: they become _", + identical(plot_file_prefix("", "a/b\\c: d*?", "CRP-A 1/PGI2 100"), "a_b_c_d_CRP-A_1_PGI2_100_plot")) +check("missing names are left out", identical(plot_file_prefix("", NULL, "step"), "step_plot") && + identical(plot_file_prefix(NULL, "", ""), "plot")) +check("long names are cut", nchar(plot_file_prefix("", strrep("w", 300), strrep("s", 300))) == 80 + 1 + 80 + 5) +default_prefix <- Find(function(p) p$name == "file.name.prefix", props)$defaultValue +check("operator.json: the default prefix is empty", identical(default_prefix, "")) + cat("\n", length(failures), " failed\n", sep = "") if (length(failures)) quit(status = 1) diff --git a/utils.R b/utils.R index aafe349..22eb8be 100644 --- a/utils.R +++ b/utils.R @@ -28,8 +28,11 @@ get_step_id <- function(ctx) { } } -get_data_step <- function(ctx) { - wf <- ctx$client$workflowService$get(get_workflow_id(ctx)) +get_workflow <- function(ctx) { + ctx$client$workflowService$get(get_workflow_id(ctx)) +} + +get_data_step <- function(ctx, wf = get_workflow(ctx)) { ds <- Find(function(s) identical(s$id, get_step_id(ctx)), wf$steps) @@ -255,6 +258,32 @@ getValues <- function(ctx, is_2d_histogram = FALSE) { +##### +### Output file name + +# The value every step created before 1.0.20 stores for file.name.prefix (the +# old default). It is treated like an empty prefix: name the file after the step. +LEGACY_FILE_PREFIX <- "Tercen_Plot" + +# One part of a file name: anything other than letters, digits, '.', '-' and +# '_' (spaces, slashes, ...) becomes '_', and long names are cut. +safe_file_part <- function(x, max_chars = 80) { + if (is.null(x) || length(x) == 0 || is.na(x[1])) return("") + x <- gsub("[^A-Za-z0-9._-]+", "_", as.character(x[1])) + x <- gsub("^[_.]+|_+$", "", x) + substr(x, 1, max_chars) +} + +# File name prefix of the plot: the file.name.prefix setting when one was set, +# otherwise __plot. +plot_file_prefix <- function(prefix, workflow_name, step_name) { + if (!is.null(prefix) && nzchar(prefix) && prefix != LEGACY_FILE_PREFIX) { + return(prefix) + } + parts <- c(safe_file_part(workflow_name), safe_file_part(step_name), "plot") + paste(parts[nzchar(parts)], collapse = "_") +} + ##### ### Bar placement # Pure functions (a data frame in, a data frame or a ggplot layer out) so that