Fix 1-D facet_wrap, default theme minimal, file name <workflow>_<step>_plot, unit tests

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 `<workflow name>_<step name>_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
+`<prefix>_<row>_<column>.png` and all of them are also in `<prefix>.zip`.
+
 ##### Unit tests
 
 `unit_tests/run.R` checks the bar placement (order, stacking, fill) by building the bar layer and

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)
 

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): <workflow name>_<step name>_plot."
     },
     {
       "kind": "StringProperty",
@@ -113,7 +113,7 @@
     {
       "kind": "EnumeratedProperty",
       "name": "theme",
-      "defaultValue": "light",
+      "defaultValue": "minimal",
       "values": [
         "gray",
         "bw",

unit_tests/run.R

@@ -126,5 +126,72 @@ 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("-- 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("-- output file name\n")
+check("default: <workflow>_<step>_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)

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)
@@ -118,7 +121,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 {
@@ -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 <workflow>_<step>_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