Fix info=FALSE ignored when no breakpoints found in as_sir_method

Operator-precedence bug at line 1601:

  if (isTRUE(info) && nrow(df_unique) < 10 || nrow(breakpoints) == 0)

R evaluates && before ||, so this was equivalent to:

  (isTRUE(info) && nrow(df_unique) < 10) || (nrow(breakpoints) == 0)

When nrow(breakpoints) == 0 (e.g. cefoxitin / flucloxacillin / mupirocin
against E. coli in EUCAST) the intro message was always printed regardless
of info. Fix: add parentheses so info gates both conditions:

  isTRUE(info) && (nrow(df_unique) < 10 || nrow(breakpoints) == 0)

Also pass print = isTRUE(info) to progress_ticker so the progress bar
(which prints intro_txt as its title) is suppressed when info = FALSE.

https://claude.ai/code/session_012DXCXbZUC54Zij1z9bFiHR

NEWS.md

@@ -37,6 +37,8 @@
 * Fixed BRMO classification by including bacterial complexes (#275)
 * Fixed `as.sir()` for data frames silently deleting columns whose AB class was already `<sir>` when called a second time (re-running on already-converted data) (#278)
 * Fixed `as.sir()` for data frames incorrectly treating metadata columns (e.g. `patient`, `ward`) as antibiotic columns when their names coincidentally matched an antibiotic code; column content is now validated against AMR data patterns before inclusion
+* Improved parallel computing in `as.sir()`: when the number of AB columns is smaller than the number of available cores, rows are now split into batches so all cores stay active (row-batch mode). Previously, a 6-column dataset on a 16-core machine would only use 6 cores; now all 16 are used, with each worker processing a smaller row slice (lower per-worker memory pressure)
+* Fixed `as.sir()` ignoring `info = FALSE` for columns with no breakpoints (e.g. cefoxitin against *E. coli*): an operator-precedence bug (`&&`/`||`) caused the "Interpreting MIC values" intro message to fire unconditionally when `nrow(breakpoints) == 0`, regardless of `info`; the progress bar title was also not gated by `info`
 
 ### Updates
 * Extensive `cli` integration for better message handling and clickable links in messages and warnings (#191, #265)

R/sir.R

@@ -952,7 +952,22 @@ as.sir.data.frame <- function(x,
   is_parallel_run <- isTRUE(parallel) && n_cores > 1 && length(ab_cols) > 1
   effective_info <- if (is_parallel_run) FALSE else info
 
-  run_as_sir_column <- function(i) {
+  # Row-batch mode: when n_cols < n_cores we would leave cores idle under plain
+  # column-parallel dispatch.  Instead we split rows into pieces so every core
+  # gets work.  pieces_per_col = ceil(n_cores / n_cols) gives ~n_cores jobs
+  # total; each job processes one column on one row slice, which also reduces
+  # per-worker memory pressure (smaller breakpoints search space).
+  # Only used for the fork path (R >= 4.0, non-Windows); PSOCK clusters already
+  # incur high per-job serialisation overhead so we keep column-mode there.
+  use_fork <- is_parallel_run &&
+    !(.Platform$OS.type == "windows" || getRversion() < "4.0.0")
+  pieces_per_col <- if (use_fork && length(ab_cols) < n_cores) {
+    ceiling(n_cores / length(ab_cols))
+  } else {
+    1L
+  }
+
+  run_as_sir_column <- function(i, rows = NULL) {
     # Always resolve AMR_env from the package namespace.  This is essential for
     # PSOCK workers (where the closure-captured AMR_env is a stale serialised copy
     # while as.sir() writes to the live AMR:::AMR_env) and also avoids capturing
@@ -967,14 +982,17 @@ as.sir.data.frame <- function(x,
     ab_col <- ab_cols[i]
     out <- list(result = NULL, log = NULL)
 
+    # row subsetting: NULL means all rows (column-mode), otherwise row-batch mode
+    row_idx <- if (is.null(rows)) seq_len(nrow(x)) else rows
+
     if (types[i] == "mic") {
       result <- as.sir(
-        as.mic(as.character(x[, ab_col, drop = TRUE])),
-        mo = x_mo,
-        mo.bak = x[, col_mo, drop = TRUE],
+        as.mic(as.character(x[row_idx, ab_col, drop = TRUE])),
+        mo = x_mo[row_idx],
+        mo.bak = x[row_idx, col_mo, drop = TRUE],
         ab = ab_col,
         guideline = guideline,
-        uti = uti,
+        uti = if (length(uti) > 1L) uti[row_idx] else uti,
         capped_mic_handling = capped_mic_handling,
         as_wt_nwt = as_wt_nwt,
         add_intrinsic_resistance = add_intrinsic_resistance,
@@ -983,7 +1001,7 @@ as.sir.data.frame <- function(x,
         include_screening = include_screening,
         include_PKPD = include_PKPD,
         breakpoint_type = breakpoint_type,
-        host = host,
+        host = if (length(host) > 1L) host[row_idx] else host,
         verbose = verbose,
         info = effective_info,
         conserve_capped_values = conserve_capped_values,
@@ -1004,12 +1022,12 @@ as.sir.data.frame <- function(x,
       return(out)
     } else if (types[i] == "disk") {
       result <- as.sir(
-        as.disk(as.character(x[, ab_col, drop = TRUE])),
-        mo = x_mo,
-        mo.bak = x[, col_mo, drop = TRUE],
+        as.disk(as.character(x[row_idx, ab_col, drop = TRUE])),
+        mo = x_mo[row_idx],
+        mo.bak = x[row_idx, col_mo, drop = TRUE],
         ab = ab_col,
         guideline = guideline,
-        uti = uti,
+        uti = if (length(uti) > 1L) uti[row_idx] else uti,
         as_wt_nwt = as_wt_nwt,
         add_intrinsic_resistance = add_intrinsic_resistance,
         reference_data = reference_data,
@@ -1017,7 +1035,7 @@ as.sir.data.frame <- function(x,
         include_screening = include_screening,
         include_PKPD = include_PKPD,
         breakpoint_type = breakpoint_type,
-        host = host,
+        host = if (length(host) > 1L) host[row_idx] else host,
         verbose = verbose,
         info = effective_info,
         is_data.frame = TRUE
@@ -1039,7 +1057,7 @@ as.sir.data.frame <- function(x,
       ab <- ab_col
       ab_coerced <- suppressWarnings(as.ab(ab, info = FALSE))
       show_message <- FALSE
-      if (!all(x[, ab, drop = TRUE] %in% c("S", "SDD", "I", "R", "NI", NA), na.rm = TRUE)) {
+      if (!all(x[row_idx, ab, drop = TRUE] %in% c("S", "SDD", "I", "R", "NI", NA), na.rm = TRUE)) {
         show_message <- TRUE
         if (isTRUE(effective_info)) {
           message_("\u00a0\u00a0", .amr_env$bullet_icon, " Cleaning values in column ", paste0("{.field ", font_bold(ab), "}"), " (",
@@ -1060,7 +1078,7 @@ as.sir.data.frame <- function(x,
           )
         }
       }
-      result <- as.sir(as.character(x[, ab, drop = TRUE]))
+      result <- as.sir(as.character(x[row_idx, ab, drop = TRUE]))
       if (show_message == TRUE && isTRUE(effective_info)) {
         message_(font_green_bg("\u00a0OK\u00a0"), as_note = FALSE)
       }
@@ -1075,10 +1093,14 @@ as.sir.data.frame <- function(x,
   if (isTRUE(parallel) && n_cores > 1 && length(ab_cols) > 1) {
     if (isTRUE(info)) {
       message_(as_note = FALSE)
+      if (pieces_per_col > 1L) {
+        message_("Running in parallel mode using ", n_cores, " out of ", get_n_cores(Inf), " cores, on columns ", vector_and(font_bold(ab_cols, collapse = NULL), quotes = "'", sort = FALSE), " (", pieces_per_col, " row slices per column)...", as_note = FALSE, appendLF = FALSE)
+      } else {
         message_("Running in parallel mode using ", n_cores, " out of ", get_n_cores(Inf), " cores, on columns ", vector_and(font_bold(ab_cols, collapse = NULL), quotes = "'", sort = FALSE), "...", as_note = FALSE, appendLF = FALSE)
       }
+    }
     if (.Platform$OS.type == "windows" || getRversion() < "4.0.0") {
-      # `cl` has been created in the part above before the `run_as_sir_column` function
+      # PSOCK cluster: column-mode only (row-batch serialisation overhead not worth it)
       on.exit(parallel::stopCluster(cl), add = TRUE)
       parallel::clusterExport(cl, varlist = c(
         "x", "x.bak", "x_mo", "ab_cols", "types",
@@ -1090,8 +1112,32 @@ as.sir.data.frame <- function(x,
         "run_as_sir_column"
       ), envir = environment())
       result_list <- parallel::parLapply(cl, seq_along(ab_cols), run_as_sir_column)
+    } else if (pieces_per_col > 1L) {
+      # Row-batch mode (R >= 4.0, non-Windows, n_cols < n_cores):
+      # build (col, row_slice) job pairs so all cores stay active
+      row_cuts <- unique(round(seq(0, nrow(x), length.out = pieces_per_col + 1L)))
+      row_ranges <- lapply(seq_len(length(row_cuts) - 1L), function(p) {
+        seq.int(row_cuts[p] + 1L, row_cuts[p + 1L])
+      })
+      jobs <- do.call(c, lapply(seq_along(ab_cols), function(ci) {
+        lapply(seq_along(row_ranges), function(p) list(col = ci, rows = row_ranges[[p]]))
+      }))
+      flat <- parallel::mclapply(jobs, function(job) {
+        run_as_sir_column(job$col, job$rows)
+      }, mc.cores = n_cores)
+      # Reassemble: for each column concatenate row pieces in order
+      result_list <- lapply(seq_along(ab_cols), function(ci) {
+        pieces <- flat[vapply(jobs, function(j) j$col == ci, logical(1L))]
+        list(
+          result = as.sir(do.call(c, lapply(pieces, function(p) as.character(p$result)))),
+          log    = {
+            logs <- Filter(Negate(is.null), lapply(pieces, function(p) p$log))
+            if (length(logs) > 0L) do.call(rbind_AMR, logs) else NULL
+          }
+        )
+      })
     } else {
-      # R>=4.0 on unix
+      # Column-parallel mode (R >= 4.0, non-Windows, n_cols >= n_cores)
       result_list <- parallel::mclapply(seq_along(ab_cols), run_as_sir_column, mc.cores = n_cores)
     }
     if (isTRUE(info)) {
@@ -1552,11 +1598,11 @@ as_sir_method <- function(method_short,
     add_intrinsic_resistance_to_AMR_env()
   }
 
-  if (isTRUE(info) && nrow(df_unique) < 10 || nrow(breakpoints) == 0) {
+  if (isTRUE(info) && (nrow(df_unique) < 10 || nrow(breakpoints) == 0)) {
     # only print intro under 10 items, otherwise progressbar will print this and then it will be printed double
     message_(intro_txt, appendLF = FALSE, as_note = FALSE)
   }
-  p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = intro_txt, only_bar_percent = TRUE)
+  p <- progress_ticker(n = nrow(df_unique), n_min = 10, print = isTRUE(info), title = intro_txt, only_bar_percent = TRUE)
   has_progress_bar <- !is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE)) && nrow(df_unique) >= 10
   on.exit(close(p))
 

tests/testthat/test-sir.R

@@ -502,6 +502,21 @@ test_that("test-sir.R", {
   sir_single_par <- suppressMessages(as.sir(df_single, col_mo = "mo", info = FALSE, parallel = TRUE))
   expect_identical(sir_single_seq[["AMC"]], sir_single_par[["AMC"]])
 
+  # 9. row-batch mode (n_cols < n_cores): force row splitting via max_cores and
+  #    verify identical output to sequential for a dataset with 2 AB columns so
+  #    pieces_per_col = ceiling(max_cores / 2) >= 2 and row batching activates
+  df_wide <- data.frame(
+    mo  = "B_ESCHR_COLI",
+    AMC = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)),
+    GEN = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)),
+    stringsAsFactors = FALSE
+  )
+  sir_wide_seq <- suppressMessages(as.sir(df_wide, col_mo = "mo", info = FALSE))
+  sir_wide_par <- suppressMessages(as.sir(df_wide, col_mo = "mo", info = FALSE,
+                                          parallel = TRUE, max_cores = 8L))
+  expect_identical(sir_wide_seq[["AMC"]], sir_wide_par[["AMC"]])
+  expect_identical(sir_wide_seq[["GEN"]], sir_wide_par[["GEN"]])
+
   # 8. info = TRUE with parallel does not produce per-column worker messages
   #    (messages should only appear in the main process, not duplicated from workers)
   msgs <- capture.output(

tools/benchmark_parallel.R

@@ -1,71 +1,115 @@
-# Benchmark: sequential vs parallel as.sir() across data-set sizes
+# Benchmark: sequential vs parallel as.sir() across data-set shapes
 #
-# Run from the repo root with:
+# Run from the repo root:
 #   Rscript tools/benchmark_parallel.R
-# or from inside an R session:
+# or inside an R session:
 #   source("tools/benchmark_parallel.R")
 #
-# Requires ggplot2 for the output plot; uses devtools::load_all() so the
-# package does not need to be installed.
+# Two panels:
+#   Left  – fixed columns (n_ab_fixed), varying rows.
+#           Parallel wins at small n; sequential catches up at large n due to
+#           memory-bandwidth saturation (all workers compete for the same
+#           clinical_breakpoints lookup table in L3 cache / RAM).
+#   Right – fixed rows (n_rows_fixed), varying column count.
+#           This is the shape that actually benefits: each additional column
+#           keeps another core busy.  The "real world" gain for a 2854×65
+#           dataset lives here.
+#
+# Requires ggplot2; uses devtools::load_all() so the package need not be
+# installed.
 
 devtools::load_all(".", quiet = TRUE)
 
-sizes <- c(20, 200, 2000, 20000)
-n_ab  <- 6   # number of antibiotic columns
+# ── configuration ─────────────────────────────────────────────────────────────
+row_sizes   <- c(200, 1000, 5000, 20000)
+col_sizes   <- c(4, 8, 16, 32, 48)
+n_rows_fixed <- 1000
+n_ab_fixed   <- 16
+n_cores_avail <- AMR:::get_n_cores(Inf)
 
-make_df <- function(n) {
+all_abs <- c("AMC", "GEN", "CIP", "TZP", "IPM", "MEM",
+             "AMP", "TMP", "SXT", "NIT", "FOX", "CRO",
+             "FEP", "CAZ", "CTX", "TOB", "AMK", "ERY",
+             "AZM", "CLI", "VAN", "TEC", "RIF", "MTR",
+             "MFX", "LNZ", "TGC", "DOX", "FLC", "OXA",
+             "PEN", "CXM", "CZO", "KAN", "COL", "FOS",
+             "MUP", "TCY", "TEC", "IPM", "CHL", "FEP",
+             "MEM", "TZP", "GEN", "AMC", "AMX", "AMP")
+all_abs <- unique(all_abs)
+
+mic_vals <- c("0.25", "0.5", "1", "2", "4", "8", "16", "32")
+
+make_df <- function(n_rows, n_ab) {
   set.seed(42)
-  mics <- lapply(seq_len(n_ab), function(j) {
-    as.mic(sample(c("0.25", "0.5", "1", "2", "4", "8", "16", "32"), n, TRUE))
-  })
-  names(mics) <- c("AMC", "GEN", "CIP", "TZP", "IPM", "MEM")
+  ab_sel <- all_abs[seq_len(min(n_ab, length(all_abs)))]
+  mics <- lapply(ab_sel, function(a) as.mic(sample(mic_vals, n_rows, TRUE)))
+  names(mics) <- ab_sel
   data.frame(mo = "B_ESCHR_COLI", mics, stringsAsFactors = FALSE)
 }
 
-results <- do.call(rbind, lapply(sizes, function(n) {
-  df <- make_df(n)
-
+time_both <- function(n_rows, n_ab, label) {
+  df <- make_df(n_rows, n_ab)
   t_seq <- system.time(
     suppressMessages(as.sir(df, col_mo = "mo", info = FALSE, parallel = FALSE))
   )[["elapsed"]]
-
   t_par <- system.time(
     suppressMessages(as.sir(df, col_mo = "mo", info = FALSE, parallel = TRUE))
   )[["elapsed"]]
+  message(sprintf("%-28s  seq=%5.2fs  par=%5.2fs  speedup=%.1fx",
+                  label, t_seq, t_par, t_seq / t_par))
+  data.frame(group = label, mode = c("sequential", "parallel"),
+             seconds = c(t_seq, t_par), stringsAsFactors = FALSE)
+}
 
-  message(sprintf("n = %6d  seq = %.3fs  par = %.3fs  speedup = %.1fx",
-                  n, t_seq, t_par, t_seq / t_par))
+# ── warm-up (avoid first-call overhead biasing results) ───────────────────────
+message("Warming up cache ...")
+invisible(suppressMessages(as.sir(make_df(100, 6), col_mo = "mo", info = FALSE)))
+invisible(suppressMessages(as.sir(make_df(100, 6), col_mo = "mo", info = FALSE, parallel = TRUE)))
+sir_interpretation_history(clean = TRUE)
 
-  data.frame(n = n, mode = c("sequential", "parallel"),
-             seconds = c(t_seq, t_par))
+# ── panel 1: vary rows, fixed columns ─────────────────────────────────────────
+message(sprintf("\nPanel 1 – varying rows, %d fixed columns:", n_ab_fixed))
+res_rows <- do.call(rbind, lapply(row_sizes, function(n) {
+  time_both(n, n_ab_fixed, sprintf("rows=%d", n))
 }))
+res_rows$x     <- rep(row_sizes, each = 2)
+res_rows$panel <- "Vary rows (16 fixed AB columns)"
+
+# ── panel 2: vary columns, fixed rows ─────────────────────────────────────────
+message(sprintf("\nPanel 2 – varying columns, %d fixed rows:", n_rows_fixed))
+res_cols <- do.call(rbind, lapply(col_sizes, function(n_ab) {
+  time_both(n_rows_fixed, n_ab, sprintf("cols=%d", n_ab))
+}))
+res_cols$x     <- rep(col_sizes, each = 2)
+res_cols$panel <- sprintf("Vary columns (%d fixed rows)", n_rows_fixed)
+
+results <- rbind(res_rows, res_cols)
 
 if (requireNamespace("ggplot2", quietly = TRUE)) {
-  p <- ggplot2::ggplot(results, ggplot2::aes(x = n, y = seconds,
-                                             colour = mode, group = mode)) +
-    ggplot2::geom_line(linewidth = 1) +
-    ggplot2::geom_point(size = 3) +
-    ggplot2::scale_x_log10(
-      breaks = sizes,
-      labels = format(sizes, big.mark = ",", scientific = FALSE)
+  p <- ggplot2::ggplot(
+    results,
+    ggplot2::aes(x = x, y = seconds, colour = mode, group = mode)
   ) +
+    ggplot2::geom_line(linewidth = 1) +
+    ggplot2::geom_point(size = 2.5) +
+    ggplot2::facet_wrap(~panel, scales = "free_x") +
     ggplot2::scale_colour_manual(
       values = c(sequential = "#E05C5C", parallel = "#2E86AB")
     ) +
     ggplot2::labs(
       title    = "as.sir() throughput: sequential vs parallel",
-      subtitle = sprintf("%d antibiotic columns, E. coli, EUCAST 2025", n_ab),
-      x        = "Number of rows (log scale)",
+      subtitle = sprintf("E. coli, EUCAST 2026, %d cores available", n_cores_avail),
+      x        = "Dataset dimension (rows  ·left·  or columns  ·right·)",
       y        = "Wall-clock time (seconds)",
       colour   = NULL
     ) +
-    ggplot2::theme_minimal(base_size = 13) +
+    ggplot2::theme_minimal(base_size = 12) +
     ggplot2::theme(legend.position = "top")
 
   out_file <- "tools/benchmark_parallel.png"
-  ggplot2::ggsave(out_file, p, width = 7, height = 5, dpi = 150)
-  message("Plot saved to ", out_file)
+  ggplot2::ggsave(out_file, p, width = 10, height = 5, dpi = 150)
+  message("\nPlot saved to ", out_file)
 } else {
   message("Install ggplot2 to get a plot; raw results:")
-  print(results)
+  print(results[, c("panel", "group", "mode", "seconds")])
 }