From 446406b3ebd4b965905aa54c5b847f0c219b50ae Mon Sep 17 00:00:00 2001 From: Rudhik1904 Date: Fri, 28 Aug 2026 19:21:09 -0400 Subject: [PATCH 01/10] Task 2 --- .Rbuildignore | 4 + .gitignore | 3 + NAMESPACE | 5 +- R/constants.R | 36 +- R/main_calculations.R | 4 +- R/module-qc-server.R | 25 +- R/module-qc-ui.R | 71 +- R/module-statmodel-server.R | 18 +- R/qc-server-data-upload.R | 263 +++- R/qc-server-turnover.R | 508 +++++++- R/server.R | 8 +- R/statmodel-server-download-code.R | 199 ++- man/qcServer.Rd | 10 +- man/statmodelServer.Rd | 11 +- tests/testthat/data/tracer/README.md | 88 ++ tests/testthat/data/tracer/tracer_dup.csv | 10 + tests/testthat/data/tracer/tracer_dupcol.csv | 9 + tests/testthat/data/tracer/tracer_empty.csv | 0 tests/testthat/data/tracer/tracer_floor.csv | 9 + tests/testthat/data/tracer/tracer_good.csv | 9 + .../data/tracer/tracer_headeronly.csv | 1 + .../data/tracer/tracer_missing_col.csv | 9 + .../data/tracer/tracer_nonnumeric.csv | 9 + tests/testthat/data/tracer/tracer_over.csv | 9 + tests/testthat/data/tracer/tracer_partial.csv | 8 + tests/testthat/data/tracer/tracer_quote.csv | 9 + tests/testthat/data/tracer/tracer_tiny.csv | 9 + tests/testthat/data/tracer/tracer_unknown.csv | 10 + tests/testthat/data/tracer/tracer_zero.csv | 9 + tests/testthat/test-module-qc-ui.R | 42 +- tests/testthat/test-module-statmodel-server.R | 112 +- tests/testthat/test-module-turnover.R | 1079 ++++++++++++++++- tests/testthat/test-qc-data-upload.R | 261 ++++ 33 files changed, 2764 insertions(+), 93 deletions(-) create mode 100644 tests/testthat/data/tracer/README.md create mode 100644 tests/testthat/data/tracer/tracer_dup.csv create mode 100644 tests/testthat/data/tracer/tracer_dupcol.csv create mode 100644 tests/testthat/data/tracer/tracer_empty.csv create mode 100644 tests/testthat/data/tracer/tracer_floor.csv create mode 100644 tests/testthat/data/tracer/tracer_good.csv create mode 100644 tests/testthat/data/tracer/tracer_headeronly.csv create mode 100644 tests/testthat/data/tracer/tracer_missing_col.csv create mode 100644 tests/testthat/data/tracer/tracer_nonnumeric.csv create mode 100644 tests/testthat/data/tracer/tracer_over.csv create mode 100644 tests/testthat/data/tracer/tracer_partial.csv create mode 100644 tests/testthat/data/tracer/tracer_quote.csv create mode 100644 tests/testthat/data/tracer/tracer_tiny.csv create mode 100644 tests/testthat/data/tracer/tracer_unknown.csv create mode 100644 tests/testthat/data/tracer/tracer_zero.csv diff --git a/.Rbuildignore b/.Rbuildignore index fa8bd473..66163613 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,3 +3,7 @@ _\.new\.png$ ^\.positai$ ^\.claude$ +^plans$ +MSstats_log_.*\.log$ +^[^/]*\.csv$ +^\.github$ diff --git a/.gitignore b/.gitignore index bf49fc03..a353936c 100644 --- a/.gitignore +++ b/.gitignore @@ -52,3 +52,6 @@ vignettes/*.pdf /*.csv .positai + +# Local planning docs (not part of the package) +plans/ diff --git a/NAMESPACE b/NAMESPACE index 483aadcd..8e0f4fc8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,7 +26,9 @@ export(tmt_summarization_loop) export(uiObject) export(xy_str) import(MSstats) -import(MSstatsConvert) +import(MSstatsConvert, except = c(MaxQtoMSstatsTMTFormat, + OpenMStoMSstatsTMTFormat, PDtoMSstatsTMTFormat, PhilosophertoMSstatsTMTFormat, + SpectroMinetoMSstatsTMTFormat)) import(MSstatsTMT) import(data.table) import(ggplot2) @@ -210,6 +212,7 @@ importFrom(stats,hclust) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,qt) +importFrom(stats,setNames) importFrom(stringr,str_detect) importFrom(stringr,str_extract) importFrom(stringr,str_extract_all) diff --git a/R/constants.R b/R/constants.R index 2c420258..02297690 100644 --- a/R/constants.R +++ b/R/constants.R @@ -188,7 +188,41 @@ NAMESPACE_QC = list( ptm_downloads_panel = "ptm_downloads_panel", # Data Upload tab template-gated upload panels data_upload_mapping_panel = "data_upload_mapping_panel", - data_upload_ratios_panel = "data_upload_ratios_panel" + data_upload_ratios_panel = "data_upload_ratios_panel", + # Tracer-constants sidebar (protein turnover): server-toggled container, + # its optional CSV upload, the clear affordance the rejected state requires, + # and the status line that makes the three states visible. + tracer_constants_panel = "tracer_constants_panel", + tracer_constants_file = "tracer_constants_file", + tracer_constants_clear = "tracer_constants_clear", + tracer_constants_status = "tracer_constants_status" +) + +# Tracer constants (protein turnover). The constant is a DIVISOR in +# MSstatsResponse::calculateTurnoverRatios (H_frac / tracer_factor), so 1 is the +# neutral default and 0 yields Inf. The floor is not merely "greater than zero": +# a value like 1e-10 passes a (0, 1] check and silently produces a huge H_frac +# whose L_frac is then clamped to 0 by pmax(1 - H_frac, 0), i.e. a +# plausible-looking but wrong result rather than an error. Enrichment is a +# measured biological fraction, so anything below 0.01 is implausible. +# The range check, its error message and the UI help text must all quote these, +# never a repeated literal. +# +# The three tracer_source_* values are the provenance states from plan section +# 0.6. They are named rather than inlined because they cross a file boundary: +# R/qc-server-turnover.R writes them into the snapshot and +# R/statmodel-server-download-code.R switches on them to choose the comment it +# stamps into the downloadable script. A typo in either would silently pick the +# wrong provenance, which is precisely the class of untraceable-provenance bug +# this feature exists to remove. "not_run" is genuinely distinct from "none": +# "none" means the user ran summarization and declined the correction, while +# "not_run" means the data-processing page never ran, so the app never asked. +CONSTANTS_QC = list( + tracer_min = 0.01, + tracer_max = 1, + tracer_source_upload = "upload", + tracer_source_none = "none", + tracer_source_not_run = "not_run" ) NAMESPACE_EXPDES = list( diff --git a/R/main_calculations.R b/R/main_calculations.R index 82496fcd..055b1854 100644 --- a/R/main_calculations.R +++ b/R/main_calculations.R @@ -129,7 +129,9 @@ lf_summarization_loop = function(data, qc_input,loadpage_input, busy_indicator = #' @export #' @import MSstats #' @import MSstatsTMT -#' @import MSstatsConvert +#' @rawNamespace import(MSstatsConvert, except = c(MaxQtoMSstatsTMTFormat, +#' OpenMStoMSstatsTMTFormat, PDtoMSstatsTMTFormat, PhilosophertoMSstatsTMTFormat, +#' SpectroMinetoMSstatsTMTFormat)) #' @import data.table #' @importFrom shinybusy show_modal_progress_line update_modal_progress remove_modal_progress #' @importFrom methods new diff --git a/R/module-qc-server.R b/R/module-qc-server.R index f77376a6..4c0e4170 100644 --- a/R/module-qc-server.R +++ b/R/module-qc-server.R @@ -9,8 +9,14 @@ #' @param parent_session session of the main calling module #' @param loadpage_input input object from loadpage UI #' @param get_data stored function that returns the data from loadpage +#' @param app_template reactive (or NULL) returning the selected template name (e.g. TEMPLATES$default) +#' @param get_condition_metadata reactive (or NULL) returning the condition metadata table #' -#' @return input object with user selected options +#' @return a list with four elements: `input` (the module's input object), +#' `preprocessData` (reactive returning the preprocessed data), +#' `turnoverRatios` (reactive returning the turnover ratios, or the uploaded +#' ratios when those override them), and `tracerConstants` (reactive +#' returning the tracer-constant provenance record snapshotted at Run) #' #' @export #' @examples @@ -25,12 +31,13 @@ qcServer <- function(input, output, session, parent_session, loadpage_input, get preprocessData(input, loadpage_input(), get_data()) }) - turnover_ratios <- register_qc_turnover(input, output, session, app_template, get_data, - get_condition_metadata, preprocess_data) + turnover = register_qc_turnover(input, output, session, app_template, get_data, + get_condition_metadata, preprocess_data) data_upload = register_qc_data_upload(input, output, session, loadpage_input, app_template, get_data, preprocess_data, - get_condition_metadata, turnover_ratios) + get_condition_metadata, turnover$ratios, + turnover$tracer_upload) effective_preprocess_data <- data_upload$effective_preprocess_data @@ -97,7 +104,15 @@ qcServer <- function(input, output, session, parent_session, loadpage_input, get list( input = input, preprocessData = effective_preprocess_data, - turnoverRatios = data_upload$effective_turnover_ratios + turnoverRatios = data_upload$effective_turnover_ratios, + # The tracer constants that actually produced the ratios shown on the QC + # page, snapshotted at Run. Exposed alongside the ratios rather than + # bundled into them because the Download-code path reads it on ALL FOUR + # templates, so it must be a reactive that cannot raise -- see the + # tracer_constants_used comment in R/qc-server-turnover.R. NOT routed + # through data_upload: the uploaded-ratios override replaces the ratios, + # not the constants that were applied when computing them. + tracerConstants = turnover$tracer_constants ) ) } diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index bc4a4783..075fc54f 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -186,8 +186,68 @@ qcUI <- function(id) { )), - tags$hr(), - uiOutput(ns("tracer_constants_sidebar")), + # Tracer constants (protein turnover only), toggled server-side by + # register_qc_turnover. Static and shinyjs::hidden(), NOT a renderUI: + # re-rendering destroys a mounted fileInput, which pushes NULL to the + # server while the parsed constants live on in a reactiveVal -- the UI + # would read "no file uploaded" while the fit kept dividing by the old + # file's values. R/qc-server-sidebar.R:101-105 documents the same rule + # for the same reason. Three of the old renderUI's dependencies are + # invalidated by ordinary actions (re-clicking proceed on the load + # page, editing a TimeVal cell, uploading a GROUP mapping), so this is + # not a theoretical hazard. + # + # The hr() lives INSIDE the div so the rule appears only with the + # section it introduces. (It is NOT true that the old unconditional hr + # at this position rendered alone on non-turnover templates -- it + # separated the last visible control from the Run button. Moving it + # gives up that separator on those templates, which is the accepted + # cost of not drawing two rules, or a leading one, on turnover.) + # + # The schema sits in the tooltip rather than in the panel body because + # this sidebar is width = 3 and already runs ~160 lines; every other + # fileInput in this app has the width = 8 main panel to spread into. + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$tracer_constants_panel), + tags$hr(), + h4("Tracer constants", class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div(paste0( + "Optional. Corrects each condition's heavy fraction for ", + "incomplete label enrichment: the heavy fraction is DIVIDED by ", + "the constant, so 1 means no correction. Leave this empty and ", + "every condition uses 1. Required columns, case-sensitive: ", + paste(get_qc_required_tracer_columns(), collapse = ", "), + ". One row per condition -- the file must cover them all, and ", + "GROUP values must match your experimental conditions exactly, ", + "including case. TracerConstant must be between ", + CONSTANTS_QC$tracer_min, " and ", CONSTANTS_QC$tracer_max, + ", inclusive. Example: a header row 'GROUP,TracerConstant' ", + "followed by '0h,0.98', '6h,0.95', '24h,0.93'. Condition names ", + "must begin with a number of hours, as those do: a d or w ", + "anywhere in the name is read as days or weeks, so names the ", + "app cannot read, and names that resolve to the same ", + "timepoint, are rejected."), + class = "icon-tooltip")), + fileInput(ns(NAMESPACE_QC$tracer_constants_file), + "Upload tracer constants (CSV)", accept = ".csv"), + # One visible line, phrased like the sibling uploads at :253-283. + # The tooltip holds the detail, but tooltips here are hover-only + # (inst/assets/style.css: .icon-wrapper:hover .icon-tooltip), and + # this would otherwise be the only upload in the app whose schema + # needs a mouse. + p(tags$strong("Required columns: "), + paste(get_qc_required_tracer_columns(), collapse = ", ")), + # Required, not optional: a rejected upload blocks Run (plan section + # 0.1), so without a clear affordance a bad file is a dead end. + actionButton(ns(NAMESPACE_QC$tracer_constants_clear), "Clear", + class = "btn-sm"), + tags$br(), tags$br(), + # Makes the absent / pending / rejected / valid states visible. The + # fileInput keeps displaying the filename of a rejected file, so + # without this the UI looks like the upload succeeded. + uiOutput(ns(NAMESPACE_QC$tracer_constants_status)) + )), actionButton(ns("run"), "Run summarization"), width = 3 ), @@ -230,7 +290,12 @@ qcUI <- function(id) { id = ns(NAMESPACE_QC$data_upload_ratios_panel), tags$hr(), fileInput(ns("upload_turnover_ratios"), "Upload Turnover Ratios (CSV)", accept = ".csv"), - p(tags$strong("Required columns: "), "Protein, TimeVal, H_frac, L_frac") + p(tags$strong("Required columns: "), "Protein, TimeVal, H_frac, L_frac"), + # plan section 0.5: the tracer-constants panel in the side bar is + # deliberately unavailable on this flow. Said here rather + # than there, because there is exactly where a user on + # this flow cannot see it. + p("Ratios uploaded here are used as given. The tracer-constants upload in the side panel does not apply on this flow: these H_frac and L_frac values are already computed, so any correction for incomplete label enrichment must be applied before upload.") )) ) ), diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 66cc3a31..790e8d0f 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -14,6 +14,11 @@ #' @param get_data stored function that returns the data from loadpage #' @param preprocess_data stored function that returns preprocessed data #' @param app_template reactive returning the selected template name (e.g. TEMPLATES$default) +#' @param turnover_ratios reactive returning the calculated turnover ratios +#' @param condition_metadata reactive returning the condition metadata table +#' @param tracer_constants reactive returning the tracer-constant provenance +#' record snapshotted by the QC page at Run (values / source / file), or +#' NULL when the data-processing page has not been run in this session #' #' @importFrom MSstatsResponse visualizeResponseProtein #' @@ -27,7 +32,8 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, get_data, preprocess_data, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), - condition_metadata = reactive(NULL)) { + condition_metadata = reactive(NULL), + tracer_constants = reactive(NULL)) { moduleServer( id, function(input, output, session) { @@ -394,7 +400,15 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison_code = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { req(contrast$matrix) comp_mat = contrast$matrix - generate_analysis_code(qc_input(), loadpage_input(), comp_mat, input, app_template()) + # Isolated by eventReactive, so this is a snapshot taken when the model + # is run -- and the QC page already snapshotted it at summarization, so + # the script can only ever cite constants that produced ratios the user + # actually saw (plan Decision I). tryCatch mirrors every other optional + # reactive read in this module: a caller that supplies something raising + # here must not take the Download-code button out on all four templates. + tracer_used = tryCatch(tracer_constants(), error = function(e) NULL) + generate_analysis_code(qc_input(), loadpage_input(), comp_mat, input, + app_template(), tracer_used) }) SignificantProteins = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { diff --git a/R/qc-server-data-upload.R b/R/qc-server-data-upload.R index 43b124db..1241234d 100644 --- a/R/qc-server-data-upload.R +++ b/R/qc-server-data-upload.R @@ -84,9 +84,15 @@ get_qc_required_ratios_columns <- function() { #' CSV uses GROUP (identical values, user-facing name). Renames GROUP to #' Condition and keeps the template-specific value columns, all coerced to #' character to match the load-page format. +#' +#' Condition is trimmed because qc_mapping_group_errors() validates the TRIMMED +#' GROUP values against ProteinLevelData. Storing the raw value instead would +#' let a quoted "DMSO " cell (fread's strip.white does not touch quoted fields) +#' pass validation and then fail the ProteinLevelData join downstream, silently +#' dropping that condition's rows. What is stored must be what was checked. #' @noRd qc_mapping_to_condition_metadata <- function(parsed, template) { - df = data.frame(Condition = as.character(parsed$GROUP), stringsAsFactors = FALSE) + df = data.frame(Condition = trimws(as.character(parsed$GROUP)), stringsAsFactors = FALSE) if (!is.null(template) && template == TEMPLATES$protein_turnover) { df$TimeVal = as.character(parsed$TimeVal) } else if (!is.null(template) && template == TEMPLATES$chemoproteomics) { @@ -113,29 +119,42 @@ qc_dose_units_valid <- function(units) { all(!is.na(normalized) & normalized %in% c("nm", "um", "mm", "m")) } -#' Errors for a GROUP mapping that must have one row per ProteinLevelData GROUP. +#' Errors for an upload that must have exactly one row per reference GROUP. +#' +#' Returns a character vector of messages (empty when valid): unknown groups, +#' reference groups missing from the upload, and duplicated rows. Missing or +#' duplicated groups otherwise corrupt the GROUP join. #' -#' Returns a character vector of messages (empty when valid): unknown mapping -#' groups, ProteinLevelData groups missing from the mapping, and duplicated -#' mapping rows. Missing or duplicated groups otherwise corrupt the GROUP join. +#' `subject` and `reference` name the two sides in the message. They are +#' parameters because more than one upload in this app is validated this way: +#' hardcoding "GROUP mapping" / "ProteinLevelData" would send a user who +#' mis-typed a condition in the tracer-constants file off to edit an unrelated +#' file. Defaults reproduce the GROUP-mapping wording verbatim. #' @noRd -qc_mapping_group_errors <- function(mapping_groups, protein_groups) { - mapping_groups = as.character(mapping_groups) - protein_groups = as.character(protein_groups) +qc_mapping_group_errors <- function(mapping_groups, protein_groups, + subject = "GROUP mapping", + reference = "ProteinLevelData") { + # Trimmed on both sides: condition names get no normalization when they are + # read off the annotation, while fread applies strip.white = TRUE. So an + # Excel-sourced "0h " could never be matched by any CSV cell, and the + # load-page metadata table disables editing on the Condition column -- there + # is no in-app fix for the user. Case is deliberately left strict. + mapping_groups = trimws(as.character(mapping_groups)) + protein_groups = trimws(as.character(protein_groups)) errors = character(0) unknown = setdiff(mapping_groups, protein_groups) if (length(unknown) > 0) { - errors = c(errors, paste0("GROUP mapping has GROUP value(s) not found in ProteinLevelData: ", + errors = c(errors, paste0(subject, " has GROUP value(s) not found in ", reference, ": ", paste(unknown, collapse = ", "), ".")) } missing_groups = setdiff(protein_groups, mapping_groups) if (length(missing_groups) > 0) { - errors = c(errors, paste0("GROUP mapping is missing row(s) for ProteinLevelData GROUP(s): ", + errors = c(errors, paste0(subject, " is missing row(s) for ", reference, " GROUP(s): ", paste(missing_groups, collapse = ", "), ".")) } duplicated_groups = unique(mapping_groups[duplicated(mapping_groups)]) if (length(duplicated_groups) > 0) { - errors = c(errors, paste0("GROUP mapping has duplicate row(s) for GROUP(s): ", + errors = c(errors, paste0(subject, " has duplicate row(s) for GROUP(s): ", paste(duplicated_groups, collapse = ", "), ".")) } errors @@ -162,6 +181,206 @@ qc_values_numeric_finite <- function(df, cols, allow_na = FALSE) { TRUE } +# ---------------------------------------------------------------------------- +# Tracer-constant upload helpers (protein turnover only). +# ---------------------------------------------------------------------------- + +#' Required columns for an uploaded tracer-constants CSV. +#' +#' GROUP matches the naming every other QC upload uses; TracerConstant is the +#' per-condition isotope enrichment fraction handed to +#' MSstatsResponse::calculateTurnoverRatios. +#' @noRd +get_qc_required_tracer_columns <- function() { + c("GROUP", "TracerConstant") +} + +#' Whether every tracer constant lies within CONSTANTS_QC$tracer_min/max. +#' +#' Takes df + col to match qc_values_numeric_finite's convention, and coerces +#' before comparing for the same reason it does: an uncoerced character column +#' compares lexicographically, so all(c("0.5", "0.5abc") > 0) is TRUE and the +#' bad value only turns into NA later, inside the analysis. Coercing first also +#' keeps NA out of the `all()`, which would otherwise return NA and throw +#' "missing value where TRUE/FALSE needed" from the calling `if`. +#' +#' Returns FALSE for an absent or empty column: all(logical(0)) is TRUE, so an +#' empty file would otherwise validate. +#' @noRd +qc_tracer_values_in_range <- function(df, col = "TracerConstant") { + if (is.null(df) || length(col) != 1 || is.na(col)) return(FALSE) + if (!(col %in% colnames(df))) return(FALSE) + raw = df[[col]] + if (length(raw) == 0) return(FALSE) + # as.numeric on a factor reads the level codes, not the labels, so + # factor("2.0") would validate as 2. fread does not produce factors, but this + # helper is the single source of truth and takes an arbitrary data frame. + if (is.factor(raw)) raw = as.character(raw) + coerced = suppressWarnings(as.numeric(raw)) + all(is.finite(coerced) & + coerced >= CONSTANTS_QC$tracer_min & + coerced <= CONSTANTS_QC$tracer_max) +} + +#' The neutral all-ones tracer-constant vector, named by condition. +#' +#' 1 is the identity for the divisor, so this reproduces uncorrected behaviour +#' exactly. Errors on zero conditions rather than returning a named numeric(0): +#' that is not NULL, so it would slip past calculateTurnoverRatios' own is.null +#' guard and make every H_frac NA. +#' @noRd +#' @importFrom stats setNames +qc_default_tracer_constants <- function(conditions) { + conditions = as.character(conditions) + if (length(conditions) == 0) { + stop("Cannot build tracer constants: no experimental conditions are available.") + } + setNames(rep(1, length(conditions)), conditions) +} + +#' Resolve the tracer-constant vector actually passed to the turnover fit. +#' +#' The single source of truth for both the analysis and the downloadable +#' script, so the two cannot disagree. `uploaded` is NULL when no file was +#' supplied, in which case every condition gets 1. +#' +#' The reindex is guarded rather than trusted: uploaded[conditions] returns NA +#' under an NA *name* for a condition the file does not cover -- no error -- and +#' H_frac / NA is NA, i.e. an entirely missing result set with no warning. +#' Names are re-applied from `conditions` because calculateTurnoverRatios re-keys +#' the vector with parse_timepoint(names(x)), so it must carry the raw condition +#' strings, not whatever the file happened to be sorted by. +#' @noRd +#' @importFrom stats setNames +qc_resolve_tracer_constants <- function(conditions, uploaded = NULL) { + resolved = qc_default_tracer_constants(conditions) + if (is.null(uploaded) || length(uploaded) == 0) return(resolved) + + conditions = names(resolved) + # Matched on trimmed keys for the reason given in qc_mapping_group_errors, + # but the RESULT keeps the raw condition strings as names: they are what + # calculateTurnoverRatios re-keys through parse_timepoint. + keys = trimws(conditions) + upload_keys = trimws(as.character(names(uploaded))) + + duplicated_keys = unique(upload_keys[duplicated(upload_keys)]) + if (length(duplicated_keys) > 0) { + stop("Tracer constants list condition(s) more than once: ", + paste(duplicated_keys, collapse = ", "), ".") + } + + matched = match(keys, upload_keys) + if (anyNA(matched)) { + stop("Tracer constants are missing for condition(s): ", + paste(conditions[is.na(matched)], collapse = ", "), ".") + } + + raw = uploaded + if (is.factor(raw)) raw = as.character(raw) + values = suppressWarnings(as.numeric(raw[matched])) + if (anyNA(values)) { + stop("Tracer constants could not be read for condition(s): ", + paste(conditions[is.na(values)], collapse = ", "), ".") + } + setNames(values, conditions) +} + +#' Hours a condition name resolves to, mirroring MSstatsResponse's parser. +#' +#' Deliberately duplicated rather than called through `:::`: parse_timepoint is +#' internal to MSstatsResponse and R CMD check flags ::: calls. It must stay in +#' step with it, because calculateTurnoverRatios re-keys the tracer vector with +#' names(x) <- parse_timepoint(names(x)) -- this is the function that decides +#' which constant a condition actually receives. +#' +#' Note the parser's two quirks, both reproduced here on purpose: the number is +#' anchored at the start of the string, and the day/week detectors are bare "d" +#' and "w" matched anywhere, so "6h_drug" resolves to 144 hours. +#' @noRd +#' @importFrom stringr str_extract str_detect +qc_tracer_timepoint_hours <- function(conditions) { + conditions = as.character(conditions) + numeric_part = suppressWarnings(as.numeric(str_extract(conditions, "^[0-9]+"))) + is_days = str_detect(conditions, "d|day") + is_weeks = str_detect(conditions, "w|week") + # str_detect returns NA for an NA condition, which would make the subscripted + # assignments below error rather than fall through to the unparseable branch. + is_days[is.na(is_days)] = FALSE + is_weeks[is.na(is_weeks)] = FALSE + + hours = numeric_part + hours[is_days] = numeric_part[is_days] * 24 + hours[is_weeks] = numeric_part[is_weeks] * 24 * 7 + hours +} + +#' Condition names whose "d"/"w" is read as a unit but is not one. +#' +#' The parser's day and week detectors are the bare patterns "d|day" and +#' "w|week", matched ANYWHERE in the string, so "6h_drug" silently resolves to +#' 144 hours rather than 6 -- the "d" of "drug". Flagged only when the letter +#' fires the multiplier without the name actually ending in a day/week unit, so +#' ordinary suffixes that carry no "d" or "w" ("24h_rep1") are left alone. +#' @noRd +#' @importFrom stringr str_detect +qc_tracer_misleading_units <- function(conditions) { + conditions = as.character(conditions) + fires = !is.na(conditions) & str_detect(conditions, "d|day|w|week") + genuine = !is.na(conditions) & + str_detect(conditions, "^[0-9]+[[:space:]]*(d|days?|w|wks?|weeks?)$") + fires & !genuine +} + +#' Errors for condition names the turnover fit cannot key tracer constants by. +#' +#' Three failure modes, all silent data corruption today: +#' - a name that resolves to NA drops every row of that condition, leaving an +#' empty result set; +#' - a stray "d" or "w" multiplies the timepoint (see +#' qc_tracer_misleading_units); +#' - two names that resolve to the SAME number collide, and the second +#' silently takes the first's constant (e.g. "24h" and "1d" both give 24). +#' +#' The remedy has to be the annotation file: the load-page metadata table +#' disables editing on the Condition column, so there is no in-app fix. +#' @noRd +qc_tracer_timepoint_errors <- function(conditions) { + conditions = unique(as.character(conditions)) + errors = character(0) + if (length(conditions) == 0) return(errors) + + hours = qc_tracer_timepoint_hours(conditions) + + unparseable = conditions[is.na(hours)] + if (length(unparseable) > 0) { + errors = c(errors, paste0( + "Condition name(s) must start with a number of hours, days or weeks ", + "(for example 0h, 6h, 24h). These do not: ", + paste(unparseable, collapse = ", "), + ". Rename the conditions in the annotation file and reload the data.")) + } + + misleading = !is.na(hours) & qc_tracer_misleading_units(conditions) + if (any(misleading)) { + errors = c(errors, paste0( + "Condition name(s) ", paste(conditions[misleading], collapse = ", "), + " contain a \"d\" or \"w\" that is read as a day or week unit, so they ", + "resolve to ", paste(hours[misleading], collapse = ", "), + " hours. Rename them in the annotation file and reload the data.")) + } + + known = hours[!is.na(hours)] + named = conditions[!is.na(hours)] + for (collision in unique(known[duplicated(known)])) { + errors = c(errors, paste0( + "Condition name(s) ", paste(named[known == collision], collapse = ", "), + " all resolve to the same timepoint (", collision, + " hours), so they cannot be given different tracer constants. ", + "Rename them in the annotation file and reload the data.")) + } + errors +} + # ---------------------------------------------------------------------------- # Server registration. # ---------------------------------------------------------------------------- @@ -171,7 +390,8 @@ qc_values_numeric_finite <- function(df, cols, allow_na = FALSE) { #' @noRd register_qc_data_upload <- function(input, output, session, loadpage_input, app_template, get_data, preprocess_data, - get_condition_metadata, turnover_ratios) { + get_condition_metadata, turnover_ratios, + tracer_upload = NULL) { uploaded_feature_level = reactiveVal(NULL) uploaded_protein_level = reactiveVal(NULL) @@ -418,10 +638,27 @@ register_qc_data_upload <- function(input, output, session, loadpage_input, }, ignoreNULL = FALSE) # ---- Disable the summarization Run button while uploads are in play ---- + # One observer for all of them on purpose. A second toggleState("run", ...) + # elsewhere would not AND with this one: each observer sends its own message + # whenever its own dependencies invalidate, so the later write wins and the + # button flips back on. Hence tracer_upload is passed in from + # register_qc_turnover rather than gating Run from there. + # + # "pending" blocks Run for the same reason "rejected" does: the tracer file + # picker sits ~20px above the Run button, so a click during the upload would + # otherwise summarize with all-1s and no warning (plan Decision I). observe({ + tracer = if (is.null(tracer_upload)) NULL else tracer_upload() + # Template-gated as well as state-gated. register_qc_turnover already + # clears the state on a template switch; this term means a stale state + # could not disable Run on a template whose sidebar has no tracer panel -- + # and so no Clear button -- to re-enable it from. + tracer_blocks_run = identical(get_template(), TEMPLATES$protein_turnover) && + !is.null(tracer) && tracer$state %in% c("pending", "rejected") shinyjs::toggleState("run", is.null(uploaded_feature_level()) && - is.null(uploaded_protein_level())) + is.null(uploaded_protein_level()) && + !tracer_blocks_run) }) # ---- Template-gated upload panels: mapping (turnover + chemo), ratios (turnover) ---- diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index f6dbe727..d31c2644 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -1,48 +1,426 @@ -# QC Turnover Ratios tab (protein-turnover template): tracer-constant inputs, -# the ratio calculation, the results table, and the ratio CSV download. +# QC Turnover Ratios tab (protein-turnover template): the optional +# tracer-constants CSV upload, the ratio calculation, the results table, and +# the ratio CSV download. -#' Register the QC Turnover Ratios tab outputs and return the ratios reactive. +#' Register the QC Turnover Ratios tab outputs. +#' +#' @return a list with three elements: `ratios` (the display reactive, which +#' carries a req()), `tracer_upload` (the upload state reactiveVal, read by +#' register_qc_data_upload to gate the Run button), and `tracer_constants` +#' (the provenance record snapshotted at Run, which must never raise -- the +#' Download-code path reads it on all four templates). #' @noRd register_qc_turnover <- function(input, output, session, app_template, get_data, get_condition_metadata, preprocess_data) { - output$tracer_constants_sidebar <- renderUI({ - req(!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) - req(get_data()) + # ---- Tracer-constants CSV upload (optional; protein turnover only) ---- + # + # Three states, deliberately not collapsed into a nullable vector (plan + # Decision H / plan section 0.1). "absent" means the user declined the + # correction and every condition gets 1; "rejected" means they supplied an + # intent the app cannot honour, which must block Run rather than silently + # fall back to all-1s -- that silent fallback is the bug this whole feature + # exists to remove. + # "pending" covers the browser-to-server upload window: the Run button sits + # ~20px below the file picker, and clicking it mid-upload would otherwise + # summarize with all-1s and no warning (Decision I). + # + # State and values live in ONE reactiveVal so they cannot disagree, and the + # committed values are whatever qc_resolve_tracer_constants() returns -- the + # same function the fit and the generated script call -- so the stored vector + # is by construction the vector the analysis will use. + tracer_upload <- reactiveVal(list(state = "absent", values = NULL, file = NULL)) - req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) - ns <- session$ns - conditions <- as.character(get_condition_metadata()$Condition) + # The constants that actually produced the displayed ratios, snapshotted at + # the moment of Run (Decision I). NOT a live view of tracer_upload(): a live + # one diverges the instant the user uploads a file after running, so the + # ratios table would show one set of numbers while the downloadable script + # emitted another -- which is the silent-divergence bug this feature exists + # to remove, reintroduced by its own fix. + # + # A reactiveVal rather than a second eventReactive, deliberately. Reading an + # eventReactive that has not yet fired raises shiny.silent.error, and this + # value is read from the Download-code path on ALL FOUR templates + # (plan Decision E) -- a silent error escaping there kills the button + # everywhere. Reading a reactiveVal cannot fail. + # + # NULL is therefore load-bearing: it is the third provenance state from + # plan section 0.6, "the QC page was never run", which is genuinely + # different from "the user ran it and declined the correction" (source = + # "none"). The generated script distinguishes all three. + tracer_constants_used <- reactiveVal(NULL) - tracer_inputs <- lapply(conditions, function(cond) { - input_id <- ns(paste0("tracer_", make.names(cond))) - fluidRow( - column(6, p(strong(cond))), - column(6, numericInput(input_id, NULL, value = 1.0, min = 0, max = 1, step = 0.001)) - ) - }) + get_template <- function() if (is.null(app_template)) NULL else app_template() - tagList( - tags$hr(), - h4("Turnover Ratio Calculation"), - p("Enter tracer constants (0 to 1) for each condition:"), - tagList(tracer_inputs) + get_conditions <- function() { + if (is.null(get_condition_metadata)) return(character(0)) + meta <- get_condition_metadata() + if (is.null(meta) || is.null(meta$Condition)) return(character(0)) + as.character(meta$Condition) + } + + # Fires on the client the moment a file is chosen, i.e. before the upload + # completes and before observeEvent(input$...) can run. shinyjs::reset() sets + # the value with jQuery .val(''), which does not dispatch "change", so + # clearing the upload cannot re-arm this and strand Run disabled. + shinyjs::onevent("change", NAMESPACE_QC$tracer_constants_file, { + tracer_upload(list(state = "pending", values = NULL, file = NULL)) + }) + + # shinyjs::reset clears the file input on the CLIENT only -- it empties the + # widget and posts back an empty message, so input$tracer_constants_file + # keeps its old name/datapath for the rest of the session. tracer_upload() is + # therefore the only trustworthy source of the resolved values; anything + # downstream (Step 4's resolve-at-run in particular) must read it and never + # the file input, or a cleared upload comes back to life. + observeEvent(input[[NAMESPACE_QC$tracer_constants_clear]], { + shinyjs::reset(NAMESPACE_QC$tracer_constants_file) + tracer_upload(list(state = "absent", values = NULL, file = NULL)) + showNotification( + "Tracer constants cleared. Every condition will use 1 (no correction).", + type = "message", duration = 6) + }, ignoreInit = TRUE) + + # A blocking tracer state must not outlive the template it belongs to. The + # template is a plain selectInput on the Home tab and can be changed at any + # point in a live session; the tracer panel -- and with it the Clear button, + # the only affordance that resets the state -- is gated on protein turnover. + # So a rejected upload followed by a template switch would leave Run disabled + # with nothing on screen to re-enable it, escapable only by restarting. + observeEvent(get_template(), { + if (identical(get_template(), TEMPLATES$protein_turnover)) return() + + # Unconditional, unlike the upload reset below: pressing Run on another + # template makes turnover_ratios' own req() fail, and shiny CACHES that + # shiny.silent.error, so the ratios table stays empty for the rest of the + # session until a fresh turnover Run. A snapshot surviving that would have + # the generated script cite tracer constants for a table showing nothing + # -- the script/display divergence Decision I exists to prevent. + tracer_constants_used(NULL) + + if (!identical(tracer_upload()$state, "absent")) { + shinyjs::reset(NAMESPACE_QC$tracer_constants_file) + tracer_upload(list(state = "absent", values = NULL, file = NULL)) + } + }, ignoreNULL = FALSE) + + observeEvent(input[[NAMESPACE_QC$tracer_constants_file]], { + file <- input[[NAMESPACE_QC$tracer_constants_file]] + req(file) + + # Every early return below leaves "rejected", never the previous file's + # values: replacing a good file with a bad one must not keep running the + # good one's constants under the bad one's filename (QA 4.1). + reject <- function(...) { + tracer_upload(list(state = "rejected", values = NULL, file = file$name)) + # Named, because replacing a good file with a bad one otherwise produces + # a red toast that does not say which of the two failed (QA 4.1). + showNotification(paste0(file$name, " was not accepted. ", ...), + type = "error", duration = 10) + } + tracer_upload(list(state = "rejected", values = NULL, file = file$name)) + + conditions <- get_conditions() + if (length(conditions) == 0) { + reject("Load your data before uploading tracer constants: the app does ", + "not yet know which experimental conditions to expect.") + return() + } + + # fread's failures here are split across three channels, and only one of + # them is an error. It ERRORS on a file it cannot parse at all; it WARNS + # (returning a 0x0 table) on a 0-byte file; and on a row with the wrong + # field count it warns without erroring, either stopping early or + # discarding the row as a "footer". So warnings are captured rather than + # discarded -- but they are not the primary defence against a dropped row; + # the line count below is. See that check for why. + fread_warnings <- character(0) + parsed <- withCallingHandlers( + tryCatch( + data.table::fread(file$datapath, + # plan section 0.4: an all-numeric GROUP column is otherwise typed + # integer, so a condition genuinely named "0010" reads + # back as "10" and can never be matched. + colClasses = list(character = "GROUP")), + error = function(e) { + reject("Could not read the tracer constants file: ", conditionMessage(e)) + NULL + } + ), + warning = function(w) { + fread_warnings <<- c(fread_warnings, conditionMessage(w)) + invokeRestart("muffleWarning") + } + ) + if (is.null(parsed)) return() + + # A 0-byte file warns rather than erroring, and a header-only file parses + # cleanly to 0 rows -- where all(logical(0)) is TRUE, so every downstream + # check would pass on it. + if (ncol(parsed) == 0 || nrow(parsed) == 0) { + reject("The tracer constants file has no data rows. It needs a header ", + "row of ", paste(get_qc_required_tracer_columns(), collapse = ", "), + " and one row per condition.") + return() + } + + # fread keeps duplicate column names and `$` silently returns the FIRST, so + # a spreadsheet carrying an old and a corrected TracerConstant column would + # quietly use the stale one. + duplicated_columns <- unique(colnames(parsed)[duplicated(colnames(parsed))]) + if (length(duplicated_columns) > 0) { + reject("The tracer constants file has more than one column named: ", + paste(duplicated_columns, collapse = ", "), + ". Delete the extra column(s) so it is unambiguous which values apply.") + return() + } + + missing <- get_missing_upload_columns(colnames(parsed), + get_qc_required_tracer_columns()) + if (length(missing) > 0) { + reject("The tracer constants file is missing required column(s): ", + paste(missing, collapse = ", "), + ". Required columns (case-sensitive): ", + paste(get_qc_required_tracer_columns(), collapse = ", "), ".") + return() + } + + # A row fread could not parse is DROPPED, not reported as an error. Where + # the row sits decides which: mid-file it stops early, and last it is + # discarded as a "single-line footer". Most such files are still caught + # downstream, because dropping a row usually leaves a condition uncovered + # and the group check demands complete coverage. The exception is a dropped + # row for a condition another row already covers -- a second "0hr" line + # typed as "0hr,0,42" instead of "0hr,0.42". That file passes every check + # below while the value the user actually entered is silently gone, and it + # would have been rejected as a duplicate had it parsed. + # + # Counted from the source rather than matched against fread's warning text: + # the wording is not part of data.table's API, and fread also emits + # unrelated warnings ("Previous fread() session was not cleaned up + # properly") that must not reject a good file. + source_rows <- tryCatch( + sum(nzchar(trimws(readLines(file$datapath, warn = FALSE)))) - 1L, + error = function(e) NA_integer_ + ) + if (!is.na(source_rows) && source_rows > nrow(parsed)) { + reject(source_rows - nrow(parsed), " row(s) could not be read and were ", + "skipped, so the file is not the one you think you uploaded. ", + "Check for stray separators or decimal commas (write 0.42, not ", + "0,42), then upload it again.") + return() + } + + # Anything else fread had to say. Reported only once the column check has + # passed: before that, a malformed file is better explained by the + # missing-column message than by fread's internals. + if (length(fread_warnings) > 0) { + showNotification( + paste0(file$name, " parsed with warnings: ", + paste(fread_warnings, collapse = " ")), + type = "warning", duration = 10) + } + + if (!qc_tracer_values_in_range(parsed)) { + values <- suppressWarnings(as.numeric(as.character(parsed$TracerConstant))) + out_of_range <- !is.finite(values) | + values < CONSTANTS_QC$tracer_min | values > CONSTANTS_QC$tracer_max + reject("TracerConstant must be a number between ", CONSTANTS_QC$tracer_min, + " and ", CONSTANTS_QC$tracer_max, " (inclusive) for every row. ", + "Check condition(s): ", + paste(as.character(parsed$GROUP)[out_of_range], collapse = ", "), ".") + return() + } + + # plan section 0.7: the labels matter. The default wording names "GROUP mapping" and + # "ProteinLevelData", and the GROUP mapping is a DIFFERENT upload on this + # same page -- a user who mis-typed a condition here would go and edit an + # unrelated file. + group_errors <- qc_mapping_group_errors( + parsed$GROUP, conditions, + subject = "The tracer constants file", + reference = "the experimental conditions") + if (length(group_errors) > 0) { + reject(paste(group_errors, collapse = " "), + " The file must have exactly one row per condition; clear the ", + "upload to use 1 for every condition instead.") + return() + } + + # plan section 0.3: calculateTurnoverRatios re-keys the vector through parse_timepoint, + # so names that do not survive it drop rows or collide -- silently, and in + # the collision case while the metadata table displays the non-colliding + # number. Checked at upload rather than at Run so the message arrives while + # the user is still looking at the file. + timepoint_errors <- qc_tracer_timepoint_errors(conditions) + if (length(timepoint_errors) > 0) { + reject(paste(timepoint_errors, collapse = " ")) + return() + } + + uploaded <- stats::setNames(parsed$TracerConstant, as.character(parsed$GROUP)) + resolved <- tryCatch( + qc_resolve_tracer_constants(conditions, uploaded), + error = function(e) { + reject(conditionMessage(e)) + NULL + } ) + if (is.null(resolved)) return() + + tracer_upload(list(state = "valid", values = resolved, file = file$name)) + showNotification(paste0("Tracer constants loaded from ", file$name, + " (", length(resolved), " conditions)."), + type = "message", duration = 6) }) + # Decision K: condition_metadata is a shared reactiveVal that ordinary + # actions rewrite AFTER a tracer upload -- re-clicking the load page's + # proceed button and uploading a GROUP mapping both replace it wholesale. + # Nothing else invalidates the upload, so without this the resolved vector + # would either go stale or blow up later as a raw "Internal error" blaming + # the software for the user's click order. + # + # Only a genuine change to the condition SET clears it: proceed1 rewrites the + # table on every click, and dropping a valid upload each time would be its + # own bug (QA 4.5). Cleared to "rejected", not "absent", so the app still + # refuses to fall back to all-1s behind the user's back (plan section 0.1). + # Registered conditionally: get_condition_metadata is documented as + # "reactive (or NULL)" and qcServer defaults it to NULL, so an unguarded + # get_condition_metadata() would be NULL() -- an error thrown on the first + # reactive flush of the session, on every template. Every sibling read in + # this module guards the same way. + if (!is.null(get_condition_metadata)) { + observeEvent(get_condition_metadata(), { + current <- tracer_upload() + if (!identical(current$state, "valid")) return() + if (setequal(trimws(names(current$values)), trimws(get_conditions()))) return() + + shinyjs::reset(NAMESPACE_QC$tracer_constants_file) + tracer_upload(list(state = "rejected", values = NULL, file = current$file)) + showNotification( + paste0("The experimental conditions changed after ", current$file, + " was uploaded, so its tracer constants no longer apply. ", + "Upload a file matching the new conditions, or press Clear to ", + "use 1 for every condition."), + type = "warning", duration = 10) + }, ignoreInit = TRUE) + } + + # ---- Tracer panel visibility ---- + # + # shinyjs::toggle on the statically mounted div, mirroring the + # template-gated upload panels at R/qc-server-data-upload.R:659-671. + # observe() rather than observeEvent(get_template()) because the gate has two + # dependencies, and toggle() must re-run when either moves. + # + # get_data() is the second half of the gate, so the panel stays off the + # "upload pre-summarized abundances" flow. That is INTENTIONAL, not an + # oversight, and is inherited from the req(get_data()) in the renderUI this + # replaces (plan section 0.5): on that flow the turnover ratios were computed + # -- and any enrichment correction applied -- outside the app, so there is + # nothing left here for a tracer constant to divide. The Upload Summarized + # Abundances tab states this where a user on that flow can actually read it; + # help text inside a hidden panel would not be visible to them. + # The state term is not redundant with the data term. get_data is an + # eventReactive on the load page's proceed button that returns NULL when a + # load FAILS (R/loadpage-server-data-loaders.R:67-78), so: upload a bad + # tracer file (Run now disabled), go back, re-click proceed, load fails -> + # data goes NULL, this panel would hide, and the Clear button that is the + # only way out of "rejected" would vanish while Run stayed disabled. The + # template never changed, so the clearing observer above does not fire + # either. That is exactly the dead end plan section 0.1 requires not to + # exist, so the panel stays mounted for as long as its state can block Run. + observe({ + loaded <- tryCatch(get_data(), error = function(e) NULL) + shinyjs::toggle( + NAMESPACE_QC$tracer_constants_panel, + condition = identical(get_template(), TEMPLATES$protein_turnover) && + (!is.null(loaded) || !identical(tracer_upload()$state, "absent")) + ) + }) + + output[[NAMESPACE_QC$tracer_constants_status]] <- renderUI({ + current <- tracer_upload() + switch( + current$state, + valid = span(class = "text-success", + paste0("Using tracer constants from ", current$file, ".")), + pending = span(class = "text-muted", + "Reading tracer constants file... If this does not finish ", + "(for example the file is over the upload size limit), ", + "press Clear."), + rejected = span(class = "text-danger", + "Tracer constants were not accepted. Fix the file and ", + "upload it again, or press Clear to use 1 for every condition."), + span(class = "text-muted", + "No file uploaded: every condition uses 1 (no tracer correction).") + ) + }) + + turnover_ratios <- eventReactive(input$run, { + # Cleared before the guards below, not after them, so that every path which + # fails to reach the commit further down leaves no snapshot at all. The + # snapshot describes the constants that produced the ratios now on screen; + # a run that produces no ratios must therefore leave nothing behind, or the + # generated script would cite constants for a table the user cannot see. + # Placing this after the req()s left a stale snapshot alive whenever a + # second Run bailed out early -- e.g. summarization returning NULL, which + # empties the table while the previous run's constants stayed on record. + tracer_constants_used(NULL) + req(!is.null(app_template) && !is.null(app_template()) && app_template() == TEMPLATES$protein_turnover) req(preprocess_data()) req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) conditions <- as.character(get_condition_metadata()$Condition) - tracer_consts <- sapply(conditions, function(cond) { - val <- input[[paste0("tracer_", make.names(cond))]] - if (is.null(val)) 1.0 else as.numeric(val) - }) - names(tracer_consts) <- conditions + + # eventReactive isolates its body, so this read takes a snapshot of the + # upload as it stands at Run and creates no dependency on it -- exactly + # what Decision I requires. Read from tracer_upload() and never from + # input[[tracer_constants_file]]: shinyjs::reset clears the widget on the + # client only, so a cleared upload still has its old name and datapath in + # the input, and reading it would resurrect constants the user deleted. + upload <- tracer_upload() + + # plan section 0.1 forbids falling back to all-1s behind the user's back, + # and the toggleState that enforces it is CLIENT-side. shinyjs::onevent + # needs a server round trip before Run is disabled, so a click inside that + # window arrives here with the state still "pending" -- the exact race + # Decision I names. Refusing here makes the guarantee server-side; the + # notification is what tells the user why the click did nothing. + if (upload$state %in% c("pending", "rejected")) { + showNotification( + paste0("Turnover ratios were not calculated: the tracer constants ", + "file is still being checked or was not accepted. Wait for it ", + "to finish, fix it, or press Clear to use 1 for every ", + "condition."), + type = "error", duration = 10) + req(FALSE) + } + uploaded <- if (identical(upload$state, "valid")) upload$values else NULL + + # The same helper the generated script resolves through, so the analysis + # and the script cannot disagree. It THROWS rather than defaulting to 1s + # when it cannot honour the user's intent; that is the point (Decision G), + # but an uncaught stop() inside this eventReactive surfaces as a bare red + # error and output$turnover_ratios_panel would tryCatch it into a silent + # "no ratios". So: name the reason in a toast, then req() out, leaving the + # snapshot cleared above rather than recording constants never applied. + tracer_consts <- tryCatch( + qc_resolve_tracer_constants(conditions, uploaded), + error = function(e) { + showNotification( + paste0("Turnover ratios were not calculated. ", conditionMessage(e), + " Upload a tracer constants file matching the current ", + "conditions, or press Clear to use 1 for every condition."), + type = "error", duration = 10) + NULL + } + ) + req(tracer_consts) # Use ProteinLevelData when any condition has more than one sample (run); # fall back to FeatureLevelData for purely single-replicate designs. @@ -50,7 +428,7 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, samples_per_condition <- tapply(pld$RUN, pld$GROUP, function(x) length(unique(x))) use_protein_level <- any(samples_per_condition > 1) - if (use_protein_level) { + ratios <- if (use_protein_level) { calculateTurnoverRatios( pld, channel_col = "LABEL", @@ -83,6 +461,22 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, tracer_constants = tracer_consts ) } + + # Committed only once the fit has RETURNED. A reactiveVal write is not + # rolled back when the body aborts, so committing before the fit left a + # snapshot on record whenever the fit threw -- and the fit does throw on + # plausible data, e.g. ProteinLevelData carrying no "H" rows. The script + # would then cite constants, and name the uploaded file, for a table that + # never drew. This is the same rule as the clear at the top of the body: + # a run that produces no ratios leaves nothing behind. + tracer_constants_used(list( + values = tracer_consts, + source = if (is.null(uploaded)) CONSTANTS_QC$tracer_source_none + else CONSTANTS_QC$tracer_source_upload, + file = if (is.null(uploaded)) NULL else upload$file + )) + + ratios }) observeEvent(input$run, { @@ -94,6 +488,21 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios_display <- reactive({ ratios <- turnover_ratios() req(ratios) + + # The snapshot is the single authority for "are there ratios on screen". + # turnover_ratios is an eventReactive, so nothing but a fresh Run can + # invalidate its cache -- in particular the template observer above cannot. + # Without this guard, switching the template away and back redrew this + # table from that surviving cache while the snapshot taken with it had been + # cleared, so the ratios on screen carried the uploaded correction while the + # generated script emitted all-1s stamped "the page was not run in this + # session". Gating the display on the snapshot keeps the pair inseparable: + # no snapshot, no table, and the user is asked to run again. + # + # Checked AFTER turnover_ratios() rather than before it: reading that + # eventReactive is what WRITES the snapshot, so an earlier req() would test + # the previous value and blank the table for a cycle on the first Run. + req(tracer_constants_used()) if (isTRUE(input[[NAMESPACE_QC$assign_feature_weights]]) && nrow(ratios) > 0) { calculatePeptideWeights(ratios) } else { @@ -101,27 +510,36 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } }) + # The table and the download button are rendered together, from one read of + # the ratios, rather than the button being toggled with enable() from a + # sibling output. This panel lives in a tabPanel, so its outputs are + # suspended while another tab is active and both re-render on activation; a + # one-off enable() message raced with that re-render and left the button + # greyed out next to a populated table. `tryCatch` maps the pending + # eventReactive (before the first "Run summarization") and any error in the + # calculation to "no ratios", so neither blocks the panel from drawing. output$turnover_ratios_panel <- renderUI({ req(!is.null(app_template) && !is.null(app_template()) && app_template() == TEMPLATES$protein_turnover) ns <- session$ns + ratios <- tryCatch(turnover_ratios_display(), error = function(e) NULL) + has_ratios <- !is.null(ratios) && NROW(ratios) > 0 + + download_button <- downloadButton(ns("download_turnover_ratios"), "Download Ratios") + if (!has_ratios) { + download_button <- disabled(download_button) + } + tagList( tags$br(), - p("Run protein summarization after filling in tracer constants in the side panel."), - uiOutput(ns("turnover_ratios_table_ui")), + p("Run protein summarization in the side panel to calculate turnover ratios."), + if (has_ratios) dataTableOutput(ns("turnover_ratios_table")), tags$br(), - disabled(downloadButton(ns("download_turnover_ratios"), "Download Ratios")) + download_button ) }) - output$turnover_ratios_table_ui <- renderUI({ - req(turnover_ratios_display()) - ns <- session$ns - enable("download_turnover_ratios") - dataTableOutput(ns("turnover_ratios_table")) - }) - output$turnover_ratios_table <- renderDataTable({ turnover_ratios_display() }, options = list(scrollX = TRUE)) @@ -135,5 +553,17 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } ) - turnover_ratios_display + # A list, not the bare ratios reactive: register_qc_data_upload needs the + # upload state to extend its existing toggleState("run", ...) observer, and a + # SECOND toggleState observer on the same button would fight the first + # (last writer wins on each flush). + # tracer_constants is exposed separately from ratios rather than bundled into + # it: ratios (turnover_ratios_display) carries a req(), and Decision E is + # explicit that the reactive reaching the Download-code path must not, or the + # silent error takes the button out on every template. + list( + ratios = turnover_ratios_display, + tracer_upload = tracer_upload, + tracer_constants = tracer_constants_used + ) } diff --git a/R/server.R b/R/server.R index 4f472293..23a50844 100644 --- a/R/server.R +++ b/R/server.R @@ -52,6 +52,7 @@ server = function(input, output, session) { qc_input = qc_values$input preprocess_data = qc_values$preprocessData get_turnover_ratios = qc_values$turnoverRatios + get_tracer_constants = qc_values$tracerConstants statmodel_values = statmodelServer( id = "statmodel", @@ -62,7 +63,12 @@ server = function(input, output, session) { preprocess_data = preprocess_data, app_template = app_template, turnover_ratios = get_turnover_ratios, - condition_metadata = get_condition_metadata + condition_metadata = get_condition_metadata, + # Passed BARE, like turnover_ratios above and unlike the reactive()-wrapped + # qc_input: this is already a reactive, and reactive(reactive(x)) reaches the + # consumer as a closure that is not NULL and cannot be coerced -- so the + # NULL default would never catch it (plan Decision E). + tracer_constants = get_tracer_constants ) statmodel_input = statmodel_values$input data_comparison = statmodel_values$dataComparison diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index e0eac6d6..e079f0af 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -1,4 +1,17 @@ -generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app_template = TEMPLATES$default) { +#' Build the downloadable reproducible-analysis script. +#' +#' @param tracer_constants The tracer-constant provenance record snapshotted by +#' the QC page at Run: a list of `values` (named numeric, keyed by raw +#' condition string), `source` ("upload" / "none") and `file`. `NULL` means the +#' QC page was never run in this session -- a reachable state, not a defect +#' (plan section 0.6), because the Download-code button only requires a +#' contrast matrix. Trailing with a NULL default so the existing positional +#' call sites -- production plus nine in the tests -- stay valid (plan +#' Decision E). +#' @noRd +generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, + app_template = TEMPLATES$default, + tracer_constants = NULL) { codes = preprocessDataCode(qc_input, loadpage_input) # Check if this is a response curve analysis @@ -14,7 +27,19 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app codes = paste(codes, "library(MSstatsResponse)\n", sep = "") if (isTRUE(app_template == TEMPLATES$protein_turnover)) { - codes = paste(codes, build_turnover_analysis_code(qc_input, comp_mat, increasing), sep = "") + # Resolved HERE rather than at the top of the function, deliberately: on + # every other template comp_mat is a bare matrix, where `$GROUP` throws + # "$ operator is invalid for atomic vectors" and would take the + # Download-code button out on all four templates. + if (is.null(tracer_constants)) { + tracer_constants = list( + values = qc_default_tracer_constants(as.character(comp_mat$GROUP)), + source = CONSTANTS_QC$tracer_source_not_run, + file = NULL + ) + } + codes = paste(codes, build_turnover_analysis_code(qc_input, comp_mat, increasing, + tracer_constants), sep = "") return(codes) } @@ -156,35 +181,179 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app } +#' The provenance comment stamped above the tracer_constants vector. +#' +#' Three states, not two (plan section 0.6). The one v1 of this feature would +#' have written -- "# No tracer constants file uploaded" -- was asserted on a +#' path where a REJECTED file had silently fallen back to all-1s, so the comment +#' actively vouched for the wrong thing. Exactly one of the three lines is +#' emitted, so the script says what happened rather than what was intended. +#' +#' The three wordings are deliberately chosen so that no one of them contains a +#' distinguishing phrase of another. "uploaded on the data-processing page" was +#' previously a substring of the no-upload sentence ("... was uploaded on the +#' data-processing page"), which made any grep for the upload state -- in a test, +#' a script, or by a user reading the file -- match the case where nothing was +#' uploaded at all. See the mutual-exclusivity test in test-module-turnover.R. +#' @noRd +build_tracer_provenance_comment <- function(tracer_constants) { + source <- tracer_constants$source + if (is.null(source)) source <- CONSTANTS_QC$tracer_source_not_run + + if (identical(source, CONSTANTS_QC$tracer_source_upload)) { + file <- tracer_constants$file + # encodeString, not paste0: a file name containing a newline would otherwise + # split the comment and leave the remainder as (invalid) code. + # length() rather than is.null() alone: `||` errors on a zero-length operand + # in current R, so a character(0) file name would take the whole script + # generator down instead of degrading to the generic label. + label <- if (length(file) != 1L || is.na(file) || !nzchar(file)) "an uploaded file" + else encodeString(as.character(file), quote = "\"") + return(paste0( + "# Tracer constants: uploaded on the data-processing page, from ", label, ".\n")) + } + if (identical(source, CONSTANTS_QC$tracer_source_none)) { + return(paste0( + "# Tracer constants: no file was supplied on the data-processing page, so\n", + "# every condition uses 1 (no tracer correction).\n")) + } + paste0( + "# Tracer constants: the data-processing page was not run in this session,\n", + "# so every condition uses 1 (no tracer correction).\n") +} + +#' Serialize a double as R source that reads back as the identical double. +#' +#' `paste0(1/3)` emits 15 significant digits, so the constant in the downloaded +#' script is NOT the constant the app divided by -- a reproducible script that +#' silently reproduces something else. The shortest round-tripping form is +#' preferred so ordinary values stay readable ("0.9", not "0.90000000000000002"). +#' +#' The 17-digit fallback is best-effort: R's own string-to-double conversion is +#' not always correctly rounded (verified on R 4.5.2, `as.numeric(sprintf("%.17g", +#' 0.123456789012345678))` is 1 ULP off), so a hand-crafted double need not +#' round-trip through any decimal form. Irrelevant in practice here, because +#' tracer constants arrive as short decimal text in a CSV. +#' @noRd +format_r_double <- function(value) { + # suppressWarnings because as.numeric("NA") warns. Callers are expected to have + # rejected non-finite values already, but a warning escaping a downloadHandler + # is a confusing way to learn that they did not. + for (digits in 15:17) { + text <- sprintf(paste0("%.", digits, "g"), value) + if (identical(suppressWarnings(as.numeric(text)), value)) return(text) + } + sprintf("%.17g", value) +} + #' Generate reproducible code for the protein-turnover dose-response pipeline. #' -#' Mirrors the app's turnover flow: calculateTurnoverRatios (with the -#' user-entered tracer constants), an optional calculatePeptideWeights step when +#' Mirrors the app's turnover flow: calculateTurnoverRatios (with the resolved +#' tracer constants), an optional calculatePeptideWeights step when #' "Assign feature weights" is checked, then a weighted doseResponseFit and #' visualizeResponseProtein. Kept as a plain string builder so it can be #' unit-tested without a running session. #' -#' @param qc_input The QC module input list (tracer_* numerics and -#' assign_feature_weights checkbox live here). +#' @param qc_input The QC module input list (the assign_feature_weights checkbox +#' lives here). #' @param comp_mat The turnover contrast matrix (GROUP + TimeVal columns); its #' GROUP column supplies the condition names the tracer constants are keyed by. #' @param increasing Logical passed through to the fit / visualization. +#' @param tracer_constants Required, not defaulted (plan Decision G.2): a list of +#' `values` (named numeric keyed by raw condition string), `source` (one of the +#' CONSTANTS_QC$tracer_source_* provenance states) and `file`. Defaulting it +#' would reinstate the original bug -- emitting all-1s that look deliberate -- +#' so the caller is forced to say which constants were actually used. #' @return A character scalar of R code, appended after `library(MSstatsResponse)`. #' @noRd -build_turnover_analysis_code <- function(qc_input, comp_mat, increasing) { +build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, + tracer_constants) { conditions <- as.character(comp_mat$GROUP) weighting <- isTRUE(qc_input[[NAMESPACE_QC$assign_feature_weights]]) - # Serialize the tracer constants keyed by original condition name, matching - # the app (calculateTurnoverRatios parses these names into timepoints). - tracer_vals <- vapply(conditions, function(cond) { - val <- qc_input[[paste0("tracer_", make.names(cond))]] - if (is.null(val)) 1.0 else as.numeric(val) - }, numeric(1)) - tracer_pairs <- paste0(" \"", conditions, "\" = ", tracer_vals, collapse = ",\n") + # The vector is no longer rebuilt from comp_mat$GROUP, so nothing structurally + # guarantees it covers the conditions being fitted any more. It can genuinely + # drift: the snapshot is taken at QC Run, while comp_mat is rebuilt from + # condition_metadata afterwards and its GROUP cells are editable in the + # contrast table. An uncovered condition would emit c(...)[["2h"]] -> NA, + # H_frac / NA -> NA, i.e. a script that runs to completion and fits nothing. + # Failing here is loud but honest; emitting a quietly wrong script is not. + values <- tracer_constants$values + if (is.null(values) || length(values) == 0 || is.null(names(values))) { + stop("Cannot generate reproducible code: no tracer constants are recorded ", + "for this turnover analysis. Run protein summarization on the ", + "data-processing page first.") + } + if (length(conditions) == 0) { + stop("Cannot generate reproducible code: the contrast matrix lists no ", + "experimental conditions.") + } + # A condition name that is blank cannot be written as an R argument name: + # `c("" = 1)` is a PARSE error ("attempt to use zero-length variable name"), + # so emitting it produces a script that does not even load. Verified reachable + # without an upload -- a blank Condition cell in the annotation reaches the + # all-1s default path, which runs none of the upload observer's name checks. + # The message names the annotation file because the metadata table disables + # editing on the Condition column (plan section 0.3). + blank_conditions <- is.na(conditions) | !nzchar(trimws(conditions)) + if (any(blank_conditions)) { + stop("Cannot generate reproducible code: ", sum(blank_conditions), + " experimental condition(s) have a blank name. Give every condition a ", + "name in the annotation file and load the data again.") + } + # Keys are trimmed on both sides for the same reason + # qc_resolve_tracer_constants trims (plan section 0.4): a condition carried in + # from Excel as "0h " is not editable in the metadata table, so a strict match + # would be a dead end the user cannot clear. + # + # Trimming can however collapse two distinct keys onto one ("0h" and "0h "), + # and match() would then hand BOTH conditions the first one's value -- a wrong + # constant, silently. Only a repeated key carrying DIFFERING values is + # actually ambiguous: repeated with the same value it cannot mispair, and + # rejecting that would newly break the benign duplicate the all-1s default + # can produce. qc_resolve_tracer_constants rejects a colliding file before it + # can be snapshotted, so this is defence in depth rather than a live path. + upload_keys <- trimws(as.character(names(values))) + repeated <- unique(upload_keys[duplicated(upload_keys)]) + ambiguous <- repeated[vapply(repeated, function(key) { + length(unique(values[upload_keys == key])) > 1L + }, logical(1))] + if (length(ambiguous) > 0) { + stop("Cannot generate reproducible code: the recorded tracer constants are ", + "ambiguous for condition(s): ", paste(ambiguous, collapse = ", "), + ". Re-upload the tracer constants file with one row per condition.") + } + matched <- match(trimws(conditions), upload_keys) + if (anyNA(matched)) { + stop("Cannot generate reproducible code: the recorded tracer constants do ", + "not cover condition(s): ", + paste(conditions[is.na(matched)], collapse = ", "), + ". Re-run protein summarization on the data-processing page so the ", + "constants match the current conditions.") + } + # is.finite, not anyNA: Inf passes an NA check and emits a literal `Inf` into + # the script, where H_frac / Inf is 0 and every L_frac becomes 1 -- a script + # that runs to completion and reports total turnover everywhere. Verified. + tracer_vals <- suppressWarnings(as.numeric(values[matched])) + if (!all(is.finite(tracer_vals))) { + bad <- !is.finite(tracer_vals) + stop("Cannot generate reproducible code: the recorded tracer constant for ", + "condition(s) ", paste(conditions[bad], collapse = ", "), + " is not a finite number.") + } + + # Keyed by the RAW condition name, matching the app: calculateTurnoverRatios + # re-keys the vector with parse_timepoint(names(x)), so make.names()-style + # sanitization here would change which constant a condition receives. + # encodeString(quote = "\"") rather than paste0-ing quotes (plan Decision J): + # a condition containing a quote or a backslash otherwise produces a script + # that does not parse, and dropping make.names() is what newly exposes that. + tracer_pairs <- paste0(" ", encodeString(conditions, quote = "\""), " = ", + vapply(tracer_vals, format_r_double, character(1)), + collapse = ",\n") code <- paste0( - "\n# Tracer constants entered per condition on the data-processing page\n", + "\n", build_tracer_provenance_comment(tracer_constants), "tracer_constants = c(\n", tracer_pairs, "\n)\n", "\n# Calculate turnover (Heavy/Light) ratios. Use protein-level data when any\n", diff --git a/man/qcServer.Rd b/man/qcServer.Rd index 5137c705..7599a09f 100644 --- a/man/qcServer.Rd +++ b/man/qcServer.Rd @@ -27,9 +27,17 @@ qcServer( \item{loadpage_input}{input object from loadpage UI} \item{get_data}{stored function that returns the data from loadpage} + +\item{app_template}{reactive (or NULL) returning the selected template name (e.g. TEMPLATES$default)} + +\item{get_condition_metadata}{reactive (or NULL) returning the condition metadata table} } \value{ -input object with user selected options +a list with four elements: \code{input} (the module's input object), +\code{preprocessData} (reactive returning the preprocessed data), +\code{turnoverRatios} (reactive returning the turnover ratios, or the uploaded +ratios when those override them), and \code{tracerConstants} (reactive +returning the tracer-constant provenance record snapshotted at Run) } \description{ This function sets up the QC server to process data based on user diff --git a/man/statmodelServer.Rd b/man/statmodelServer.Rd index 077435f6..867cefe1 100644 --- a/man/statmodelServer.Rd +++ b/man/statmodelServer.Rd @@ -13,7 +13,8 @@ statmodelServer( preprocess_data, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), - condition_metadata = reactive(NULL) + condition_metadata = reactive(NULL), + tracer_constants = reactive(NULL) ) } \arguments{ @@ -30,6 +31,14 @@ statmodelServer( \item{preprocess_data}{stored function that returns preprocessed data} \item{app_template}{reactive returning the selected template name (e.g. TEMPLATES$default)} + +\item{turnover_ratios}{reactive returning the calculated turnover ratios} + +\item{condition_metadata}{reactive returning the condition metadata table} + +\item{tracer_constants}{reactive returning the tracer-constant provenance +record snapshotted by the QC page at Run (values / source / file), or +NULL when the data-processing page has not been run in this session} } \value{ list object with user selected options and matrix build diff --git a/tests/testthat/data/tracer/README.md b/tests/testthat/data/tracer/README.md new file mode 100644 index 00000000..fc315542 --- /dev/null +++ b/tests/testthat/data/tracer/README.md @@ -0,0 +1,88 @@ +# Tracer-constant CSV fixtures + +Authored for Phase 0.2 of `plans/tracer-constants-QA.md`. Used by the manual QA +walkthrough (Phases 2–5) and available to automated tests in +`tests/testthat/` via `test_path("data/tracer/")`. + +Schema is `GROUP,TracerConstant` (plan §5.A). + +## Condition names + +These use the **eight conditions of the working turnover dataset**, not the +`0h`/`6h`/`24h` names from the plan's example schema: + + 0hr, 1hr, 4hr, 12hrs, 24hrs, 48hrs, 96hrs, 168hrs + +Verified that both time parsers agree on all eight (`0, 1, 4, 12, 24, 48, 96, +168`) with no collisions and no `NA`s — so these fixtures reach the specific +trap each one exists for, rather than stopping at the group-match check. + +Do not substitute `T0h`/`Time_0h` style names; both parse to `NA` under +`parse_timepoint`'s anchored `^[0-9]+` and yield an empty result set (plan +§0.3). **If the dataset's conditions change, rewrite the `GROUP` column in every +file here to match** — otherwise every fixture fails at the group-match check +and none of the traps below are reachable. + +> Note on §0.3: this dataset cannot exercise the `24h`+`1d` collision case. No +> condition name contains `d` or `w`, so `autofill_condition_value` and +> `parse_timepoint` return identical values for all eight. Constructing that +> case needs a deliberately renamed annotation. + +## Files + +| File | Contents | What it must trap | +|---|---|---| +| `tracer_good.csv` | all eight conditions, `0.98` down to `0.91` | happy path; all values in `[0.01, 1]` | +| `tracer_missing_col.csv` | second column named `Tracer` | missing-column check | +| `tracer_nonnumeric.csv` | `12hrs` = `0.5abc` | Decision B coercion trap | +| `tracer_zero.csv` | `12hrs` = `0` | §0.2 — below the `0.01` floor (and would divide to `Inf`) | +| `tracer_tiny.csv` | `12hrs` = `1e-10` | §0.2 — below the `0.01` floor, must be **rejected** | +| `tracer_floor.csv` | `12hrs` = `0.01` | §0.2 — the inclusive boundary, must be **accepted** | +| `tracer_over.csv` | `12hrs` = `1.5` | range upper bound | +| `tracer_unknown.csv` | all eight conditions **plus** `336hrs` | group match | +| `tracer_partial.csv` | omits `168hrs` | Decision C (all-or-nothing coverage) | +| `tracer_dup.csv` | `0hr` twice, `0.98` then `0.42` | duplicate rows | +| `tracer_dupcol.csv` | `GROUP,TracerConstant,TracerConstant` | A6 | +| `tracer_empty.csv` | 0 bytes | A5 | +| `tracer_headeronly.csv` | header row only | A5 | +| `tracer_quote.csv` | `24"hrs` as a GROUP | Decision J | + +## The `0.01` floor + +§0.2 was resolved to an **inclusive `0.01` floor**: accepted range is +`[0.01, 1]`. `tracer_tiny.csv` and `tracer_floor.csv` are a matched pair +straddling that boundary — `1e-10` must be rejected, `0.01` must be accepted. A +`>` written where `>=` was meant passes every other fixture here and is caught +only by `tracer_floor.csv`, so run the two together. + +## Verified behaviour (data.table `fread`) + +Each fixture was checked to actually reproduce its trap, not just to look like +it would: + +- **`tracer_nonnumeric.csv`** — `fread` types the column `character`, and + `all(x > 0 & x <= 1)` over the column returns **`TRUE`** by lexicographic + comparison. It passes a naive range check, then `as.numeric` + silently yields `NA`. This is why the range helper must coerce first. +- **`tracer_dupcol.csv`** — `fread` keeps **both** `TracerConstant` columns; + `dt$TracerConstant` silently returns the **first**. The first column holds + `0.01`–`0.08` and the second the correct `0.98`–`0.91`, so "took the stale + column" is visible in the output rather than being a subtle offset. +- **`tracer_empty.csv`** — `fread` **warns** (`has size 0. Returning a NULL + data.table`) and returns a `0x0` data.table. It does not error, so a + `tryCatch` around `fread` alone will not catch this. +- **`tracer_headeronly.csv`** — parses cleanly to 0 rows with correct names, and + `all(logical(0))` is `TRUE`, so a naive range check **passes** on it. +- **`tracer_quote.csv`** — written with a bare `24"h` rather than the RFC 4180 + `"24""h"` form **on purpose**: `fread` does not unescape doubled quotes here + (it yields the literal `24""hrs`), whereas the bare field parses to exactly + one `"` character. Confirmed that feeding that group name through the current + unescaped `paste0(" \"", conditions, "\" = ", ...)` produces a script that + fails `parse()` with `unexpected symbol`. + + Reaching the script-generation step needs a condition genuinely named + `24"hrs` in the annotation; against the unmodified annotation this file stops + at the group-match check instead. + +Phase 3 also calls for a **non-CSV file**. That is not checked in — use any +handy binary or text file (e.g. `inst/extdata/evidence.rda`). diff --git a/tests/testthat/data/tracer/tracer_dup.csv b/tests/testthat/data/tracer/tracer_dup.csv new file mode 100644 index 00000000..49657948 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_dup.csv @@ -0,0 +1,10 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 +0hr,0.42 diff --git a/tests/testthat/data/tracer/tracer_dupcol.csv b/tests/testthat/data/tracer/tracer_dupcol.csv new file mode 100644 index 00000000..3877625e --- /dev/null +++ b/tests/testthat/data/tracer/tracer_dupcol.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant,TracerConstant +0hr,0.01,0.98 +1hr,0.02,0.97 +4hr,0.03,0.96 +12hrs,0.04,0.95 +24hrs,0.05,0.94 +48hrs,0.06,0.93 +96hrs,0.07,0.92 +168hrs,0.08,0.91 diff --git a/tests/testthat/data/tracer/tracer_empty.csv b/tests/testthat/data/tracer/tracer_empty.csv new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/data/tracer/tracer_floor.csv b/tests/testthat/data/tracer/tracer_floor.csv new file mode 100644 index 00000000..57a15e20 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_floor.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.01 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_good.csv b/tests/testthat/data/tracer/tracer_good.csv new file mode 100644 index 00000000..7eb6d94a --- /dev/null +++ b/tests/testthat/data/tracer/tracer_good.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_headeronly.csv b/tests/testthat/data/tracer/tracer_headeronly.csv new file mode 100644 index 00000000..bc273354 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_headeronly.csv @@ -0,0 +1 @@ +GROUP,TracerConstant diff --git a/tests/testthat/data/tracer/tracer_missing_col.csv b/tests/testthat/data/tracer/tracer_missing_col.csv new file mode 100644 index 00000000..605290cf --- /dev/null +++ b/tests/testthat/data/tracer/tracer_missing_col.csv @@ -0,0 +1,9 @@ +GROUP,Tracer +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_nonnumeric.csv b/tests/testthat/data/tracer/tracer_nonnumeric.csv new file mode 100644 index 00000000..aa347985 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_nonnumeric.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.5abc +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_over.csv b/tests/testthat/data/tracer/tracer_over.csv new file mode 100644 index 00000000..a0e3824a --- /dev/null +++ b/tests/testthat/data/tracer/tracer_over.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,1.5 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_partial.csv b/tests/testthat/data/tracer/tracer_partial.csv new file mode 100644 index 00000000..e497fb2c --- /dev/null +++ b/tests/testthat/data/tracer/tracer_partial.csv @@ -0,0 +1,8 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 diff --git a/tests/testthat/data/tracer/tracer_quote.csv b/tests/testthat/data/tracer/tracer_quote.csv new file mode 100644 index 00000000..b920b976 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_quote.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24"hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_tiny.csv b/tests/testthat/data/tracer/tracer_tiny.csv new file mode 100644 index 00000000..de8f8132 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_tiny.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,1e-10 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/data/tracer/tracer_unknown.csv b/tests/testthat/data/tracer/tracer_unknown.csv new file mode 100644 index 00000000..d6819c7a --- /dev/null +++ b/tests/testthat/data/tracer/tracer_unknown.csv @@ -0,0 +1,10 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0.95 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 +336hrs,0.90 diff --git a/tests/testthat/data/tracer/tracer_zero.csv b/tests/testthat/data/tracer/tracer_zero.csv new file mode 100644 index 00000000..8b2e4bd4 --- /dev/null +++ b/tests/testthat/data/tracer/tracer_zero.csv @@ -0,0 +1,9 @@ +GROUP,TracerConstant +0hr,0.98 +1hr,0.97 +4hr,0.96 +12hrs,0 +24hrs,0.94 +48hrs,0.93 +96hrs,0.92 +168hrs,0.91 diff --git a/tests/testthat/test-module-qc-ui.R b/tests/testthat/test-module-qc-ui.R index f8b3ac7e..b49c5924 100644 --- a/tests/testthat/test-module-qc-ui.R +++ b/tests/testthat/test-module-qc-ui.R @@ -21,7 +21,15 @@ test_that("qcUI renders the namespaced processing-option input ids", { input_ids <- c("global_norm", "log", "summarization", "null", "maxQC", "norm", "standards", "reference_norm", "remove_norm_channel", "features_used", "censInt", "null1", "maxQC1", "MBi", "remove50", - "typequant", "format", "summ", "fname", "run", "update_results") + "typequant", "format", "summ", "fname", "run", "update_results", + # The tracer-constants panel is statically mounted and + # server-toggled, and every one of these ids is addressed + # server-side through NAMESPACE_QC rather than as a literal + # (shinyjs::toggle/reset/onevent, input[[...]], output[[...]]). + # A renamed or un-namespaced id would leave the panel, the + # Clear button or the status line silently inert with the rest + # of the suite green, so they are pinned here. + "tracer_constants_file", "tracer_constants_clear") for (id in input_ids) { expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), info = paste("Missing input id:", id)) @@ -35,7 +43,9 @@ test_that("qcUI renders every server-toggled visibility container", { "standards_type_section", "reference_norm_panel", "lf_options_panel", "features_topn_panel", "censoring_section", "mbi_panel", "profileplot_options_panel", "qualitymetrics_options_panel", - "nonptm_downloads_panel", "ptm_downloads_panel") + "nonptm_downloads_panel", "ptm_downloads_panel", + "data_upload_mapping_panel", "data_upload_ratios_panel", + "tracer_constants_panel") for (id in container_ids) { expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), info = paste("Missing container id:", id)) @@ -54,3 +64,31 @@ test_that("the collapsed normalization select keeps all label-free choices", { info = paste("Missing normalization choice:", choice)) } }) + +test_that("qcUI mounts the tracer-constants status output", { + html <- render_qc_ui_html("test") + # uiOutput, not an input, so it needs its own assertion. Without it the + # absent/pending/rejected/valid states have nowhere to render, and a rejected + # upload looks identical to a successful one (plan Decision H). + expect_true(grepl('id="test-tracer_constants_status"', html, fixed = TRUE)) +}) + +test_that("the tracer-constants help text quotes CONSTANTS_QC, not a literal", { + html <- render_qc_ui_html("test") + # Catches the drift plan section 5.B warns about: if the floor is revised in + # CONSTANTS_QC and the help text keeps a hardcoded number, the expected + # string moves and this fails. It cannot catch a literal that happens to + # equal today's value -- both render identically -- which is why the range + # check and the rejection message read the same constant. + expect_true(grepl(paste0("between ", CONSTANTS_QC$tracer_min, " and ", + CONSTANTS_QC$tracer_max), html, fixed = TRUE)) + + # Scoped to the panel's own markup. Page-wide, "GROUP" appears a dozen times + # in unrelated uploads and would still match with this panel deleted. + panel_start <- regexpr("test-tracer_constants_panel", html, fixed = TRUE) + expect_gt(panel_start, 0) + panel <- substr(html, panel_start, panel_start + 3000L) + for (column in get_qc_required_tracer_columns()) { + expect_true(grepl(column, panel, fixed = TRUE), info = column) + } +}) diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index ec1aa4d2..9ab89c59 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -785,4 +785,114 @@ test_that("create_download_plot_handler is invoked with all 6 arguments", { info = "create_download_plot_handler should receive 9 arguments") } ) -}) \ No newline at end of file +}) +# ============================================================================ +# Tracer constants: the statmodelServer -> generate_analysis_code hop +# ============================================================================ + +test_that("statmodelServer forwards the tracer_constants snapshot to generate_analysis_code", { + # The highest-value hop in the threading chain and the one the first draft of + # this feature left untested. A correct generator wired to nothing is exactly + # the original bug, so this asserts the value ARRIVES, not that the generator + # formats it (test-module-turnover.R covers the formatting). + # + # data_comparison_code is private to the module and only read by the download + # handler, so it is captured through create_download_handlers -- the same + # stub-the-collaborator pattern as the create_download_plot_handler test. + captured = new.env(parent = emptyenv()) + captured$code_reactive = NULL + captured$args = NULL + + mockery::stub(statmodelServer, "create_download_handlers", + function(output, data_comparison, SignificantProteins, data_comparison_code) { + captured$code_reactive = data_comparison_code + }) + mockery::stub(statmodelServer, "generate_analysis_code", + function(...) { captured$args = list(...); "# generated\n" }) + + snapshot = list(values = stats::setNames(c(1, 0.9), c("0h", "6h")), + source = CONSTANTS_QC$tracer_source_upload, + file = "constants.csv") + metadata = reactiveVal(NULL) + + testServer( + statmodelServer, + args = list( + parent_session = MockShinySession$new(), + loadpage_input = reactive({ + list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0) + }), + qc_input = reactive({ list(normalization = "equalizeMedians") }), + get_data = reactive({ create_mock_raw_data() }), + preprocess_data = reactive({ create_mock_data("DDA", "protein") }), + app_template = reactive(TEMPLATES$protein_turnover), + condition_metadata = metadata, + tracer_constants = reactive(snapshot) + ), + { + expect_false(is.null(captured$code_reactive), + info = "create_download_handlers must receive the code reactive") + + session$setInputs(!!NAMESPACE_STATMODEL$comparison_mode := + CONSTANTS_STATMODEL$comparison_mode_response_curve) + # Set only after the comparison mode, because the observer that builds the + # turnover contrast matrix req()s the response-curve mode. + metadata(data.frame(Condition = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE)) + session$setInputs(!!NAMESPACE_STATMODEL$modeling_start := 1) + + captured$code_reactive() + + expect_equal(length(captured$args), 6, + info = "generate_analysis_code must be called with the tracer snapshot appended") + expect_identical(captured$args[[5]], TEMPLATES$protein_turnover) + expect_identical(captured$args[[6]], snapshot, + info = "the snapshot must arrive unwrapped and unmodified") + } + ) +}) + +test_that("statmodelServer defaults the tracer snapshot to NULL when no reactive is supplied", { + # Every existing caller and test omits the argument; none of them may start + # failing, and the generator must see NULL (the "QC page never run" state) + # rather than a reactive it cannot coerce. + captured = new.env(parent = emptyenv()) + captured$code_reactive = NULL + captured$args = NULL + + mockery::stub(statmodelServer, "create_download_handlers", + function(output, data_comparison, SignificantProteins, data_comparison_code) { + captured$code_reactive = data_comparison_code + }) + mockery::stub(statmodelServer, "generate_analysis_code", + function(...) { captured$args = list(...); "# generated\n" }) + + metadata = reactiveVal(NULL) + + testServer( + statmodelServer, + args = list( + parent_session = MockShinySession$new(), + loadpage_input = reactive({ + list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0) + }), + qc_input = reactive({ list(normalization = "equalizeMedians") }), + get_data = reactive({ create_mock_raw_data() }), + preprocess_data = reactive({ create_mock_data("DDA", "protein") }), + app_template = reactive(TEMPLATES$protein_turnover), + condition_metadata = metadata + ), + { + session$setInputs(!!NAMESPACE_STATMODEL$comparison_mode := + CONSTANTS_STATMODEL$comparison_mode_response_curve) + metadata(data.frame(Condition = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE)) + session$setInputs(!!NAMESPACE_STATMODEL$modeling_start := 1) + + captured$code_reactive() + + expect_equal(length(captured$args), 6) + expect_null(captured$args[[6]]) + } + ) +}) diff --git a/tests/testthat/test-module-turnover.R b/tests/testthat/test-module-turnover.R index e20fd58b..48011758 100644 --- a/tests/testthat/test-module-turnover.R +++ b/tests/testthat/test-module-turnover.R @@ -409,14 +409,22 @@ test_that("generate_analysis_code produces turnover-specific code for protein_tu # Tests for build_turnover_analysis_code (weighted reproducible script) # ============================================================================ +# A tracer_constants snapshot in the shape register_qc_turnover records it. +# Written as a helper because the argument is now REQUIRED: a default would let +# a future test silently assert all-1s behaviour, which is the bug under repair. +tracer_snapshot <- function(values, source = CONSTANTS_QC$tracer_source_upload, + file = "tracer.csv") { + list(values = values, source = source, file = file) +} + test_that("build_turnover_analysis_code includes weights when the checkbox is enabled", { comp_mat <- data.frame(GROUP = c("T0h", "T4h"), TimeVal = c(0, 4), stringsAsFactors = FALSE) qc_input <- list(assign_feature_weights = TRUE) - qc_input[[paste0("tracer_", make.names("T0h"))]] <- 1.0 - qc_input[[paste0("tracer_", make.names("T4h"))]] <- 0.9 - code <- MSstatsShiny:::build_turnover_analysis_code(qc_input, comp_mat, increasing = TRUE) + code <- MSstatsShiny:::build_turnover_analysis_code( + qc_input, comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(c("T0h" = 1.0, "T4h" = 0.9))) has <- function(p) grepl(p, code, fixed = TRUE) expect_true(has("calculatePeptideWeights(turnover_ratios)"), @@ -428,7 +436,7 @@ test_that("build_turnover_analysis_code includes weights when the checkbox is en expect_true(has("\"weight\")"), info = "weighted script must retain the weight column in prepared_data") expect_true(has("\"T4h\" = 0.9"), - info = "tracer constants must be serialized from qc_input, keyed by condition") + info = "tracer constants must be serialized from the resolved snapshot, keyed by condition") }) test_that("build_turnover_analysis_code omits weighting when the checkbox is disabled", { @@ -436,7 +444,11 @@ test_that("build_turnover_analysis_code omits weighting when the checkbox is dis stringsAsFactors = FALSE) qc_input <- list(assign_feature_weights = FALSE) - code <- MSstatsShiny:::build_turnover_analysis_code(qc_input, comp_mat, increasing = FALSE) + code <- MSstatsShiny:::build_turnover_analysis_code( + qc_input, comp_mat, increasing = FALSE, + tracer_constants = tracer_snapshot(c("T0h" = 1, "T4h" = 1), + source = CONSTANTS_QC$tracer_source_none, + file = NULL)) expect_false(grepl("calculatePeptideWeights", code, fixed = TRUE), info = "unweighted script must not compute peptide weights") @@ -451,12 +463,329 @@ test_that("build_turnover_analysis_code emits syntactically valid R", { stringsAsFactors = FALSE) for (flag in c(TRUE, FALSE)) { code <- MSstatsShiny:::build_turnover_analysis_code( - list(assign_feature_weights = flag), comp_mat, increasing = TRUE + list(assign_feature_weights = flag), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(c("T0h" = 1, "T4h" = 0.9, "T8h" = 0.8)) ) expect_silent(parse(text = code)) } }) +# --------------------------------------------------------------------------- +# Risk #1: the emitted vector must round-trip to the vector the app divided by. +# +# Deliberately NOT a grepl() for a substring: that is the shape of assertion +# that masked the original bug, because it passes on a script whose vector is +# right in the one place it looks and all-1s everywhere else. Evaluating the +# emitted source and comparing the whole object catches names, values, ORDER and +# precision at once. +# --------------------------------------------------------------------------- + +# Pulls the `tracer_constants = c(...)` assignment back out of the generated +# script and evaluates it, so the assertion is against what R would actually +# bind, not against the text. +eval_emitted_tracer_constants <- function(code) { + env <- new.env(parent = baseenv()) + found <- FALSE + for (expr in as.list(parse(text = code))) { + is_assignment <- is.call(expr) && length(expr) == 3L && + as.character(expr[[1L]])[1L] %in% c("=", "<-") && + is.name(expr[[2L]]) && identical(as.character(expr[[2L]]), "tracer_constants") + if (is_assignment) { + eval(expr, env) + found <- TRUE + } + } + if (!found) stop("the generated script contains no tracer_constants assignment") + get("tracer_constants", envir = env) +} + +test_that("the emitted tracer_constants vector is identical to the resolved one", { + conditions <- c("0h", "6h", "24h") + # 1/3 is the point of the test: paste0() renders it to 15 significant digits, + # which parses back to a DIFFERENT double, so a "reproducible" script would + # divide by a number the app never used. + uploaded <- stats::setNames(c(1/3, 0.9, 1), conditions) + resolved <- MSstatsShiny:::qc_resolve_tracer_constants(conditions, uploaded) + + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), + data.frame(GROUP = conditions, TimeVal = c(0, 6, 24), stringsAsFactors = FALSE), + increasing = TRUE, tracer_constants = tracer_snapshot(resolved)) + + expect_identical(eval_emitted_tracer_constants(code), resolved) +}) + +test_that("the emitted vector follows the contrast matrix order, not the file order", { + conditions <- c("0h", "6h", "24h") + resolved <- stats::setNames(c(1, 0.9, 0.8), conditions) + # Same condition set, reversed: calculateTurnoverRatios keys by name, but an + # order-blind assertion would not notice a wrong-value-per-name pairing. + comp_mat <- data.frame(GROUP = rev(conditions), TimeVal = c(24, 6, 0), + stringsAsFactors = FALSE) + + emitted <- eval_emitted_tracer_constants( + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(resolved))) + + expect_identical(names(emitted), rev(conditions)) + expect_identical(unname(emitted[conditions]), unname(resolved)) +}) + +test_that("build_turnover_analysis_code escapes quotes in condition names", { + # Latent before this change, because make.names() sanitized the names away; + # keying by the raw condition string newly exposes it (plan Decision J). + conditions <- c('0h "baseline"', "6h\\late") + resolved <- stats::setNames(c(1, 0.9), conditions) + comp_mat <- data.frame(GROUP = conditions, TimeVal = c(0, 6), + stringsAsFactors = FALSE) + + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(resolved)) + + expect_silent(parse(text = code)) + expect_identical(eval_emitted_tracer_constants(code), resolved) +}) + +test_that("build_turnover_analysis_code refuses to emit constants it cannot vouch for", { + comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + build <- function(values) MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(values)) + + # An uncovered condition would emit NA and fit nothing, silently. + expect_error(build(c("0h" = 1)), "do not cover condition\\(s\\): 6h") + expect_error(build(NULL), "no tracer constants are recorded") + expect_error(build(c(1, 1)), "no tracer constants are recorded") + expect_error(build(c("0h" = 1, "6h" = NA_real_)), "is not a finite number") + # Inf passes an anyNA check and emits a literal `Inf`, where H_frac / Inf is 0 + # and the script reports total turnover for every peptide. + expect_error(build(c("0h" = 1, "6h" = Inf)), "is not a finite number") + expect_error(build(c("0h" = 1, "6h" = -Inf)), "is not a finite number") + expect_error(build(c("0h" = 1, "6h" = NaN)), "is not a finite number") + # Trimming can collapse two distinct keys onto one, and match() would then + # give BOTH conditions the first value. + expect_error( + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), + data.frame(GROUP = c("0h", "0h "), TimeVal = c(0, 0), stringsAsFactors = FALSE), + increasing = TRUE, + tracer_constants = tracer_snapshot(stats::setNames(c(0.5, 0.9), c("0h", "0h ")))), + "ambiguous for condition") + # ...but a key repeated with the SAME value cannot mispair, and the all-1s + # default legitimately produces one, so it must still build. + expect_silent( + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), + data.frame(GROUP = c("0h", "0h"), TimeVal = c(0, 0), stringsAsFactors = FALSE), + increasing = TRUE, + tracer_constants = tracer_snapshot(stats::setNames(c(1, 1), c("0h", "0h"))))) + # No default: forgetting the argument must fail, not fall back to all-1s. + expect_error( + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE), + "tracer_constants") +}) + +test_that("build_turnover_analysis_code refuses a blank condition name", { + # `c("" = 1)` is a PARSE error in R, not a runtime one, so emitting a blank + # condition name produces a downloadable script that will not even load. This + # is reachable WITHOUT an upload: a blank Condition cell in the annotation + # reaches the all-1s default path, which runs none of the upload observer's + # name checks. + for (blank in list("", " ", NA_character_)) { + comp_mat <- data.frame(GROUP = c(blank, "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + expect_error( + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot( + stats::setNames(c(1, 1), c(blank, "6h")))), + "blank name", + info = paste("must refuse condition name:", deparse(blank))) + } +}) + +test_that("a blank condition name cannot reach the script via the all-1s default", { + # The same hole one hop up: generate_analysis_code builds the default vector + # from comp_mat$GROUP, so the guard has to be the thing that stops it. + mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") + mock_input <- list() + mock_input[[NAMESPACE_STATMODEL$comparison_mode]] <- CONSTANTS_STATMODEL$comparison_mode_response_curve + mock_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] <- TRUE + + expect_error( + generate_analysis_code( + list(), list(), data.frame(GROUP = c("", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE), + mock_input, app_template = TEMPLATES$protein_turnover), + "blank name") +}) + +test_that("build_turnover_analysis_code matches conditions ignoring surrounding whitespace", { + # An Excel-sourced "0h " is not editable in the metadata table, so a strict + # match would be an unfixable dead end (plan section 0.4). + comp_mat <- data.frame(GROUP = c("0h ", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(c("0h" = 0.5, "6h" = 0.9))) + + expect_identical(unname(eval_emitted_tracer_constants(code)), c(0.5, 0.9)) +}) + +test_that("exactly one tracer provenance comment is stamped into the script", { + comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + # Each marker is the phrase that DISTINGUISHES its state. Deliberately shorter + # than the full comment: a marker only usable in its entirety would not catch + # the overlap this test exists to prevent. + markers <- c(upload = "uploaded on the data-processing page", + none = "no file was supplied on the data-processing page", + not_run = "the data-processing page was not run in this session") + + cases <- list( + upload = tracer_snapshot(c("0h" = 1, "6h" = 0.9), + source = CONSTANTS_QC$tracer_source_upload, + file = "constants.csv"), + none = tracer_snapshot(c("0h" = 1, "6h" = 1), + source = CONSTANTS_QC$tracer_source_none, file = NULL), + not_run = tracer_snapshot(c("0h" = 1, "6h" = 1), + source = CONSTANTS_QC$tracer_source_not_run, file = NULL) + ) + + for (state in names(cases)) { + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = cases[[state]]) + hits <- vapply(markers, function(m) grepl(m, code, fixed = TRUE), logical(1)) + expect_identical(names(markers)[hits], state, + info = paste("provenance comments must be mutually exclusive:", state)) + } + + # The markers must not be substrings of one another's comments. Before this + # was asserted, "uploaded on the data-processing page" matched the NO-upload + # comment ("...no tracer constants file was uploaded on the data-processing + # page"), so any grep for the upload state also matched the case where nothing + # was uploaded -- provenance that cannot be read unambiguously is not + # provenance. + comments <- vapply(cases, MSstatsShiny:::build_tracer_provenance_comment, + character(1)) + for (owner in names(markers)) { + for (other in setdiff(names(markers), owner)) { + expect_false(grepl(markers[[owner]], comments[[other]], fixed = TRUE), + info = paste0("the ", owner, " marker must not appear in the ", + other, " comment")) + } + } + + # The file name is quoted so it survives into the comment verbatim. + expect_true(grepl('from "constants.csv"', + MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = cases$upload), fixed = TRUE)) +}) + +test_that("a newline in the uploaded file name cannot break the provenance comment", { + comp_mat <- data.frame(GROUP = "0h", TimeVal = 0, stringsAsFactors = FALSE) + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = FALSE), comp_mat, increasing = TRUE, + tracer_constants = tracer_snapshot(c("0h" = 1), file = "bad\nname.csv")) + + expect_silent(parse(text = code)) +}) + +test_that("format_r_double emits the shortest form that reads back identically", { + for (value in c(1, 0.9, 0.01, 0.5, 1/3, 2/7, 0.123, 0.4567)) { + text <- MSstatsShiny:::format_r_double(value) + expect_identical(as.numeric(text), value, + info = paste("must round-trip:", value)) + } + # Readability is not sacrificed for the common case. + expect_identical(MSstatsShiny:::format_r_double(0.9), "0.9") + expect_identical(MSstatsShiny:::format_r_double(1), "1") +}) + +# --------------------------------------------------------------------------- +# Per-hop forwarding. The round-trip test above proves the generator is correct +# given the right input; these prove the right input actually reaches it. Both +# halves are needed -- the original bug was a correct generator wired to the +# wrong source. +# --------------------------------------------------------------------------- + +test_that("generate_analysis_code forwards the tracer snapshot into the turnover script", { + mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") + + comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + mock_input <- list() + mock_input[[NAMESPACE_STATMODEL$comparison_mode]] <- CONSTANTS_STATMODEL$comparison_mode_response_curve + mock_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] <- TRUE + mock_input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]] <- FALSE + + resolved <- stats::setNames(c(0.98, 0.93), c("0h", "6h")) + result <- generate_analysis_code( + list(), list(), comp_mat, mock_input, + app_template = TEMPLATES$protein_turnover, + tracer_constants = list(values = resolved, + source = CONSTANTS_QC$tracer_source_upload, + file = "constants.csv")) + + expect_identical(eval_emitted_tracer_constants(result), resolved) + expect_true(grepl("# Tracer constants: uploaded on the data-processing page", + result, fixed = TRUE)) +}) + +test_that("generate_analysis_code labels an unrun QC page as such rather than as no upload", { + # Reachable, not a defect: the Download-code button only requires a contrast + # matrix, and the upload-summarized-abundances flow never renders the tracer + # panel at all (plan section 0.6). The script must not claim the user declined + # a correction they were never offered. + mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") + + comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + mock_input <- list() + mock_input[[NAMESPACE_STATMODEL$comparison_mode]] <- CONSTANTS_STATMODEL$comparison_mode_response_curve + mock_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] <- TRUE + + result <- generate_analysis_code( + list(), list(), comp_mat, mock_input, + app_template = TEMPLATES$protein_turnover) + + expect_identical(eval_emitted_tracer_constants(result), + stats::setNames(c(1, 1), c("0h", "6h"))) + expect_true(grepl("the data-processing page was not run in this session", + result, fixed = TRUE)) + expect_false(grepl("no file was supplied", result, fixed = TRUE)) +}) + +test_that("generate_analysis_code resolves the NULL snapshot only inside the turnover branch", { + # On the group-comparison path comp_mat is a bare MATRIX, where `$GROUP` + # throws "$ operator is invalid for atomic vectors". Resolving the NULL + # snapshot at the top of the function -- rather than inside the turnover + # branch -- would therefore take the Download-code button out on every + # template. Verified against the existing matrix fixture shape used by + # test-utils-statmodel-server.R. + mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") + + comp_mat <- matrix(c(1, -1), nrow = 1, dimnames = list("C2-C1", c("C1", "C2"))) + mock_input <- list() + mock_input[[NAMESPACE_STATMODEL$visualization_plot_type]] <- "VolcanoPlot" + + for (template in c(TEMPLATES$default, TEMPLATES$chemoproteomics)) { + result <- generate_analysis_code( + list(), list(DDA_DIA = "DDA", BIO = "Protein"), comp_mat, mock_input, + app_template = template, tracer_constants = NULL) + expect_true(grepl("groupComparison", result, fixed = TRUE), + info = paste("group comparison path must still build on", template)) + expect_false(grepl("tracer_constants", result, fixed = TRUE), + info = paste("no tracer constants belong in the", template, "script")) + } +}) + test_that("generate_analysis_code does not set precalculated_ratios for chemoproteomics template", { mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") @@ -509,4 +838,740 @@ test_that("generate_analysis_code uses placeholder drug_name for non-turnover te expect_true(grepl("Enter drug name here", result), info = "Non-turnover code should use a placeholder drug name") -}) \ No newline at end of file +}) +# ============================================================================ +# Tests for the Turnover Ratios panel (register_qc_turnover) +# ============================================================================ + +library(shiny) + +# Minimal FeatureLevelData with paired heavy/light measurements at three +# timepoints, enough for calculateTurnoverRatios to return rows. +create_mock_turnover_summary <- function() { + groups <- c("0hr", "4hr", "24hr") + feature <- expand.grid(GROUP = groups, LABEL = c("H", "L"), + PEPTIDE = c("PEPTIDEK_2", "PEPTIDER_2"), + stringsAsFactors = FALSE) + feature$PROTEIN <- "ProtA" + feature$RUN <- match(feature$GROUP, groups) + feature$INTENSITY <- seq_len(nrow(feature)) * 1000 + # One run per condition, so the panel takes the FeatureLevelData branch. + protein <- data.frame(RUN = seq_along(groups), Protein = "ProtA", LABEL = "L", + LogIntensities = c(10, 11, 12), GROUP = groups, + stringsAsFactors = FALSE) + list(FeatureLevelData = feature, ProteinLevelData = protein) +} + +turnover_panel_server <- function(summary_data) { + function(input, output, session) { + register_qc_turnover( + input, output, session, + app_template = reactive(TEMPLATES$protein_turnover), + get_data = reactive(summary_data$FeatureLevelData), + get_condition_metadata = reactive( + data.frame(Condition = unique(summary_data$ProteinLevelData$GROUP), + stringsAsFactors = FALSE)), + preprocess_data = reactive(summary_data) + ) + } +} + +test_that("Download Ratios is disabled before summarization is run", { + testServer(turnover_panel_server(create_mock_turnover_summary()), { + panel <- as.character(output$turnover_ratios_panel$html) + expect_true(grepl("download_turnover_ratios", panel, fixed = TRUE)) + # shinyjs marks its own disabling with the shinyjs-disabled class; the + # plain "disabled" class is on every downloadButton until the client binds + # it, so it cannot distinguish the two states. + expect_true(grepl("shinyjs-disabled", panel, fixed = TRUE), + info = "Button should render disabled until ratios exist") + }) +}) + +test_that("Download Ratios is enabled once ratios are calculated", { + testServer(turnover_panel_server(create_mock_turnover_summary()), { + session$setInputs(run = 1) + panel <- as.character(output$turnover_ratios_panel$html) + expect_true(grepl("download_turnover_ratios", panel, fixed = TRUE)) + # Rendered from the ratios state, so it survives a re-render of the panel + # (outputs in an inactive tabPanel are suspended and re-render on + # activation, which a one-off shinyjs::enable() message does not). + expect_false(grepl("shinyjs-disabled", panel, fixed = TRUE)) + }) +}) + +# ============================================================================ +# Tests for the tracer-constants upload observer (register_qc_turnover) +# ============================================================================ + +# The eight conditions of the working turnover dataset. Every fixture in +# data/tracer/ is keyed to these; see that directory's README. +turnover_conditions <- c("0hr", "1hr", "4hr", "12hrs", "24hrs", + "48hrs", "96hrs", "168hrs") + +# register_qc_turnover's return is captured through an environment rather than +# session$getReturned(), which is not available for a bare server function. +tracer_upload_server <- function(capture, + conditions = reactive( + data.frame(Condition = turnover_conditions, + stringsAsFactors = FALSE)), + template = reactive(TEMPLATES$protein_turnover)) { + function(input, output, session) { + capture$returned <- register_qc_turnover( + input, output, session, + app_template = template, + get_data = reactive(data.frame(x = 1)), + get_condition_metadata = conditions, + preprocess_data = reactive(NULL)) + } +} + +# Shiny delivers a fileInput's value as a one-row data frame. +tracer_file_input <- function(path) { + data.frame(name = basename(path), datapath = path, stringsAsFactors = FALSE) +} + +tracer_upload_state <- function(fixture) { + capture <- new.env() + state <- NULL + testServer(tracer_upload_server(capture), { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", fixture))) + state <<- capture$returned$tracer_upload() + }) + state +} + +test_that("a well-formed tracer file is accepted with one value per condition", { + for (fixture in c("tracer_good.csv", "tracer_floor.csv")) { + state <- tracer_upload_state(fixture) + expect_identical(state$state, "valid", info = fixture) + # Names are the raw condition strings: calculateTurnoverRatios re-keys the + # vector through parse_timepoint(names(x)), so they must survive intact. + expect_identical(names(state$values), turnover_conditions, info = fixture) + } + # tracer_floor.csv sits on the inclusive 0.01 boundary; a ">" written where + # ">=" was meant passes every other fixture and is caught only here. + expect_equal(unname(tracer_upload_state("tracer_floor.csv")$values[["12hrs"]]), + CONSTANTS_QC$tracer_min) +}) + +test_that("every malformed tracer file is rejected rather than silently defaulted", { + # Rejected, not absent: absent means "the user declined the correction" and + # runs with all 1s, which is the silent failure this feature exists to remove. + rejected <- c("tracer_missing_col.csv", "tracer_nonnumeric.csv", + "tracer_zero.csv", "tracer_tiny.csv", "tracer_over.csv", + "tracer_unknown.csv", "tracer_partial.csv", "tracer_dup.csv", + "tracer_dupcol.csv", "tracer_empty.csv", + "tracer_headeronly.csv", "tracer_quote.csv") + for (fixture in rejected) { + state <- tracer_upload_state(fixture) + expect_identical(state$state, "rejected", info = fixture) + expect_null(state$values, info = fixture) + } +}) + +test_that("a row fread silently discards rejects the file", { + # fread drops an unparseable row with a warning, not an error. A dropped row + # for a condition another row already covers passes the coverage check, so + # the file looks complete while the value the user typed is gone. + path <- file.path(tempdir(), "tracer_footer.csv") + writeLines(c("GROUP,TracerConstant", + paste0(turnover_conditions, ",", + c(0.98, 0.97, 0.96, 0.95, 0.94, 0.93, 0.92, 0.91)), + "0hr,0,42"), + path) + capture <- new.env() + testServer(tracer_upload_server(capture), { + session$setInputs(tracer_constants_file = tracer_file_input(path)) + expect_identical(capture$returned$tracer_upload()$state, "rejected") + }) +}) + +test_that("a rejected file does not leave the previous good file's values in play", { + capture <- new.env() + testServer(tracer_upload_server(capture), { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + expect_identical(capture$returned$tracer_upload()$state, "valid") + + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_unknown.csv"))) + state <- capture$returned$tracer_upload() + expect_identical(state$state, "rejected") + expect_null(state$values) + }) +}) + +test_that("a NULL condition-metadata argument does not error", { + # qcServer defaults get_condition_metadata to NULL and documents it as + # "reactive (or NULL)". An unguarded get_condition_metadata() is NULL(), + # which throws on the first flush of the session, on every template. + capture <- new.env() + expect_no_error( + testServer(tracer_upload_server(capture, conditions = NULL, + template = reactive(TEMPLATES$default)), { + session$setInputs(run = 1) + }) + ) +}) + +test_that("switching away from protein turnover clears a blocking tracer state", { + # The tracer panel, and with it the Clear button, is gated on the turnover + # template. A rejected state surviving a template switch would keep the Run + # button disabled with no on-screen way to re-enable it. + capture <- new.env() + template <- reactiveVal(TEMPLATES$protein_turnover) + testServer(tracer_upload_server(capture, template = template), { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_zero.csv"))) + expect_identical(capture$returned$tracer_upload()$state, "rejected") + + template(TEMPLATES$default) + session$flushReact() + expect_identical(capture$returned$tracer_upload()$state, "absent") + }) +}) + +test_that("a valid upload survives a metadata rewrite but not a change of conditions", { + # condition_metadata is rewritten wholesale by ordinary actions -- re-clicking + # the load page's proceed button, uploading a GROUP mapping -- so dropping the + # upload on every rewrite would be its own bug. Only a changed condition SET + # invalidates it. + capture <- new.env() + metadata <- reactiveVal(data.frame(Condition = turnover_conditions, + stringsAsFactors = FALSE)) + testServer(tracer_upload_server(capture, conditions = metadata), { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + expect_identical(capture$returned$tracer_upload()$state, "valid") + + metadata(data.frame(Condition = turnover_conditions, stringsAsFactors = FALSE)) + session$flushReact() + expect_identical(capture$returned$tracer_upload()$state, "valid") + + metadata(data.frame(Condition = c(turnover_conditions, "336hrs"), + stringsAsFactors = FALSE)) + session$flushReact() + expect_identical(capture$returned$tracer_upload()$state, "rejected") + }) +}) + +test_that("clearing the upload returns to the neutral all-ones state", { + capture <- new.env() + testServer(tracer_upload_server(capture), { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + expect_identical(capture$returned$tracer_upload()$state, "valid") + + session$setInputs(tracer_constants_clear = 1) + state <- capture$returned$tracer_upload() + expect_identical(state$state, "absent") + expect_null(state$values) + }) +}) + +# ============================================================================ +# Step 4: the constants resolved at Run are the ones the fit actually receives +# ============================================================================ + +# The upload observer tests above stop at the reactiveVal. These carry the +# value the rest of the way, because "the state says valid" and "the fit +# divided by those numbers" are different claims -- the whole bug this feature +# removes was a UI that asserted the first while the second was false. +# +# calculateTurnoverRatios is stubbed so the assertion is on the tracer_constants +# argument itself rather than on downstream ratios, which would depend on +# MSstatsResponse's arithmetic and on turnover fixture data this repo does not +# have (plan section 8). +# Two distinct runs per condition, so use_protein_level is TRUE and the +# ProteinLevelData branch is taken. +turnover_pld <- function() { + pld <- data.frame( + GROUP = rep(turnover_conditions, each = 2), + Protein = "P1", LogIntensities = 1, LABEL = "H", + stringsAsFactors = FALSE) + pld$RUN <- seq_len(nrow(pld)) + pld +} + +# One run per condition, so use_protein_level is FALSE and the FeatureLevelData +# branch is taken instead. Pairs with turnover_fld() below. +turnover_pld_single <- function() { + pld <- data.frame( + GROUP = turnover_conditions, + Protein = "P1", LogIntensities = 1, LABEL = "H", + stringsAsFactors = FALSE) + pld$RUN <- seq_len(nrow(pld)) + pld +} + +# Deliberately uses the FeatureLevelData column names (PEPTIDE/PROTEIN/ +# INTENSITY) rather than the ProteinLevelData ones, so a test can tell which of +# the two branches actually called the fit. +turnover_fld <- function() { + fld <- data.frame( + GROUP = turnover_conditions, + PROTEIN = "P1", PEPTIDE = "PEP1", INTENSITY = 1, LABEL = "H", + stringsAsFactors = FALSE) + fld$RUN <- seq_len(nrow(fld)) + fld +} + +# template and preprocess are injectable so the divergence regressions below can +# switch the app template mid-session and make a second Run bail out early; +# their defaults keep every other caller on the original single-template setup. +tracer_run_server <- function(capture, + conditions = reactive( + data.frame(Condition = turnover_conditions, + stringsAsFactors = FALSE)), + template = reactive(TEMPLATES$protein_turnover), + preprocess = reactive( + list(ProteinLevelData = turnover_pld()))) { + fn <- function(input, output, session) { + capture$returned <- register_qc_turnover( + input, output, session, + app_template = template, + get_data = reactive(data.frame(x = 1)), + get_condition_metadata = conditions, + preprocess_data = preprocess) + } + mockery::stub(fn, "register_qc_turnover", register_qc_turnover) + fn +} + +# Captures the tracer_constants argument handed to the fit, and which of the +# two branches called it -- the branch choice is otherwise invisible to the +# tests, because preprocess_data()$FeatureLevelData is NULL in this harness. +with_stubbed_fit <- function() { + capture <- new.env() + capture$constants_seen <- NULL + capture$fit_calls <- 0L + capture$data_seen <- NULL + fake_fit <- function(data, ...) { + args <- list(...) + capture$fit_calls <- capture$fit_calls + 1L + capture$constants_seen <- args$tracer_constants + capture$data_seen <- data + data.frame(Protein = "P1", TimeVal = 0, H_frac = 0.5) + } + list(capture = capture, fit = fake_fit) +} + +test_that("a valid upload reaches the fit; no upload sends all 1s", { + for (case in list(list(fixture = NULL, source = "none"), + list(fixture = "tracer_good.csv", source = "upload"))) { + ctx <- with_stubbed_fit() + capture <- ctx$capture + server <- tracer_run_server(capture) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + if (!is.null(case$fixture)) { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", case$fixture))) + } + session$setInputs(run = 1) + capture$snapshot <- capture$returned$tracer_constants() + }) + + label <- case$source + expected <- if (is.null(case$fixture)) { + stats::setNames(rep(1, length(turnover_conditions)), turnover_conditions) + } else { + stats::setNames(c(0.98, 0.97, 0.96, 0.95, 0.94, 0.93, 0.92, 0.91), + turnover_conditions) + } + + # Names AND values AND order: calculateTurnoverRatios re-keys by name, so a + # correct-values/wrong-names vector silently mis-assigns every constant. + expect_equal(capture$constants_seen, expected, info = label) + expect_equal(capture$snapshot$values, expected, info = label) + expect_identical(capture$snapshot$source, case$source, info = label) + # The ProteinLevelData branch, not the FeatureLevelData one: the harness + # supplies two runs per condition. Asserted because the fake fit otherwise + # makes the two branches indistinguishable. + expect_identical(capture$fit_calls, 1L, info = label) + expect_identical(nrow(capture$data_seen), 16L, info = label) + # Provenance is three-state (plan section 0.6), so "which file" has to + # survive alongside "from a file at all". + if (is.null(case$fixture)) { + expect_null(capture$snapshot$file, info = label) + } else { + expect_identical(capture$snapshot$file, case$fixture, info = label) + } + } +}) + +test_that("the FeatureLevelData branch also receives the tracer constants", { + # The single-replicate branch (R/qc-server-turnover.R). Every other fit test + # supplies two runs per condition and so only ever exercises the + # ProteinLevelData branch -- deleting tracer_constants = from this one would + # revert single-replicate turnover experiments to no correction with the rest + # of the suite still green. + ctx <- with_stubbed_fit() + capture <- ctx$capture + server <- tracer_run_server( + capture, + preprocess = reactive(list(ProteinLevelData = turnover_pld_single(), + FeatureLevelData = turnover_fld()))) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", "tracer_good.csv"))) + session$setInputs(run = 1) + }) + + expected <- stats::setNames(c(0.98, 0.97, 0.96, 0.95, 0.94, 0.93, 0.92, 0.91), + turnover_conditions) + + # Which branch ran: the fake fit is shared, so the data's column names are the + # only witness. INTENSITY means FeatureLevelData, LogIntensities would mean + # the harness silently fell back to the ProteinLevelData branch and this test + # would be asserting nothing new. + expect_identical(capture$fit_calls, 1L) + expect_true("INTENSITY" %in% names(capture$data_seen)) + expect_false("LogIntensities" %in% names(capture$data_seen)) + + expect_equal(capture$constants_seen, expected) +}) + +test_that("rejection messages name the tracer file, not the GROUP mapping upload", { + # plan section 0.7. qc_mapping_group_errors' defaults name "GROUP mapping" and + # "ProteinLevelData"; the GROUP mapping is a DIFFERENT upload on this same + # page, so the default wording sends a user who mis-typed a condition here off + # to edit an unrelated file. The labels are supplied only at the call site in + # R/qc-server-turnover.R, so nothing else pins them -- reverting that call to + # the defaults leaves every other test green. + cases <- list( + list(fixture = "tracer_unknown.csv", reference = TRUE), + list(fixture = "tracer_partial.csv", reference = TRUE), + # The duplicate-rows message names the subject only, not the reference. + list(fixture = "tracer_dup.csv", reference = FALSE)) + + for (case in cases) { + ctx <- with_stubbed_fit() + capture <- ctx$capture + capture$messages <- character(0) + server <- tracer_run_server(capture) + # Only the upload observer runs here (Run is never pressed), so the fit is + # never reached and must NOT be stubbed as well: two mockery::stub calls on + # the same function do not compose, and stubbing the fit first silently + # discards this one. + mockery::stub( + server, "showNotification", + function(ui, ...) { + capture$messages <- c(capture$messages, + paste(as.character(ui), collapse = " ")) + NULL + }, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", case$fixture))) + capture$state <- capture$returned$tracer_upload()$state + }) + + msg <- paste(capture$messages, collapse = " ") + expect_identical(capture$state, "rejected", info = case$fixture) + expect_true(grepl("The tracer constants file", msg, fixed = TRUE), + info = case$fixture) + if (case$reference) { + expect_true(grepl("the experimental conditions", msg, fixed = TRUE), + info = case$fixture) + } + # The two strings that would send the user to the wrong file. + expect_false(grepl("GROUP mapping", msg, fixed = TRUE), info = case$fixture) + expect_false(grepl("ProteinLevelData", msg, fixed = TRUE), info = case$fixture) + } +}) + +test_that("Run is refused server-side while an upload is pending or rejected", { + # plan section 0.1. toggleState disables the button on the CLIENT, and + # shinyjs::onevent needs a server round trip to set "pending", so a click in + # that window reaches the server with the button still live. Falling back to + # all-1s there is the silent failure the feature exists to remove. + for (fixture in c("tracer_partial.csv", "tracer_nonnumeric.csv")) { + ctx <- with_stubbed_fit() + capture <- ctx$capture + server <- tracer_run_server(capture) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", fixture))) + session$setInputs(run = 1) + capture$state <- capture$returned$tracer_upload()$state + capture$snapshot <- capture$returned$tracer_constants() + }) + + expect_identical(capture$state, "rejected", info = fixture) + # Neither run with 1s nor record a snapshot: the fit is never reached. + expect_identical(capture$fit_calls, 0L, info = fixture) + expect_null(capture$snapshot, info = fixture) + } +}) + +test_that("the snapshot never outlives the ratios it describes", { + # Decision I is a two-way guarantee: the snapshot must not drift ahead of the + # displayed ratios, and it must not survive them either. A snapshot left + # behind by a run that produced nothing would have the generated script cite + # tracer constants for an empty table. + ctx <- with_stubbed_fit() + capture <- ctx$capture + template <- reactiveVal(TEMPLATES$protein_turnover) + metadata <- reactiveVal(data.frame(Condition = turnover_conditions, + stringsAsFactors = FALSE)) + pld <- data.frame(GROUP = rep(turnover_conditions, each = 2), + Protein = "P1", LogIntensities = 1, LABEL = "H", + stringsAsFactors = FALSE) + pld$RUN <- seq_len(nrow(pld)) + + fn <- function(input, output, session) { + capture$returned <- register_qc_turnover( + input, output, session, + app_template = template, + get_data = reactive(data.frame(x = 1)), + get_condition_metadata = metadata, + preprocess_data = reactive(list(ProteinLevelData = pld))) + } + mockery::stub(fn, "register_qc_turnover", register_qc_turnover) + mockery::stub(fn, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(fn, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", "tracer_good.csv"))) + session$setInputs(run = 1) + capture$after_run <- capture$returned$tracer_constants() + + # Leaving turnover makes the ratios eventReactive's own req() fail, and + # shiny caches that error for the rest of the session. + template(TEMPLATES$default) + session$flushReact() + capture$after_switch <- capture$returned$tracer_constants() + }) + + expect_identical(capture$after_run$source, "upload") + expect_null(capture$after_switch) +}) + +test_that("a refused re-Run clears the snapshot left by an earlier good Run", { + # The dangerous ordering: a good run banks a snapshot, then the user replaces + # the file with a bad one and presses Run again. The re-Run is refused, so + # the ratios table still shows the FIRST run's numbers -- but if the snapshot + # survived it would too, and the generated script would keep citing a file + # the app has since rejected. Clearing is what makes the refusal visible + # downstream instead of silently reusing stale provenance. + ctx <- with_stubbed_fit() + capture <- ctx$capture + server <- tracer_run_server(capture) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", "tracer_good.csv"))) + session$setInputs(run = 1) + capture$after_good <- capture$returned$tracer_constants() + + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", "tracer_partial.csv"))) + session$setInputs(run = 2) + capture$after_bad <- capture$returned$tracer_constants() + }) + + expect_identical(capture$after_good$source, "upload") + expect_identical(capture$after_good$file, "tracer_good.csv") + # The refused re-Run never reaches the fit, and leaves nothing behind. + expect_identical(capture$fit_calls, 1L) + expect_null(capture$after_bad) +}) + +test_that("the snapshot is taken at Run and does not follow a later upload", { + # Decision I. A live view of the upload would make the ratios table show one + # set of constants while the downloadable script emitted another. + ctx <- with_stubbed_fit() + capture <- ctx$capture + server <- tracer_run_server(capture) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(run = 1) + capture$before <- capture$returned$tracer_constants() + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer", "tracer_good.csv"))) + capture$after <- capture$returned$tracer_constants() + capture$state <- capture$returned$tracer_upload()$state + }) + + expect_identical(capture$state, "valid") + expect_identical(capture$after$source, "none") + expect_equal(capture$after$values, capture$before$values) +}) + +test_that("the exposed constants reactive is NULL before Run and never errors", { + # Plan section 0.6's third provenance state, and Decision E: this value is + # read from the Download-code path on all four templates, so reading it + # before the QC page has run must not raise shiny.silent.error. + capture <- new.env() + before <- "unset" + testServer(tracer_upload_server(capture), { + before <<- capture$returned$tracer_constants() + }) + expect_null(before) +}) + +# ============================================================================ +# The qcServer -> server.R hop: return shape +# ============================================================================ + +# Wraps the real qcServer so its return value can be inspected. A shape +# assertion rather than a behavioural one: this hop is pure plumbing, and the +# way it breaks is a renamed or dropped key, which every downstream test would +# see only as a mysterious NULL. +qc_server_return_capture <- function(capture, template = TEMPLATES$protein_turnover) { + function(input, output, session) { + capture$returned <- qcServer( + input, output, session, + parent_session = session, + loadpage_input = reactive(list(BIO = "Protein", DDA_DIA = "LType", + filetype = "standard", proceed1 = 0)), + get_data = reactive(NULL), + app_template = reactive(template), + get_condition_metadata = reactive(NULL) + ) + } +} + +test_that("qcServer exposes tracerConstants alongside the ratios", { + capture <- new.env() + keys <- NULL + is_reactive <- NA + value <- "unset" + + testServer(qc_server_return_capture(capture), { + keys <<- names(capture$returned) + is_reactive <<- is.function(capture$returned$tracerConstants) + # Must be readable before anything has been run, on any template: server.R + # hands it to statmodelServer, which reads it from the Download-code path + # for all four templates (plan Decision E). + value <<- capture$returned$tracerConstants() + }) + + expect_true("tracerConstants" %in% keys, + info = "server.R reads qc_values$tracerConstants by exactly this name") + expect_true(all(c("input", "preprocessData", "turnoverRatios") %in% keys), + info = "the pre-existing keys must not be disturbed") + expect_true(is_reactive) + expect_null(value) +}) + +test_that("qcServer's tracerConstants is readable on a non-turnover template", { + capture <- new.env() + value <- "unset" + testServer(qc_server_return_capture(capture, template = TEMPLATES$default), { + value <<- capture$returned$tracerConstants() + }) + expect_null(value) +}) + +# ============================================================================ +# Decision I regressions: the ratios table and the generated script must never +# disagree about which constants were used. Both cases below passed the whole +# suite while diverging, because every existing test reads the two values only +# at the moment of Run, when they necessarily agree. +# ============================================================================ + +test_that("a template round-trip clears the ratios table with its snapshot", { + # turnover_ratios is an eventReactive, so nothing but a fresh Run invalidates + # its cache -- the template observer cannot. It does clear the snapshot, so + # switching away and back used to redraw a table carrying the uploaded + # correction while the script emitted all-1s stamped "not run in this + # session". Asserted after the round trip, not at Run, for that reason. + ctx <- with_stubbed_fit() + capture <- ctx$capture + template <- reactiveVal(TEMPLATES$protein_turnover) + server <- tracer_run_server(capture, template = template) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + session$setInputs(run = 1) + expect_identical(capture$returned$tracer_constants()$source, "upload") + expect_s3_class(capture$returned$ratios(), "data.frame") + + template(TEMPLATES$default) + session$flushReact() + template(TEMPLATES$protein_turnover) + session$flushReact() + + # No snapshot, so no table: the user is asked to run again rather than + # shown ratios the downloadable script would not reproduce. + expect_null(capture$returned$tracer_constants()) + expect_error(capture$returned$ratios(), class = "shiny.silent.error") + }) +}) + +test_that("a Run that bails before the fit leaves no stale snapshot", { + # The snapshot is cleared at the very top of the eventReactive, ahead of its + # req() guards. With the clear placed after them, a second Run that bailed -- + # here because summarization returned NULL -- emptied the table while the + # first run's constants stayed on record for the script. + ctx <- with_stubbed_fit() + capture <- ctx$capture + prep <- reactiveVal(list(ProteinLevelData = turnover_pld())) + server <- tracer_run_server(capture, preprocess = function() prep()) + mockery::stub(server, "calculateTurnoverRatios", ctx$fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + session$setInputs(run = 1) + expect_identical(capture$returned$tracer_constants()$source, "upload") + + prep(NULL) + session$setInputs(run = 2) + session$flushReact() + + expect_null(capture$returned$tracer_constants()) + expect_error(capture$returned$ratios(), class = "shiny.silent.error") + # The bailed Run must not have reached the fit at all. + expect_identical(capture$fit_calls, 1L) + }) +}) + +test_that("the snapshot is committed only after the fit returns", { + # A reactiveVal write is not rolled back when the eventReactive body aborts, + # and calculateTurnoverRatios throws on plausible data (ProteinLevelData with + # no "H" rows raises "Element `H` doesn't exist"). Committing before the fit + # therefore left the script citing constants -- and naming the uploaded file + # -- for a table that never drew. + # + # Asserted by reading the snapshot from INSIDE the fit rather than by making + # the fit throw: an error there is unhandled in the observer that forces this + # eventReactive, which destroys the session and takes every reactive with it, + # so nothing would be readable afterwards. The ordering is the real subject + # anyway, and it is what distinguishes the two versions. + ctx <- with_stubbed_fit() + capture <- ctx$capture + ordering_fit <- function(data, ...) { + capture$snapshot_during_fit <- capture$returned$tracer_constants() + ctx$fit(data, ...) + } + server <- tracer_run_server(capture) + mockery::stub(server, "calculateTurnoverRatios", ordering_fit, depth = 2) + + testServer(server, { + session$setInputs(tracer_constants_file = + tracer_file_input(test_path("data/tracer/tracer_good.csv"))) + session$setInputs(run = 1) + + expect_identical(capture$fit_calls, 1L) + # Nothing on record while the fit is still in flight and could throw... + expect_null(capture$snapshot_during_fit) + # ...and on record once it has returned. + expect_identical(capture$returned$tracer_constants()$source, "upload") + expect_identical(capture$returned$tracer_constants()$file, "tracer_good.csv") + }) +}) diff --git a/tests/testthat/test-qc-data-upload.R b/tests/testthat/test-qc-data-upload.R index 3c297afb..995ecbfe 100644 --- a/tests/testthat/test-qc-data-upload.R +++ b/tests/testthat/test-qc-data-upload.R @@ -98,6 +98,22 @@ test_that("qc_mapping_to_condition_metadata renames GROUP to Condition (turnover expect_type(out$TimeVal, "character") }) +test_that("qc_mapping_to_condition_metadata stores the same trimmed Condition that was validated", { + # qc_mapping_group_errors compares TRIMMED values, so a quoted "DMSO " cell + # (fread's strip.white leaves quoted fields alone) passes validation. If the + # raw value were stored, it would then miss the ProteinLevelData join and + # silently drop that condition's rows. + parsed = data.frame(GROUP = c("DMSO ", " 6h"), TimeVal = c(0, 6), + stringsAsFactors = FALSE) + protein_groups = c("DMSO", "6h") + + expect_length(MSstatsShiny:::qc_mapping_group_errors(parsed$GROUP, protein_groups), 0) + + out = MSstatsShiny:::qc_mapping_to_condition_metadata(parsed, TEMPLATES$protein_turnover) + expect_equal(out$Condition, protein_groups) + expect_true(all(out$Condition %in% protein_groups)) +}) + test_that("qc_mapping_to_condition_metadata keeps optional chemo columns when present", { # DoseUnit / DrugName are passed through only when present in the CSV. bare = data.frame(GROUP = c("DMSO", "Drug_10nM"), DoseVal = c(0, 10), @@ -187,3 +203,248 @@ test_that("qc_values_numeric_finite allows NA / blank when allow_na = TRUE", { na_default = data.frame(TimeVal = c(0, NA, 2), stringsAsFactors = FALSE) expect_false(MSstatsShiny:::qc_values_numeric_finite(na_default, "TimeVal")) }) + +# ============================================================================ +# Tracer-constant upload helpers (protein turnover). +# ============================================================================ + +test_that("get_qc_required_tracer_columns names the upload schema", { + expect_equal(MSstatsShiny:::get_qc_required_tracer_columns(), + c("GROUP", "TracerConstant")) +}) + +test_that("qc_tracer_values_in_range accepts the inclusive [min, max] band", { + tracer_min = MSstatsShiny:::CONSTANTS_QC$tracer_min + tracer_max = MSstatsShiny:::CONSTANTS_QC$tracer_max + in_range = function(x) MSstatsShiny:::qc_tracer_values_in_range( + data.frame(TracerConstant = x, stringsAsFactors = FALSE), "TracerConstant") + + # Both bounds are inclusive, and the band is populated in between. + expect_true(in_range(tracer_min)) + expect_true(in_range(tracer_max)) + expect_true(in_range(c(tracer_min, 0.5, tracer_max))) + + # Just under the floor fails, so the boundary is >= and not >. + expect_false(in_range(tracer_min - 0.001)) + # 0 divides to Inf; 1e-10 is worse because it passes a naive (0, 1] check and + # yields a huge H_frac whose L_frac is then silently clamped to 0. + expect_false(in_range(0)) + expect_false(in_range(1e-10)) + # Above the ceiling, negative, and non-finite. + expect_false(in_range(tracer_max + 0.5)) + expect_false(in_range(-0.2)) + expect_false(in_range(NA_real_)) + expect_false(in_range(Inf)) + # One bad value among good ones fails the whole file. + expect_false(in_range(c(0.5, NA_real_))) + + # A character column must be coerced before comparison: uncoerced, + # all(c("0.5", "0.5abc") > 0 & <= 1) is TRUE and the bad cell only becomes NA + # later, inside the analysis. + expect_true(in_range(c("0.5", "1"))) + expect_false(in_range(c("0.5", "0.5abc"))) + + # all(logical(0)) is TRUE, so empty input must be rejected explicitly. + expect_false(in_range(character(0))) + expect_false(in_range(numeric(0))) + expect_false(MSstatsShiny:::qc_tracer_values_in_range(NULL, "TracerConstant")) + # Absent column. + expect_false(MSstatsShiny:::qc_tracer_values_in_range( + data.frame(GROUP = "0h", stringsAsFactors = FALSE), "TracerConstant")) +}) + +test_that("qc_default_tracer_constants is all ones, named by condition", { + defaults = MSstatsShiny:::qc_default_tracer_constants(c("0h", "6h", "24h")) + # identical, not equal: the contract is a double vector, and expect_equal + # would accept rep(1L, n). + expect_identical(defaults, c("0h" = 1, "6h" = 1, "24h" = 1)) + + # A named numeric(0) is not NULL, so it would pass calculateTurnoverRatios' + # own guard and make every H_frac NA. Error instead. + expect_error(MSstatsShiny:::qc_default_tracer_constants(character(0)), + "no experimental conditions") +}) + +test_that("qc_resolve_tracer_constants defaults to ones when nothing is uploaded", { + conditions = c("0h", "6h", "24h") + expect_equal(MSstatsShiny:::qc_resolve_tracer_constants(conditions, NULL), + c("0h" = 1, "6h" = 1, "24h" = 1)) + expect_equal(MSstatsShiny:::qc_resolve_tracer_constants(conditions, numeric(0)), + c("0h" = 1, "6h" = 1, "24h" = 1)) +}) + +test_that("qc_resolve_tracer_constants reindexes to condition order", { + # File order must not leak through: calculateTurnoverRatios re-keys by name, + # so the returned vector has to carry the raw condition strings in the + # experiment's own order. + uploaded = c("24h" = 0.93, "0h" = 0.98, "6h" = 0.95) + expect_equal( + MSstatsShiny:::qc_resolve_tracer_constants(c("0h", "6h", "24h"), uploaded), + c("0h" = 0.98, "6h" = 0.95, "24h" = 0.93) + ) +}) + +test_that("qc_resolve_tracer_constants errors instead of reindexing to NA", { + # uploaded[conditions] silently returns NA under an NA name for an uncovered + # condition, and H_frac / NA is NA -- an empty result set with no warning. + expect_error( + MSstatsShiny:::qc_resolve_tracer_constants(c("0h", "6h"), c("0h" = 0.98)), + "missing for condition\\(s\\): 6h" + ) + # Unreadable value rather than absent key. + expect_error( + MSstatsShiny:::qc_resolve_tracer_constants(c("0h"), c("0h" = NA_real_)), + "could not be read for condition\\(s\\): 0h" + ) + # Zero conditions is a defect, not a default. + expect_error( + MSstatsShiny:::qc_resolve_tracer_constants(character(0), c("0h" = 0.98)), + "no experimental conditions" + ) +}) + +test_that("qc_tracer_timepoint_hours mirrors the MSstatsResponse parser", { + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours(c("0h", "6h", "24h")), + c(0, 6, 24)) + # The number is anchored at the start of the string. + expect_true(is.na(MSstatsShiny:::qc_tracer_timepoint_hours("Time_0h"))) + # Bare "d"/"w" matched anywhere, not just as a unit suffix. + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("1d"), 24) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("6h_drug"), 144) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("2w"), 336) + # NA in, NA out. The upstream parser errors here ("NAs are not allowed in + # subscripted assignments") once the vector is long enough for the day/week + # subscript assignment to fire, so this needs a length > 1 case to bite. + expect_true(is.na(MSstatsShiny:::qc_tracer_timepoint_hours(NA_character_))) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours(c("1d", NA, "2w")), + c(24, NA, 336)) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours(c("6h_drug", NA)), + c(144, NA)) +}) + +test_that("qc_tracer_misleading_units flags a stray d or w, not any suffix", { + flags = function(x) MSstatsShiny:::qc_tracer_misleading_units(x) + # The "d" of "drug" and the "w" of "washout" fire the day/week multipliers. + expect_true(flags("6h_drug")) + expect_true(flags("24h_washout")) + # A genuine day/week unit is not misleading. + expect_equal(flags(c("1d", "2w", "3 days", "4 weeks", "5wk")), rep(FALSE, 5)) + # A suffix carrying no "d" or "w" never fires the multiplier, so leaving it + # alone avoids rejecting a run that would have been correct. + expect_equal(flags(c("0h", "24h_rep1", "168hrs", "12hrs")), rep(FALSE, 4)) + expect_false(flags(NA_character_)) +}) + +test_that("qc_tracer_timepoint_errors rejects unparseable and colliding names", { + # The working dataset's conditions all parse, and none collide. + expect_equal( + MSstatsShiny:::qc_tracer_timepoint_errors( + c("0hr", "1hr", "4hr", "12hrs", "24hrs", "48hrs", "96hrs", "168hrs")), + character(0) + ) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_errors(c("0h", "6h", "24h")), + character(0)) + expect_equal(MSstatsShiny:::qc_tracer_timepoint_errors(character(0)), + character(0)) + + # Resolves to NA -> would drop every row of that condition. + unparseable = MSstatsShiny:::qc_tracer_timepoint_errors(c("Time_0h", "6h")) + expect_length(unparseable, 1) + expect_match(unparseable, "Time_0h", fixed = TRUE) + expect_match(unparseable, "annotation file") + + # "24h" and "1d" both resolve to 24, so the second silently takes the first's + # constant. + collision = MSstatsShiny:::qc_tracer_timepoint_errors(c("0h", "24h", "1d")) + expect_length(collision, 1) + expect_match(collision, "same timepoint (24 hours)", fixed = TRUE) + expect_match(collision, "24h", fixed = TRUE) + expect_match(collision, "1d", fixed = TRUE) + + # A stray unit letter resolves to a wrong-but-plausible timepoint, which + # neither the NA check nor the collision check would catch. + misleading = MSstatsShiny:::qc_tracer_timepoint_errors(c("0h", "6h_drug")) + expect_length(misleading, 1) + expect_match(misleading, "6h_drug", fixed = TRUE) + expect_match(misleading, "144 hours", fixed = TRUE) + # A suffix with no "d" or "w" is left alone. + expect_equal(MSstatsShiny:::qc_tracer_timepoint_errors(c("0h", "24h_rep1")), + character(0)) + + # Conditions are de-duplicated first, so a repeated name is not a collision + # with itself. + expect_equal(MSstatsShiny:::qc_tracer_timepoint_errors(c("6h", "6h")), + character(0)) + + # All three failure modes at once are reported separately. + expect_length( + MSstatsShiny:::qc_tracer_timepoint_errors(c("Time_0h", "6h_drug", "24h", "1d")), 3) +}) + +test_that("qc_tracer_values_in_range does not read factor level codes", { + # as.numeric(factor("2.0")) is 1, so an unconverted factor would validate an + # out-of-range value and reject valid ones. + expect_false(MSstatsShiny:::qc_tracer_values_in_range( + data.frame(TracerConstant = factor("2.0")))) + expect_true(MSstatsShiny:::qc_tracer_values_in_range( + data.frame(TracerConstant = factor(c("0.5", "0.7"))))) + # Degenerate column arguments return FALSE rather than throwing from `if`. + expect_false(MSstatsShiny:::qc_tracer_values_in_range( + data.frame(TracerConstant = 0.5), character(0))) + expect_false(MSstatsShiny:::qc_tracer_values_in_range( + data.frame(TracerConstant = 0.5), NA_character_)) +}) + +test_that("qc_resolve_tracer_constants matches on trimmed names", { + # condition_metadata is never normalized but fread strips whitespace, so an + # Excel-sourced trailing space would otherwise be unmatchable -- and + # unfixable, since the metadata table disables editing on Condition. + resolved = MSstatsShiny:::qc_resolve_tracer_constants( + c("0h ", "6h"), c("0h" = 0.98, " 6h" = 0.95)) + # Matching is trimmed; the returned NAMES stay raw, because + # calculateTurnoverRatios re-keys them through parse_timepoint. + expect_equal(resolved, c("0h " = 0.98, "6h" = 0.95)) + # Case stays strict. + expect_error( + MSstatsShiny:::qc_resolve_tracer_constants(c("0H"), c("0h" = 0.98)), + "missing for condition" + ) +}) + +test_that("qc_resolve_tracer_constants rejects a condition listed twice", { + # Silently taking the first of two rows is the same class of failure as a + # duplicated column: a corrected value loses to the stale one above it. + expect_error( + MSstatsShiny:::qc_resolve_tracer_constants("0h", c("0h" = 0.8, "0h" = 0.2)), + "more than once: 0h" + ) +}) + +test_that("qc_mapping_group_errors matches on trimmed names", { + expect_equal(MSstatsShiny:::qc_mapping_group_errors(c("0h "), c("0h")), + character(0)) + # Case is deliberately not folded. + expect_length(MSstatsShiny:::qc_mapping_group_errors(c("0H"), c("0h")), 2) +}) + +test_that("qc_mapping_group_errors labels are parameterized, defaults unchanged", { + # Defaults still name the GROUP mapping and ProteinLevelData, so the existing + # caller's messages are untouched. + default_msg = MSstatsShiny:::qc_mapping_group_errors(c("A"), c("A", "B")) + expect_match(default_msg, "GROUP mapping is missing row(s) for ProteinLevelData GROUP(s): B.", + fixed = TRUE) + + # A different upload names itself and its own reference, so the message does + # not send the user off to edit an unrelated file. + tracer_msg = MSstatsShiny:::qc_mapping_group_errors( + c("0h", "99h"), c("0h", "6h"), + subject = "Tracer constants file", reference = "the annotation") + expect_length(tracer_msg, 2) + expect_match(tracer_msg[1], + "Tracer constants file has GROUP value(s) not found in the annotation: 99h.", + fixed = TRUE) + expect_match(tracer_msg[2], + "Tracer constants file is missing row(s) for the annotation GROUP(s): 6h.", + fixed = TRUE) + expect_false(any(grepl("ProteinLevelData", tracer_msg, fixed = TRUE))) +}) From 03856867424fb13807d155de1fcba802e7f22b08 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 09:06:14 -0400 Subject: [PATCH 02/10] remove unnecessary fluff comments --- NAMESPACE | 4 +- R/constants.R | 22 --- R/main_calculations.R | 4 +- R/module-qc-server.R | 7 - R/module-qc-ui.R | 61 ++------ R/module-statmodel-server.R | 6 - R/qc-server-data-upload.R | 103 ++---------- R/qc-server-turnover.R | 242 +++++------------------------ R/server.R | 4 - R/statmodel-server-download-code.R | 110 ++++--------- 10 files changed, 94 insertions(+), 469 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8e0f4fc8..a41c43d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,9 +26,7 @@ export(tmt_summarization_loop) export(uiObject) export(xy_str) import(MSstats) -import(MSstatsConvert, except = c(MaxQtoMSstatsTMTFormat, - OpenMStoMSstatsTMTFormat, PDtoMSstatsTMTFormat, PhilosophertoMSstatsTMTFormat, - SpectroMinetoMSstatsTMTFormat)) +import(MSstatsConvert) import(MSstatsTMT) import(data.table) import(ggplot2) diff --git a/R/constants.R b/R/constants.R index 02297690..a0acaeb5 100644 --- a/R/constants.R +++ b/R/constants.R @@ -189,34 +189,12 @@ NAMESPACE_QC = list( # Data Upload tab template-gated upload panels data_upload_mapping_panel = "data_upload_mapping_panel", data_upload_ratios_panel = "data_upload_ratios_panel", - # Tracer-constants sidebar (protein turnover): server-toggled container, - # its optional CSV upload, the clear affordance the rejected state requires, - # and the status line that makes the three states visible. tracer_constants_panel = "tracer_constants_panel", tracer_constants_file = "tracer_constants_file", tracer_constants_clear = "tracer_constants_clear", tracer_constants_status = "tracer_constants_status" ) -# Tracer constants (protein turnover). The constant is a DIVISOR in -# MSstatsResponse::calculateTurnoverRatios (H_frac / tracer_factor), so 1 is the -# neutral default and 0 yields Inf. The floor is not merely "greater than zero": -# a value like 1e-10 passes a (0, 1] check and silently produces a huge H_frac -# whose L_frac is then clamped to 0 by pmax(1 - H_frac, 0), i.e. a -# plausible-looking but wrong result rather than an error. Enrichment is a -# measured biological fraction, so anything below 0.01 is implausible. -# The range check, its error message and the UI help text must all quote these, -# never a repeated literal. -# -# The three tracer_source_* values are the provenance states from plan section -# 0.6. They are named rather than inlined because they cross a file boundary: -# R/qc-server-turnover.R writes them into the snapshot and -# R/statmodel-server-download-code.R switches on them to choose the comment it -# stamps into the downloadable script. A typo in either would silently pick the -# wrong provenance, which is precisely the class of untraceable-provenance bug -# this feature exists to remove. "not_run" is genuinely distinct from "none": -# "none" means the user ran summarization and declined the correction, while -# "not_run" means the data-processing page never ran, so the app never asked. CONSTANTS_QC = list( tracer_min = 0.01, tracer_max = 1, diff --git a/R/main_calculations.R b/R/main_calculations.R index 055b1854..82496fcd 100644 --- a/R/main_calculations.R +++ b/R/main_calculations.R @@ -129,9 +129,7 @@ lf_summarization_loop = function(data, qc_input,loadpage_input, busy_indicator = #' @export #' @import MSstats #' @import MSstatsTMT -#' @rawNamespace import(MSstatsConvert, except = c(MaxQtoMSstatsTMTFormat, -#' OpenMStoMSstatsTMTFormat, PDtoMSstatsTMTFormat, PhilosophertoMSstatsTMTFormat, -#' SpectroMinetoMSstatsTMTFormat)) +#' @import MSstatsConvert #' @import data.table #' @importFrom shinybusy show_modal_progress_line update_modal_progress remove_modal_progress #' @importFrom methods new diff --git a/R/module-qc-server.R b/R/module-qc-server.R index 4c0e4170..0ddf6891 100644 --- a/R/module-qc-server.R +++ b/R/module-qc-server.R @@ -105,13 +105,6 @@ qcServer <- function(input, output, session, parent_session, loadpage_input, get input = input, preprocessData = effective_preprocess_data, turnoverRatios = data_upload$effective_turnover_ratios, - # The tracer constants that actually produced the ratios shown on the QC - # page, snapshotted at Run. Exposed alongside the ratios rather than - # bundled into them because the Download-code path reads it on ALL FOUR - # templates, so it must be a reactive that cannot raise -- see the - # tracer_constants_used comment in R/qc-server-turnover.R. NOT routed - # through data_upload: the uploaded-ratios override replaces the ratios, - # not the constants that were applied when computing them. tracerConstants = turnover$tracer_constants ) ) diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index 075fc54f..c9700983 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -187,65 +187,34 @@ qcUI <- function(id) { )), # Tracer constants (protein turnover only), toggled server-side by - # register_qc_turnover. Static and shinyjs::hidden(), NOT a renderUI: - # re-rendering destroys a mounted fileInput, which pushes NULL to the - # server while the parsed constants live on in a reactiveVal -- the UI - # would read "no file uploaded" while the fit kept dividing by the old - # file's values. R/qc-server-sidebar.R:101-105 documents the same rule - # for the same reason. Three of the old renderUI's dependencies are - # invalidated by ordinary actions (re-clicking proceed on the load - # page, editing a TimeVal cell, uploading a GROUP mapping), so this is - # not a theoretical hazard. - # - # The hr() lives INSIDE the div so the rule appears only with the - # section it introduces. (It is NOT true that the old unconditional hr - # at this position rendered alone on non-turnover templates -- it - # separated the last visible control from the Run button. Moving it - # gives up that separator on those templates, which is the accepted - # cost of not drawing two rules, or a leading one, on turnover.) - # - # The schema sits in the tooltip rather than in the panel body because - # this sidebar is width = 3 and already runs ~160 lines; every other - # fileInput in this app has the width = 8 main panel to spread into. + # register_qc_turnover. shinyjs::hidden(div( id = ns(NAMESPACE_QC$tracer_constants_panel), tags$hr(), h4("Tracer constants", class = "icon-wrapper", icon("question-circle", lib = "font-awesome"), div(paste0( - "Optional. Corrects each condition's heavy fraction for ", - "incomplete label enrichment: the heavy fraction is DIVIDED by ", - "the constant, so 1 means no correction. Leave this empty and ", - "every condition uses 1. Required columns, case-sensitive: ", + "Optional: corrects each condition's heavy fraction for ", + "incomplete label enrichment by dividing it by this constant ", + "(1 = no correction; leave empty to use 1 everywhere). ", + "Upload a CSV with columns ", paste(get_qc_required_tracer_columns(), collapse = ", "), - ". One row per condition -- the file must cover them all, and ", - "GROUP values must match your experimental conditions exactly, ", - "including case. TracerConstant must be between ", - CONSTANTS_QC$tracer_min, " and ", CONSTANTS_QC$tracer_max, - ", inclusive. Example: a header row 'GROUP,TracerConstant' ", - "followed by '0h,0.98', '6h,0.95', '24h,0.93'. Condition names ", - "must begin with a number of hours, as those do: a d or w ", - "anywhere in the name is read as days or weeks, so names the ", - "app cannot read, and names that resolve to the same ", - "timepoint, are rejected."), + " (case-sensitive), one row per condition -- GROUP must match ", + "your experimental condition names exactly, including case. ", + "TracerConstant must be between ", CONSTANTS_QC$tracer_min, + " and ", CONSTANTS_QC$tracer_max, ". Example: header ", + "'GROUP,TracerConstant', then '0h,0.98', '6h,0.95', ", + "'24h,0.93'. Condition names must start with a number of ", + "hours (d or w for days/weeks); names the app can't parse, ", + "or that duplicate a timepoint, are rejected."), class = "icon-tooltip")), fileInput(ns(NAMESPACE_QC$tracer_constants_file), "Upload tracer constants (CSV)", accept = ".csv"), - # One visible line, phrased like the sibling uploads at :253-283. - # The tooltip holds the detail, but tooltips here are hover-only - # (inst/assets/style.css: .icon-wrapper:hover .icon-tooltip), and - # this would otherwise be the only upload in the app whose schema - # needs a mouse. p(tags$strong("Required columns: "), paste(get_qc_required_tracer_columns(), collapse = ", ")), - # Required, not optional: a rejected upload blocks Run (plan section - # 0.1), so without a clear affordance a bad file is a dead end. actionButton(ns(NAMESPACE_QC$tracer_constants_clear), "Clear", class = "btn-sm"), tags$br(), tags$br(), - # Makes the absent / pending / rejected / valid states visible. The - # fileInput keeps displaying the filename of a rejected file, so - # without this the UI looks like the upload succeeded. uiOutput(ns(NAMESPACE_QC$tracer_constants_status)) )), actionButton(ns("run"), "Run summarization"), @@ -291,10 +260,6 @@ qcUI <- function(id) { tags$hr(), fileInput(ns("upload_turnover_ratios"), "Upload Turnover Ratios (CSV)", accept = ".csv"), p(tags$strong("Required columns: "), "Protein, TimeVal, H_frac, L_frac"), - # plan section 0.5: the tracer-constants panel in the side bar is - # deliberately unavailable on this flow. Said here rather - # than there, because there is exactly where a user on - # this flow cannot see it. p("Ratios uploaded here are used as given. The tracer-constants upload in the side panel does not apply on this flow: these H_frac and L_frac values are already computed, so any correction for incomplete label enrichment must be applied before upload.") )) ) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 790e8d0f..10575469 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -400,12 +400,6 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison_code = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { req(contrast$matrix) comp_mat = contrast$matrix - # Isolated by eventReactive, so this is a snapshot taken when the model - # is run -- and the QC page already snapshotted it at summarization, so - # the script can only ever cite constants that produced ratios the user - # actually saw (plan Decision I). tryCatch mirrors every other optional - # reactive read in this module: a caller that supplies something raising - # here must not take the Download-code button out on all four templates. tracer_used = tryCatch(tracer_constants(), error = function(e) NULL) generate_analysis_code(qc_input(), loadpage_input(), comp_mat, input, app_template(), tracer_used) diff --git a/R/qc-server-data-upload.R b/R/qc-server-data-upload.R index 1241234d..b15e6e50 100644 --- a/R/qc-server-data-upload.R +++ b/R/qc-server-data-upload.R @@ -84,12 +84,6 @@ get_qc_required_ratios_columns <- function() { #' CSV uses GROUP (identical values, user-facing name). Renames GROUP to #' Condition and keeps the template-specific value columns, all coerced to #' character to match the load-page format. -#' -#' Condition is trimmed because qc_mapping_group_errors() validates the TRIMMED -#' GROUP values against ProteinLevelData. Storing the raw value instead would -#' let a quoted "DMSO " cell (fread's strip.white does not touch quoted fields) -#' pass validation and then fail the ProteinLevelData join downstream, silently -#' dropping that condition's rows. What is stored must be what was checked. #' @noRd qc_mapping_to_condition_metadata <- function(parsed, template) { df = data.frame(Condition = trimws(as.character(parsed$GROUP)), stringsAsFactors = FALSE) @@ -125,20 +119,11 @@ qc_dose_units_valid <- function(units) { #' reference groups missing from the upload, and duplicated rows. Missing or #' duplicated groups otherwise corrupt the GROUP join. #' -#' `subject` and `reference` name the two sides in the message. They are -#' parameters because more than one upload in this app is validated this way: -#' hardcoding "GROUP mapping" / "ProteinLevelData" would send a user who -#' mis-typed a condition in the tracer-constants file off to edit an unrelated -#' file. Defaults reproduce the GROUP-mapping wording verbatim. +#' `subject` and `reference` name the two sides in the message. #' @noRd qc_mapping_group_errors <- function(mapping_groups, protein_groups, subject = "GROUP mapping", reference = "ProteinLevelData") { - # Trimmed on both sides: condition names get no normalization when they are - # read off the annotation, while fread applies strip.white = TRUE. So an - # Excel-sourced "0h " could never be matched by any CSV cell, and the - # load-page metadata table disables editing on the Condition column -- there - # is no in-app fix for the user. Case is deliberately left strict. mapping_groups = trimws(as.character(mapping_groups)) protein_groups = trimws(as.character(protein_groups)) errors = character(0) @@ -197,24 +182,13 @@ get_qc_required_tracer_columns <- function() { #' Whether every tracer constant lies within CONSTANTS_QC$tracer_min/max. #' -#' Takes df + col to match qc_values_numeric_finite's convention, and coerces -#' before comparing for the same reason it does: an uncoerced character column -#' compares lexicographically, so all(c("0.5", "0.5abc") > 0) is TRUE and the -#' bad value only turns into NA later, inside the analysis. Coercing first also -#' keeps NA out of the `all()`, which would otherwise return NA and throw -#' "missing value where TRUE/FALSE needed" from the calling `if`. -#' -#' Returns FALSE for an absent or empty column: all(logical(0)) is TRUE, so an -#' empty file would otherwise validate. +#' Returns FALSE for an absent, empty, or out-of-range column. #' @noRd qc_tracer_values_in_range <- function(df, col = "TracerConstant") { if (is.null(df) || length(col) != 1 || is.na(col)) return(FALSE) if (!(col %in% colnames(df))) return(FALSE) raw = df[[col]] if (length(raw) == 0) return(FALSE) - # as.numeric on a factor reads the level codes, not the labels, so - # factor("2.0") would validate as 2. fread does not produce factors, but this - # helper is the single source of truth and takes an arbitrary data frame. if (is.factor(raw)) raw = as.character(raw) coerced = suppressWarnings(as.numeric(raw)) all(is.finite(coerced) & @@ -224,10 +198,7 @@ qc_tracer_values_in_range <- function(df, col = "TracerConstant") { #' The neutral all-ones tracer-constant vector, named by condition. #' -#' 1 is the identity for the divisor, so this reproduces uncorrected behaviour -#' exactly. Errors on zero conditions rather than returning a named numeric(0): -#' that is not NULL, so it would slip past calculateTurnoverRatios' own is.null -#' guard and make every H_frac NA. +#' Errors when there are no conditions. #' @noRd #' @importFrom stats setNames qc_default_tracer_constants <- function(conditions) { @@ -241,15 +212,8 @@ qc_default_tracer_constants <- function(conditions) { #' Resolve the tracer-constant vector actually passed to the turnover fit. #' #' The single source of truth for both the analysis and the downloadable -#' script, so the two cannot disagree. `uploaded` is NULL when no file was -#' supplied, in which case every condition gets 1. -#' -#' The reindex is guarded rather than trusted: uploaded[conditions] returns NA -#' under an NA *name* for a condition the file does not cover -- no error -- and -#' H_frac / NA is NA, i.e. an entirely missing result set with no warning. -#' Names are re-applied from `conditions` because calculateTurnoverRatios re-keys -#' the vector with parse_timepoint(names(x)), so it must carry the raw condition -#' strings, not whatever the file happened to be sorted by. +#' script. `uploaded` is NULL when no file was supplied, in which case every +#' condition gets 1. #' @noRd #' @importFrom stats setNames qc_resolve_tracer_constants <- function(conditions, uploaded = NULL) { @@ -257,9 +221,7 @@ qc_resolve_tracer_constants <- function(conditions, uploaded = NULL) { if (is.null(uploaded) || length(uploaded) == 0) return(resolved) conditions = names(resolved) - # Matched on trimmed keys for the reason given in qc_mapping_group_errors, - # but the RESULT keeps the raw condition strings as names: they are what - # calculateTurnoverRatios re-keys through parse_timepoint. + # Matched on trimmed keys, but the result keeps the raw condition strings as names. keys = trimws(conditions) upload_keys = trimws(as.character(names(uploaded))) @@ -285,17 +247,9 @@ qc_resolve_tracer_constants <- function(conditions, uploaded = NULL) { setNames(values, conditions) } -#' Hours a condition name resolves to, mirroring MSstatsResponse's parser. -#' -#' Deliberately duplicated rather than called through `:::`: parse_timepoint is -#' internal to MSstatsResponse and R CMD check flags ::: calls. It must stay in -#' step with it, because calculateTurnoverRatios re-keys the tracer vector with -#' names(x) <- parse_timepoint(names(x)) -- this is the function that decides -#' which constant a condition actually receives. -#' -#' Note the parser's two quirks, both reproduced here on purpose: the number is -#' anchored at the start of the string, and the day/week detectors are bare "d" -#' and "w" matched anywhere, so "6h_drug" resolves to 144 hours. +#' Hours a condition name resolves to, mirroring MSstatsResponse's internal +#' (not exported) parse_timepoint(). The number is anchored at the start of +#' the string, and the day/week detectors are bare "d"/"w" matched anywhere. #' @noRd #' @importFrom stringr str_extract str_detect qc_tracer_timepoint_hours <- function(conditions) { @@ -303,8 +257,6 @@ qc_tracer_timepoint_hours <- function(conditions) { numeric_part = suppressWarnings(as.numeric(str_extract(conditions, "^[0-9]+"))) is_days = str_detect(conditions, "d|day") is_weeks = str_detect(conditions, "w|week") - # str_detect returns NA for an NA condition, which would make the subscripted - # assignments below error rather than fall through to the unparseable branch. is_days[is.na(is_days)] = FALSE is_weeks[is.na(is_weeks)] = FALSE @@ -314,13 +266,8 @@ qc_tracer_timepoint_hours <- function(conditions) { hours } -#' Condition names whose "d"/"w" is read as a unit but is not one. -#' -#' The parser's day and week detectors are the bare patterns "d|day" and -#' "w|week", matched ANYWHERE in the string, so "6h_drug" silently resolves to -#' 144 hours rather than 6 -- the "d" of "drug". Flagged only when the letter -#' fires the multiplier without the name actually ending in a day/week unit, so -#' ordinary suffixes that carry no "d" or "w" ("24h_rep1") are left alone. +#' Condition names whose "d"/"w" is read as a unit but is not one (e.g. +#' "6h_drug" resolves to 144 hours via the "d" in "drug"). #' @noRd #' @importFrom stringr str_detect qc_tracer_misleading_units <- function(conditions) { @@ -331,18 +278,9 @@ qc_tracer_misleading_units <- function(conditions) { fires & !genuine } -#' Errors for condition names the turnover fit cannot key tracer constants by. -#' -#' Three failure modes, all silent data corruption today: -#' - a name that resolves to NA drops every row of that condition, leaving an -#' empty result set; -#' - a stray "d" or "w" multiplies the timepoint (see -#' qc_tracer_misleading_units); -#' - two names that resolve to the SAME number collide, and the second -#' silently takes the first's constant (e.g. "24h" and "1d" both give 24). -#' -#' The remedy has to be the annotation file: the load-page metadata table -#' disables editing on the Condition column, so there is no in-app fix. +#' Errors for condition names the turnover fit cannot key tracer constants by: +#' names that don't parse to a timepoint, names with a misleading "d"/"w", and +#' names that collide on the same resolved timepoint. #' @noRd qc_tracer_timepoint_errors <- function(conditions) { conditions = unique(as.character(conditions)) @@ -638,22 +576,9 @@ register_qc_data_upload <- function(input, output, session, loadpage_input, }, ignoreNULL = FALSE) # ---- Disable the summarization Run button while uploads are in play ---- - # One observer for all of them on purpose. A second toggleState("run", ...) - # elsewhere would not AND with this one: each observer sends its own message - # whenever its own dependencies invalidate, so the later write wins and the - # button flips back on. Hence tracer_upload is passed in from - # register_qc_turnover rather than gating Run from there. - # - # "pending" blocks Run for the same reason "rejected" does: the tracer file - # picker sits ~20px above the Run button, so a click during the upload would - # otherwise summarize with all-1s and no warning (plan Decision I). observe({ tracer = if (is.null(tracer_upload)) NULL else tracer_upload() - # Template-gated as well as state-gated. register_qc_turnover already - # clears the state on a template switch; this term means a stale state - # could not disable Run on a template whose sidebar has no tracer panel -- - # and so no Clear button -- to re-enable it from. tracer_blocks_run = identical(get_template(), TEMPLATES$protein_turnover) && !is.null(tracer) && tracer$state %in% c("pending", "rejected") shinyjs::toggleState("run", is.null(uploaded_feature_level()) && diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index d31c2644..dc123b7b 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -7,47 +7,23 @@ #' @return a list with three elements: `ratios` (the display reactive, which #' carries a req()), `tracer_upload` (the upload state reactiveVal, read by #' register_qc_data_upload to gate the Run button), and `tracer_constants` -#' (the provenance record snapshotted at Run, which must never raise -- the -#' Download-code path reads it on all four templates). +#' (the provenance record snapshotted at Run). #' @noRd register_qc_turnover <- function(input, output, session, app_template, get_data, get_condition_metadata, preprocess_data) { # ---- Tracer-constants CSV upload (optional; protein turnover only) ---- # - # Three states, deliberately not collapsed into a nullable vector (plan - # Decision H / plan section 0.1). "absent" means the user declined the - # correction and every condition gets 1; "rejected" means they supplied an - # intent the app cannot honour, which must block Run rather than silently - # fall back to all-1s -- that silent fallback is the bug this whole feature - # exists to remove. - # "pending" covers the browser-to-server upload window: the Run button sits - # ~20px below the file picker, and clicking it mid-upload would otherwise - # summarize with all-1s and no warning (Decision I). - # - # State and values live in ONE reactiveVal so they cannot disagree, and the - # committed values are whatever qc_resolve_tracer_constants() returns -- the - # same function the fit and the generated script call -- so the stored vector - # is by construction the vector the analysis will use. + # Three states: "absent" (no file; every condition gets 1), "rejected" + # (an uploaded file the app cannot honour; blocks Run rather than silently + # falling back to all-1s), and "pending" (upload in flight; also blocks Run). tracer_upload <- reactiveVal(list(state = "absent", values = NULL, file = NULL)) # The constants that actually produced the displayed ratios, snapshotted at - # the moment of Run (Decision I). NOT a live view of tracer_upload(): a live - # one diverges the instant the user uploads a file after running, so the - # ratios table would show one set of numbers while the downloadable script - # emitted another -- which is the silent-divergence bug this feature exists - # to remove, reintroduced by its own fix. - # - # A reactiveVal rather than a second eventReactive, deliberately. Reading an - # eventReactive that has not yet fired raises shiny.silent.error, and this - # value is read from the Download-code path on ALL FOUR templates - # (plan Decision E) -- a silent error escaping there kills the button - # everywhere. Reading a reactiveVal cannot fail. - # - # NULL is therefore load-bearing: it is the third provenance state from - # plan section 0.6, "the QC page was never run", which is genuinely - # different from "the user ran it and declined the correction" (source = - # "none"). The generated script distinguishes all three. + # the moment of Run. NOT a live view of tracer_upload(): that would let the + # ratios table and the downloadable script disagree about which constants + # were used. NULL means the QC page has not been run in this session, which + # is distinct from "run, and no file was supplied" (source = "none"). tracer_constants_used <- reactiveVal(NULL) get_template <- function() if (is.null(app_template)) NULL else app_template() @@ -59,20 +35,15 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, as.character(meta$Condition) } - # Fires on the client the moment a file is chosen, i.e. before the upload - # completes and before observeEvent(input$...) can run. shinyjs::reset() sets - # the value with jQuery .val(''), which does not dispatch "change", so - # clearing the upload cannot re-arm this and strand Run disabled. + # shinyjs::reset() sets the value client-side only and does not dispatch + # "change", so clearing the upload cannot re-arm this handler. shinyjs::onevent("change", NAMESPACE_QC$tracer_constants_file, { tracer_upload(list(state = "pending", values = NULL, file = NULL)) }) - # shinyjs::reset clears the file input on the CLIENT only -- it empties the - # widget and posts back an empty message, so input$tracer_constants_file - # keeps its old name/datapath for the rest of the session. tracer_upload() is - # therefore the only trustworthy source of the resolved values; anything - # downstream (Step 4's resolve-at-run in particular) must read it and never - # the file input, or a cleared upload comes back to life. + # input[[tracer_constants_file]] keeps its old name/datapath after a + # shinyjs::reset (client-side only), so tracer_upload() is the only + # trustworthy source of the resolved values. observeEvent(input[[NAMESPACE_QC$tracer_constants_clear]], { shinyjs::reset(NAMESPACE_QC$tracer_constants_file) tracer_upload(list(state = "absent", values = NULL, file = NULL)) @@ -81,21 +52,11 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, type = "message", duration = 6) }, ignoreInit = TRUE) - # A blocking tracer state must not outlive the template it belongs to. The - # template is a plain selectInput on the Home tab and can be changed at any - # point in a live session; the tracer panel -- and with it the Clear button, - # the only affordance that resets the state -- is gated on protein turnover. - # So a rejected upload followed by a template switch would leave Run disabled - # with nothing on screen to re-enable it, escapable only by restarting. + # A blocking tracer state must not outlive the template it belongs to: the + # tracer panel (and its Clear button) is only shown on protein turnover. observeEvent(get_template(), { if (identical(get_template(), TEMPLATES$protein_turnover)) return() - # Unconditional, unlike the upload reset below: pressing Run on another - # template makes turnover_ratios' own req() fail, and shiny CACHES that - # shiny.silent.error, so the ratios table stays empty for the rest of the - # session until a fresh turnover Run. A snapshot surviving that would have - # the generated script cite tracer constants for a table showing nothing - # -- the script/display divergence Decision I exists to prevent. tracer_constants_used(NULL) if (!identical(tracer_upload()$state, "absent")) { @@ -108,13 +69,8 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, file <- input[[NAMESPACE_QC$tracer_constants_file]] req(file) - # Every early return below leaves "rejected", never the previous file's - # values: replacing a good file with a bad one must not keep running the - # good one's constants under the bad one's filename (QA 4.1). reject <- function(...) { tracer_upload(list(state = "rejected", values = NULL, file = file$name)) - # Named, because replacing a good file with a bad one otherwise produces - # a red toast that does not say which of the two failed (QA 4.1). showNotification(paste0(file$name, " was not accepted. ", ...), type = "error", duration = 10) } @@ -127,20 +83,14 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # fread's failures here are split across three channels, and only one of - # them is an error. It ERRORS on a file it cannot parse at all; it WARNS - # (returning a 0x0 table) on a 0-byte file; and on a row with the wrong - # field count it warns without erroring, either stopping early or - # discarding the row as a "footer". So warnings are captured rather than - # discarded -- but they are not the primary defence against a dropped row; - # the line count below is. See that check for why. + # fread warns (rather than errors) on some malformed rows/files, so + # warnings are captured for reporting but are not relied on for detection. fread_warnings <- character(0) parsed <- withCallingHandlers( tryCatch( data.table::fread(file$datapath, - # plan section 0.4: an all-numeric GROUP column is otherwise typed - # integer, so a condition genuinely named "0010" reads - # back as "10" and can never be matched. + # An all-numeric GROUP column is otherwise typed + # integer, so "0010" would read back as "10". colClasses = list(character = "GROUP")), error = function(e) { reject("Could not read the tracer constants file: ", conditionMessage(e)) @@ -154,9 +104,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, ) if (is.null(parsed)) return() - # A 0-byte file warns rather than erroring, and a header-only file parses - # cleanly to 0 rows -- where all(logical(0)) is TRUE, so every downstream - # check would pass on it. if (ncol(parsed) == 0 || nrow(parsed) == 0) { reject("The tracer constants file has no data rows. It needs a header ", "row of ", paste(get_qc_required_tracer_columns(), collapse = ", "), @@ -164,9 +111,8 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # fread keeps duplicate column names and `$` silently returns the FIRST, so - # a spreadsheet carrying an old and a corrected TracerConstant column would - # quietly use the stale one. + # fread keeps duplicate column names and `$` returns the first, so a + # duplicated TracerConstant column would silently use the stale one. duplicated_columns <- unique(colnames(parsed)[duplicated(colnames(parsed))]) if (length(duplicated_columns) > 0) { reject("The tracer constants file has more than one column named: ", @@ -185,20 +131,10 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # A row fread could not parse is DROPPED, not reported as an error. Where - # the row sits decides which: mid-file it stops early, and last it is - # discarded as a "single-line footer". Most such files are still caught - # downstream, because dropping a row usually leaves a condition uncovered - # and the group check demands complete coverage. The exception is a dropped - # row for a condition another row already covers -- a second "0hr" line - # typed as "0hr,0,42" instead of "0hr,0.42". That file passes every check - # below while the value the user actually entered is silently gone, and it - # would have been rejected as a duplicate had it parsed. - # - # Counted from the source rather than matched against fread's warning text: - # the wording is not part of data.table's API, and fread also emits - # unrelated warnings ("Previous fread() session was not cleaned up - # properly") that must not reject a good file. + # A row fread cannot parse is silently dropped rather than erroring. Most + # such cases are still caught below by the group-coverage check; comparing + # counted source rows against parsed rows catches the rest (e.g. a + # duplicate row for a condition another row already covers). source_rows <- tryCatch( sum(nzchar(trimws(readLines(file$datapath, warn = FALSE)))) - 1L, error = function(e) NA_integer_ @@ -211,9 +147,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # Anything else fread had to say. Reported only once the column check has - # passed: before that, a malformed file is better explained by the - # missing-column message than by fread's internals. if (length(fread_warnings) > 0) { showNotification( paste0(file$name, " parsed with warnings: ", @@ -232,10 +165,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # plan section 0.7: the labels matter. The default wording names "GROUP mapping" and - # "ProteinLevelData", and the GROUP mapping is a DIFFERENT upload on this - # same page -- a user who mis-typed a condition here would go and edit an - # unrelated file. group_errors <- qc_mapping_group_errors( parsed$GROUP, conditions, subject = "The tracer constants file", @@ -247,11 +176,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # plan section 0.3: calculateTurnoverRatios re-keys the vector through parse_timepoint, - # so names that do not survive it drop rows or collide -- silently, and in - # the collision case while the metadata table displays the non-colliding - # number. Checked at upload rather than at Run so the message arrives while - # the user is still looking at the file. timepoint_errors <- qc_tracer_timepoint_errors(conditions) if (length(timepoint_errors) > 0) { reject(paste(timepoint_errors, collapse = " ")) @@ -274,22 +198,10 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, type = "message", duration = 6) }) - # Decision K: condition_metadata is a shared reactiveVal that ordinary - # actions rewrite AFTER a tracer upload -- re-clicking the load page's - # proceed button and uploading a GROUP mapping both replace it wholesale. - # Nothing else invalidates the upload, so without this the resolved vector - # would either go stale or blow up later as a raw "Internal error" blaming - # the software for the user's click order. - # - # Only a genuine change to the condition SET clears it: proceed1 rewrites the - # table on every click, and dropping a valid upload each time would be its - # own bug (QA 4.5). Cleared to "rejected", not "absent", so the app still - # refuses to fall back to all-1s behind the user's back (plan section 0.1). - # Registered conditionally: get_condition_metadata is documented as - # "reactive (or NULL)" and qcServer defaults it to NULL, so an unguarded - # get_condition_metadata() would be NULL() -- an error thrown on the first - # reactive flush of the session, on every template. Every sibling read in - # this module guards the same way. + # condition_metadata is a shared reactiveVal that ordinary actions (e.g. + # re-clicking proceed, uploading a GROUP mapping) can rewrite after a + # tracer upload; a valid upload whose conditions no longer match must be + # invalidated rather than silently reused or left to error later. if (!is.null(get_condition_metadata)) { observeEvent(get_condition_metadata(), { current <- tracer_upload() @@ -308,29 +220,8 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } # ---- Tracer panel visibility ---- - # - # shinyjs::toggle on the statically mounted div, mirroring the - # template-gated upload panels at R/qc-server-data-upload.R:659-671. - # observe() rather than observeEvent(get_template()) because the gate has two - # dependencies, and toggle() must re-run when either moves. - # - # get_data() is the second half of the gate, so the panel stays off the - # "upload pre-summarized abundances" flow. That is INTENTIONAL, not an - # oversight, and is inherited from the req(get_data()) in the renderUI this - # replaces (plan section 0.5): on that flow the turnover ratios were computed - # -- and any enrichment correction applied -- outside the app, so there is - # nothing left here for a tracer constant to divide. The Upload Summarized - # Abundances tab states this where a user on that flow can actually read it; - # help text inside a hidden panel would not be visible to them. - # The state term is not redundant with the data term. get_data is an - # eventReactive on the load page's proceed button that returns NULL when a - # load FAILS (R/loadpage-server-data-loaders.R:67-78), so: upload a bad - # tracer file (Run now disabled), go back, re-click proceed, load fails -> - # data goes NULL, this panel would hide, and the Clear button that is the - # only way out of "rejected" would vanish while Run stayed disabled. The - # template never changed, so the clearing observer above does not fire - # either. That is exactly the dead end plan section 0.1 requires not to - # exist, so the panel stays mounted for as long as its state can block Run. + # Shown only on protein turnover, and only once data is loaded (or a tracer + # state is already in play, so a bad-upload dead end can still be cleared). observe({ loaded <- tryCatch(get_data(), error = function(e) NULL) shinyjs::toggle( @@ -360,14 +251,7 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios <- eventReactive(input$run, { - # Cleared before the guards below, not after them, so that every path which - # fails to reach the commit further down leaves no snapshot at all. The - # snapshot describes the constants that produced the ratios now on screen; - # a run that produces no ratios must therefore leave nothing behind, or the - # generated script would cite constants for a table the user cannot see. - # Placing this after the req()s left a stale snapshot alive whenever a - # second Run bailed out early -- e.g. summarization returning NULL, which - # empties the table while the previous run's constants stayed on record. + # Cleared up front so any early exit below leaves no stale snapshot. tracer_constants_used(NULL) req(!is.null(app_template) && !is.null(app_template()) && @@ -377,20 +261,10 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) conditions <- as.character(get_condition_metadata()$Condition) - # eventReactive isolates its body, so this read takes a snapshot of the - # upload as it stands at Run and creates no dependency on it -- exactly - # what Decision I requires. Read from tracer_upload() and never from - # input[[tracer_constants_file]]: shinyjs::reset clears the widget on the - # client only, so a cleared upload still has its old name and datapath in - # the input, and reading it would resurrect constants the user deleted. + # Snapshot the upload as it stands at Run; read from tracer_upload() and + # never from input[[tracer_constants_file]] (see the reset note above). upload <- tracer_upload() - # plan section 0.1 forbids falling back to all-1s behind the user's back, - # and the toggleState that enforces it is CLIENT-side. shinyjs::onevent - # needs a server round trip before Run is disabled, so a click inside that - # window arrives here with the state still "pending" -- the exact race - # Decision I names. Refusing here makes the guarantee server-side; the - # notification is what tells the user why the click did nothing. if (upload$state %in% c("pending", "rejected")) { showNotification( paste0("Turnover ratios were not calculated: the tracer constants ", @@ -402,13 +276,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } uploaded <- if (identical(upload$state, "valid")) upload$values else NULL - # The same helper the generated script resolves through, so the analysis - # and the script cannot disagree. It THROWS rather than defaulting to 1s - # when it cannot honour the user's intent; that is the point (Decision G), - # but an uncaught stop() inside this eventReactive surfaces as a bare red - # error and output$turnover_ratios_panel would tryCatch it into a silent - # "no ratios". So: name the reason in a toast, then req() out, leaving the - # snapshot cleared above rather than recording constants never applied. tracer_consts <- tryCatch( qc_resolve_tracer_constants(conditions, uploaded), error = function(e) { @@ -462,13 +329,8 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, ) } - # Committed only once the fit has RETURNED. A reactiveVal write is not - # rolled back when the body aborts, so committing before the fit left a - # snapshot on record whenever the fit threw -- and the fit does throw on - # plausible data, e.g. ProteinLevelData carrying no "H" rows. The script - # would then cite constants, and name the uploaded file, for a table that - # never drew. This is the same rule as the clear at the top of the body: - # a run that produces no ratios leaves nothing behind. + # Committed only once the fit has returned, so a run that fails leaves no + # snapshot behind (matches the clear at the top of this reactive). tracer_constants_used(list( values = tracer_consts, source = if (is.null(uploaded)) CONSTANTS_QC$tracer_source_none @@ -489,19 +351,9 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, ratios <- turnover_ratios() req(ratios) - # The snapshot is the single authority for "are there ratios on screen". - # turnover_ratios is an eventReactive, so nothing but a fresh Run can - # invalidate its cache -- in particular the template observer above cannot. - # Without this guard, switching the template away and back redrew this - # table from that surviving cache while the snapshot taken with it had been - # cleared, so the ratios on screen carried the uploaded correction while the - # generated script emitted all-1s stamped "the page was not run in this - # session". Gating the display on the snapshot keeps the pair inseparable: - # no snapshot, no table, and the user is asked to run again. - # - # Checked AFTER turnover_ratios() rather than before it: reading that - # eventReactive is what WRITES the snapshot, so an earlier req() would test - # the previous value and blank the table for a cycle on the first Run. + # The snapshot is the authority for "are there ratios on screen"; without + # this guard, switching templates away and back could redraw the table + # from a cached ratios value after its snapshot had been cleared. req(tracer_constants_used()) if (isTRUE(input[[NAMESPACE_QC$assign_feature_weights]]) && nrow(ratios) > 0) { calculatePeptideWeights(ratios) @@ -510,14 +362,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } }) - # The table and the download button are rendered together, from one read of - # the ratios, rather than the button being toggled with enable() from a - # sibling output. This panel lives in a tabPanel, so its outputs are - # suspended while another tab is active and both re-render on activation; a - # one-off enable() message raced with that re-render and left the button - # greyed out next to a populated table. `tryCatch` maps the pending - # eventReactive (before the first "Run summarization") and any error in the - # calculation to "no ratios", so neither blocks the panel from drawing. output$turnover_ratios_panel <- renderUI({ req(!is.null(app_template) && !is.null(app_template()) && app_template() == TEMPLATES$protein_turnover) @@ -553,14 +397,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, } ) - # A list, not the bare ratios reactive: register_qc_data_upload needs the - # upload state to extend its existing toggleState("run", ...) observer, and a - # SECOND toggleState observer on the same button would fight the first - # (last writer wins on each flush). - # tracer_constants is exposed separately from ratios rather than bundled into - # it: ratios (turnover_ratios_display) carries a req(), and Decision E is - # explicit that the reactive reaching the Download-code path must not, or the - # silent error takes the button out on every template. list( ratios = turnover_ratios_display, tracer_upload = tracer_upload, diff --git a/R/server.R b/R/server.R index 23a50844..0c4f2fba 100644 --- a/R/server.R +++ b/R/server.R @@ -64,10 +64,6 @@ server = function(input, output, session) { app_template = app_template, turnover_ratios = get_turnover_ratios, condition_metadata = get_condition_metadata, - # Passed BARE, like turnover_ratios above and unlike the reactive()-wrapped - # qc_input: this is already a reactive, and reactive(reactive(x)) reaches the - # consumer as a closure that is not NULL and cannot be coerced -- so the - # NULL default would never catch it (plan Decision E). tracer_constants = get_tracer_constants ) statmodel_input = statmodel_values$input diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index e079f0af..30f9438c 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -2,12 +2,8 @@ #' #' @param tracer_constants The tracer-constant provenance record snapshotted by #' the QC page at Run: a list of `values` (named numeric, keyed by raw -#' condition string), `source` ("upload" / "none") and `file`. `NULL` means the -#' QC page was never run in this session -- a reachable state, not a defect -#' (plan section 0.6), because the Download-code button only requires a -#' contrast matrix. Trailing with a NULL default so the existing positional -#' call sites -- production plus nine in the tests -- stay valid (plan -#' Decision E). +#' condition string), `source` ("upload" / "none") and `file`. `NULL` means +#' the QC page was never run in this session. #' @noRd generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app_template = TEMPLATES$default, @@ -27,10 +23,8 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, codes = paste(codes, "library(MSstatsResponse)\n", sep = "") if (isTRUE(app_template == TEMPLATES$protein_turnover)) { - # Resolved HERE rather than at the top of the function, deliberately: on - # every other template comp_mat is a bare matrix, where `$GROUP` throws - # "$ operator is invalid for atomic vectors" and would take the - # Download-code button out on all four templates. + # Resolved here, not at the top of the function: on every other + # template comp_mat is a bare matrix, and `$GROUP` throws on it. if (is.null(tracer_constants)) { tracer_constants = list( values = qc_default_tracer_constants(as.character(comp_mat$GROUP)), @@ -181,20 +175,10 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, } -#' The provenance comment stamped above the tracer_constants vector. -#' -#' Three states, not two (plan section 0.6). The one v1 of this feature would -#' have written -- "# No tracer constants file uploaded" -- was asserted on a -#' path where a REJECTED file had silently fallen back to all-1s, so the comment -#' actively vouched for the wrong thing. Exactly one of the three lines is -#' emitted, so the script says what happened rather than what was intended. -#' -#' The three wordings are deliberately chosen so that no one of them contains a -#' distinguishing phrase of another. "uploaded on the data-processing page" was -#' previously a substring of the no-upload sentence ("... was uploaded on the -#' data-processing page"), which made any grep for the upload state -- in a test, -#' a script, or by a user reading the file -- match the case where nothing was -#' uploaded at all. See the mutual-exclusivity test in test-module-turnover.R. +#' The provenance comment stamped above the tracer_constants vector. Exactly +#' one of three mutually-exclusive lines is emitted, matching whether the +#' constants came from an upload, were explicitly declined, or the +#' data-processing page was never run. #' @noRd build_tracer_provenance_comment <- function(tracer_constants) { source <- tracer_constants$source @@ -202,11 +186,6 @@ build_tracer_provenance_comment <- function(tracer_constants) { if (identical(source, CONSTANTS_QC$tracer_source_upload)) { file <- tracer_constants$file - # encodeString, not paste0: a file name containing a newline would otherwise - # split the comment and leave the remainder as (invalid) code. - # length() rather than is.null() alone: `||` errors on a zero-length operand - # in current R, so a character(0) file name would take the whole script - # generator down instead of degrading to the generic label. label <- if (length(file) != 1L || is.na(file) || !nzchar(file)) "an uploaded file" else encodeString(as.character(file), quote = "\"") return(paste0( @@ -222,23 +201,11 @@ build_tracer_provenance_comment <- function(tracer_constants) { "# so every condition uses 1 (no tracer correction).\n") } -#' Serialize a double as R source that reads back as the identical double. -#' -#' `paste0(1/3)` emits 15 significant digits, so the constant in the downloaded -#' script is NOT the constant the app divided by -- a reproducible script that -#' silently reproduces something else. The shortest round-tripping form is -#' preferred so ordinary values stay readable ("0.9", not "0.90000000000000002"). -#' -#' The 17-digit fallback is best-effort: R's own string-to-double conversion is -#' not always correctly rounded (verified on R 4.5.2, `as.numeric(sprintf("%.17g", -#' 0.123456789012345678))` is 1 ULP off), so a hand-crafted double need not -#' round-trip through any decimal form. Irrelevant in practice here, because -#' tracer constants arrive as short decimal text in a CSV. +#' Serialize a double as R source that reads back as the identical double, +#' preferring the shortest round-tripping form so ordinary values stay +#' readable ("0.9", not "0.90000000000000002"). #' @noRd format_r_double <- function(value) { - # suppressWarnings because as.numeric("NA") warns. Callers are expected to have - # rejected non-finite values already, but a warning escaping a downloadHandler - # is a confusing way to learn that they did not. for (digits in 15:17) { text <- sprintf(paste0("%.", digits, "g"), value) if (identical(suppressWarnings(as.numeric(text)), value)) return(text) @@ -259,11 +226,9 @@ format_r_double <- function(value) { #' @param comp_mat The turnover contrast matrix (GROUP + TimeVal columns); its #' GROUP column supplies the condition names the tracer constants are keyed by. #' @param increasing Logical passed through to the fit / visualization. -#' @param tracer_constants Required, not defaulted (plan Decision G.2): a list of -#' `values` (named numeric keyed by raw condition string), `source` (one of the -#' CONSTANTS_QC$tracer_source_* provenance states) and `file`. Defaulting it -#' would reinstate the original bug -- emitting all-1s that look deliberate -- -#' so the caller is forced to say which constants were actually used. +#' @param tracer_constants Required, not defaulted: a list of `values` (named +#' numeric keyed by raw condition string), `source` (one of the +#' CONSTANTS_QC$tracer_source_* provenance states) and `file`. #' @return A character scalar of R code, appended after `library(MSstatsResponse)`. #' @noRd build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, @@ -271,13 +236,9 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, conditions <- as.character(comp_mat$GROUP) weighting <- isTRUE(qc_input[[NAMESPACE_QC$assign_feature_weights]]) - # The vector is no longer rebuilt from comp_mat$GROUP, so nothing structurally - # guarantees it covers the conditions being fitted any more. It can genuinely - # drift: the snapshot is taken at QC Run, while comp_mat is rebuilt from - # condition_metadata afterwards and its GROUP cells are editable in the - # contrast table. An uncovered condition would emit c(...)[["2h"]] -> NA, - # H_frac / NA -> NA, i.e. a script that runs to completion and fits nothing. - # Failing here is loud but honest; emitting a quietly wrong script is not. + # tracer_constants is snapshotted at QC Run, so it can drift from comp_mat + # (rebuilt afterwards from editable condition metadata); an uncovered + # condition must fail loudly rather than emit a silently wrong script. values <- tracer_constants$values if (is.null(values) || length(values) == 0 || is.null(names(values))) { stop("Cannot generate reproducible code: no tracer constants are recorded ", @@ -288,31 +249,17 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, stop("Cannot generate reproducible code: the contrast matrix lists no ", "experimental conditions.") } - # A condition name that is blank cannot be written as an R argument name: - # `c("" = 1)` is a PARSE error ("attempt to use zero-length variable name"), - # so emitting it produces a script that does not even load. Verified reachable - # without an upload -- a blank Condition cell in the annotation reaches the - # all-1s default path, which runs none of the upload observer's name checks. - # The message names the annotation file because the metadata table disables - # editing on the Condition column (plan section 0.3). + # A blank condition name cannot be written as an R argument name + # (`c("" = 1)` is a parse error), so it must be rejected before emitting code. blank_conditions <- is.na(conditions) | !nzchar(trimws(conditions)) if (any(blank_conditions)) { stop("Cannot generate reproducible code: ", sum(blank_conditions), " experimental condition(s) have a blank name. Give every condition a ", "name in the annotation file and load the data again.") } - # Keys are trimmed on both sides for the same reason - # qc_resolve_tracer_constants trims (plan section 0.4): a condition carried in - # from Excel as "0h " is not editable in the metadata table, so a strict match - # would be a dead end the user cannot clear. - # - # Trimming can however collapse two distinct keys onto one ("0h" and "0h "), - # and match() would then hand BOTH conditions the first one's value -- a wrong - # constant, silently. Only a repeated key carrying DIFFERING values is - # actually ambiguous: repeated with the same value it cannot mispair, and - # rejecting that would newly break the benign duplicate the all-1s default - # can produce. qc_resolve_tracer_constants rejects a colliding file before it - # can be snapshotted, so this is defence in depth rather than a live path. + # Keys are trimmed on both sides, matching qc_resolve_tracer_constants. + # Trimming can collapse two distinct keys onto one, so only flag a repeated + # key whose values actually differ as ambiguous. upload_keys <- trimws(as.character(names(values))) repeated <- unique(upload_keys[duplicated(upload_keys)]) ambiguous <- repeated[vapply(repeated, function(key) { @@ -331,9 +278,7 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, ". Re-run protein summarization on the data-processing page so the ", "constants match the current conditions.") } - # is.finite, not anyNA: Inf passes an NA check and emits a literal `Inf` into - # the script, where H_frac / Inf is 0 and every L_frac becomes 1 -- a script - # that runs to completion and reports total turnover everywhere. Verified. + # is.finite, not anyNA: Inf would pass an NA check and emit a literal `Inf`. tracer_vals <- suppressWarnings(as.numeric(values[matched])) if (!all(is.finite(tracer_vals))) { bad <- !is.finite(tracer_vals) @@ -342,12 +287,9 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, " is not a finite number.") } - # Keyed by the RAW condition name, matching the app: calculateTurnoverRatios - # re-keys the vector with parse_timepoint(names(x)), so make.names()-style - # sanitization here would change which constant a condition receives. - # encodeString(quote = "\"") rather than paste0-ing quotes (plan Decision J): - # a condition containing a quote or a backslash otherwise produces a script - # that does not parse, and dropping make.names() is what newly exposes that. + # Keyed by the raw condition name, matching the app (calculateTurnoverRatios + # re-keys via parse_timepoint(names(x))). encodeString() rather than + # paste0-ing quotes, so a quote or backslash in the name still parses. tracer_pairs <- paste0(" ", encodeString(conditions, quote = "\""), " = ", vapply(tracer_vals, format_r_double, character(1)), collapse = ",\n") From 326dc449b626ea853efc32382bdbda57b0b9cbaa Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 09:18:10 -0400 Subject: [PATCH 03/10] remove unnecessary readme --- tests/testthat/data/tracer/README.md | 88 ---------------------------- 1 file changed, 88 deletions(-) delete mode 100644 tests/testthat/data/tracer/README.md diff --git a/tests/testthat/data/tracer/README.md b/tests/testthat/data/tracer/README.md deleted file mode 100644 index fc315542..00000000 --- a/tests/testthat/data/tracer/README.md +++ /dev/null @@ -1,88 +0,0 @@ -# Tracer-constant CSV fixtures - -Authored for Phase 0.2 of `plans/tracer-constants-QA.md`. Used by the manual QA -walkthrough (Phases 2–5) and available to automated tests in -`tests/testthat/` via `test_path("data/tracer/")`. - -Schema is `GROUP,TracerConstant` (plan §5.A). - -## Condition names - -These use the **eight conditions of the working turnover dataset**, not the -`0h`/`6h`/`24h` names from the plan's example schema: - - 0hr, 1hr, 4hr, 12hrs, 24hrs, 48hrs, 96hrs, 168hrs - -Verified that both time parsers agree on all eight (`0, 1, 4, 12, 24, 48, 96, -168`) with no collisions and no `NA`s — so these fixtures reach the specific -trap each one exists for, rather than stopping at the group-match check. - -Do not substitute `T0h`/`Time_0h` style names; both parse to `NA` under -`parse_timepoint`'s anchored `^[0-9]+` and yield an empty result set (plan -§0.3). **If the dataset's conditions change, rewrite the `GROUP` column in every -file here to match** — otherwise every fixture fails at the group-match check -and none of the traps below are reachable. - -> Note on §0.3: this dataset cannot exercise the `24h`+`1d` collision case. No -> condition name contains `d` or `w`, so `autofill_condition_value` and -> `parse_timepoint` return identical values for all eight. Constructing that -> case needs a deliberately renamed annotation. - -## Files - -| File | Contents | What it must trap | -|---|---|---| -| `tracer_good.csv` | all eight conditions, `0.98` down to `0.91` | happy path; all values in `[0.01, 1]` | -| `tracer_missing_col.csv` | second column named `Tracer` | missing-column check | -| `tracer_nonnumeric.csv` | `12hrs` = `0.5abc` | Decision B coercion trap | -| `tracer_zero.csv` | `12hrs` = `0` | §0.2 — below the `0.01` floor (and would divide to `Inf`) | -| `tracer_tiny.csv` | `12hrs` = `1e-10` | §0.2 — below the `0.01` floor, must be **rejected** | -| `tracer_floor.csv` | `12hrs` = `0.01` | §0.2 — the inclusive boundary, must be **accepted** | -| `tracer_over.csv` | `12hrs` = `1.5` | range upper bound | -| `tracer_unknown.csv` | all eight conditions **plus** `336hrs` | group match | -| `tracer_partial.csv` | omits `168hrs` | Decision C (all-or-nothing coverage) | -| `tracer_dup.csv` | `0hr` twice, `0.98` then `0.42` | duplicate rows | -| `tracer_dupcol.csv` | `GROUP,TracerConstant,TracerConstant` | A6 | -| `tracer_empty.csv` | 0 bytes | A5 | -| `tracer_headeronly.csv` | header row only | A5 | -| `tracer_quote.csv` | `24"hrs` as a GROUP | Decision J | - -## The `0.01` floor - -§0.2 was resolved to an **inclusive `0.01` floor**: accepted range is -`[0.01, 1]`. `tracer_tiny.csv` and `tracer_floor.csv` are a matched pair -straddling that boundary — `1e-10` must be rejected, `0.01` must be accepted. A -`>` written where `>=` was meant passes every other fixture here and is caught -only by `tracer_floor.csv`, so run the two together. - -## Verified behaviour (data.table `fread`) - -Each fixture was checked to actually reproduce its trap, not just to look like -it would: - -- **`tracer_nonnumeric.csv`** — `fread` types the column `character`, and - `all(x > 0 & x <= 1)` over the column returns **`TRUE`** by lexicographic - comparison. It passes a naive range check, then `as.numeric` - silently yields `NA`. This is why the range helper must coerce first. -- **`tracer_dupcol.csv`** — `fread` keeps **both** `TracerConstant` columns; - `dt$TracerConstant` silently returns the **first**. The first column holds - `0.01`–`0.08` and the second the correct `0.98`–`0.91`, so "took the stale - column" is visible in the output rather than being a subtle offset. -- **`tracer_empty.csv`** — `fread` **warns** (`has size 0. Returning a NULL - data.table`) and returns a `0x0` data.table. It does not error, so a - `tryCatch` around `fread` alone will not catch this. -- **`tracer_headeronly.csv`** — parses cleanly to 0 rows with correct names, and - `all(logical(0))` is `TRUE`, so a naive range check **passes** on it. -- **`tracer_quote.csv`** — written with a bare `24"h` rather than the RFC 4180 - `"24""h"` form **on purpose**: `fread` does not unescape doubled quotes here - (it yields the literal `24""hrs`), whereas the bare field parses to exactly - one `"` character. Confirmed that feeding that group name through the current - unescaped `paste0(" \"", conditions, "\" = ", ...)` produces a script that - fails `parse()` with `unexpected symbol`. - - Reaching the script-generation step needs a condition genuinely named - `24"hrs` in the annotation; against the unmodified annotation this file stops - at the group-match check instead. - -Phase 3 also calls for a **non-CSV file**. That is not checked in — use any -handy binary or text file (e.g. `inst/extdata/evidence.rda`). From b7eb6c2a92e41e389e0e20c8b168fc611ea235c8 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 09:30:56 -0400 Subject: [PATCH 04/10] add unnecessary comments from test files --- tests/testthat/test-module-qc-ui.R | 25 +-- tests/testthat/test-module-statmodel-server.R | 18 +- tests/testthat/test-module-turnover.R | 186 +++++++----------- tests/testthat/test-qc-data-upload.R | 36 ++-- 4 files changed, 100 insertions(+), 165 deletions(-) diff --git a/tests/testthat/test-module-qc-ui.R b/tests/testthat/test-module-qc-ui.R index b49c5924..77c9070c 100644 --- a/tests/testthat/test-module-qc-ui.R +++ b/tests/testthat/test-module-qc-ui.R @@ -22,13 +22,8 @@ test_that("qcUI renders the namespaced processing-option input ids", { "standards", "reference_norm", "remove_norm_channel", "features_used", "censInt", "null1", "maxQC1", "MBi", "remove50", "typequant", "format", "summ", "fname", "run", "update_results", - # The tracer-constants panel is statically mounted and - # server-toggled, and every one of these ids is addressed - # server-side through NAMESPACE_QC rather than as a literal - # (shinyjs::toggle/reset/onevent, input[[...]], output[[...]]). - # A renamed or un-namespaced id would leave the panel, the - # Clear button or the status line silently inert with the rest - # of the suite green, so they are pinned here. + # Addressed server-side through NAMESPACE_QC, so a renamed or + # un-namespaced id leaves the panel and Clear button inert. "tracer_constants_file", "tracer_constants_clear") for (id in input_ids) { expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), @@ -67,24 +62,20 @@ test_that("the collapsed normalization select keeps all label-free choices", { test_that("qcUI mounts the tracer-constants status output", { html <- render_qc_ui_html("test") - # uiOutput, not an input, so it needs its own assertion. Without it the - # absent/pending/rejected/valid states have nowhere to render, and a rejected - # upload looks identical to a successful one (plan Decision H). + # uiOutput, not an input: without it the absent/pending/rejected/valid states + # have nowhere to render. expect_true(grepl('id="test-tracer_constants_status"', html, fixed = TRUE)) }) test_that("the tracer-constants help text quotes CONSTANTS_QC, not a literal", { html <- render_qc_ui_html("test") - # Catches the drift plan section 5.B warns about: if the floor is revised in - # CONSTANTS_QC and the help text keeps a hardcoded number, the expected - # string moves and this fails. It cannot catch a literal that happens to - # equal today's value -- both render identically -- which is why the range - # check and the rejection message read the same constant. + # Fails if the bounds are revised in CONSTANTS_QC while the help text keeps a + # hardcoded number. expect_true(grepl(paste0("between ", CONSTANTS_QC$tracer_min, " and ", CONSTANTS_QC$tracer_max), html, fixed = TRUE)) - # Scoped to the panel's own markup. Page-wide, "GROUP" appears a dozen times - # in unrelated uploads and would still match with this panel deleted. + # Scoped to the panel's own markup: page-wide, "GROUP" appears in unrelated + # uploads and would still match with this panel deleted. panel_start <- regexpr("test-tracer_constants_panel", html, fixed = TRUE) expect_gt(panel_start, 0) panel <- substr(html, panel_start, panel_start + 3000L) diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index 9ab89c59..69e2e484 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -786,19 +786,16 @@ test_that("create_download_plot_handler is invoked with all 6 arguments", { } ) }) + # ============================================================================ # Tracer constants: the statmodelServer -> generate_analysis_code hop # ============================================================================ test_that("statmodelServer forwards the tracer_constants snapshot to generate_analysis_code", { - # The highest-value hop in the threading chain and the one the first draft of - # this feature left untested. A correct generator wired to nothing is exactly - # the original bug, so this asserts the value ARRIVES, not that the generator - # formats it (test-module-turnover.R covers the formatting). - # - # data_comparison_code is private to the module and only read by the download - # handler, so it is captured through create_download_handlers -- the same - # stub-the-collaborator pattern as the create_download_plot_handler test. + # Asserts the snapshot ARRIVES; test-module-turnover.R covers how the + # generator formats it. data_comparison_code is private to the module and only + # read by the download handler, so it is captured through + # create_download_handlers. captured = new.env(parent = emptyenv()) captured$code_reactive = NULL captured$args = NULL @@ -853,9 +850,8 @@ test_that("statmodelServer forwards the tracer_constants snapshot to generate_an }) test_that("statmodelServer defaults the tracer snapshot to NULL when no reactive is supplied", { - # Every existing caller and test omits the argument; none of them may start - # failing, and the generator must see NULL (the "QC page never run" state) - # rather than a reactive it cannot coerce. + # Existing callers omit the argument, and the generator must see NULL (the + # "QC page never run" state) rather than a reactive it cannot coerce. captured = new.env(parent = emptyenv()) captured$code_reactive = NULL captured$args = NULL diff --git a/tests/testthat/test-module-turnover.R b/tests/testthat/test-module-turnover.R index 48011758..c19088b6 100644 --- a/tests/testthat/test-module-turnover.R +++ b/tests/testthat/test-module-turnover.R @@ -1,7 +1,3 @@ -# ============================================================================ -# Tests for protein turnover functionality -# ============================================================================ - # ============================================================================ # Tests for TEMPLATES and TEMPLATE_LABELS constants # ============================================================================ @@ -410,8 +406,6 @@ test_that("generate_analysis_code produces turnover-specific code for protein_tu # ============================================================================ # A tracer_constants snapshot in the shape register_qc_turnover records it. -# Written as a helper because the argument is now REQUIRED: a default would let -# a future test silently assert all-1s behaviour, which is the bug under repair. tracer_snapshot <- function(values, source = CONSTANTS_QC$tracer_source_upload, file = "tracer.csv") { list(values = values, source = source, file = file) @@ -471,18 +465,13 @@ test_that("build_turnover_analysis_code emits syntactically valid R", { }) # --------------------------------------------------------------------------- -# Risk #1: the emitted vector must round-trip to the vector the app divided by. -# -# Deliberately NOT a grepl() for a substring: that is the shape of assertion -# that masked the original bug, because it passes on a script whose vector is -# right in the one place it looks and all-1s everywhere else. Evaluating the -# emitted source and comparing the whole object catches names, values, ORDER and -# precision at once. +# The emitted vector must round-trip to the vector the app divided by. +# Evaluating the emitted source rather than grepl()-ing a substring out of it +# catches names, values, order and precision at once. # --------------------------------------------------------------------------- -# Pulls the `tracer_constants = c(...)` assignment back out of the generated -# script and evaluates it, so the assertion is against what R would actually -# bind, not against the text. +# Pulls the `tracer_constants = c(...)` assignment out of the generated script +# and evaluates it, so the assertion is against what R would bind. eval_emitted_tracer_constants <- function(code) { env <- new.env(parent = baseenv()) found <- FALSE @@ -502,8 +491,7 @@ eval_emitted_tracer_constants <- function(code) { test_that("the emitted tracer_constants vector is identical to the resolved one", { conditions <- c("0h", "6h", "24h") # 1/3 is the point of the test: paste0() renders it to 15 significant digits, - # which parses back to a DIFFERENT double, so a "reproducible" script would - # divide by a number the app never used. + # which parses back to a DIFFERENT double. uploaded <- stats::setNames(c(1/3, 0.9, 1), conditions) resolved <- MSstatsShiny:::qc_resolve_tracer_constants(conditions, uploaded) @@ -533,8 +521,8 @@ test_that("the emitted vector follows the contrast matrix order, not the file or }) test_that("build_turnover_analysis_code escapes quotes in condition names", { - # Latent before this change, because make.names() sanitized the names away; - # keying by the raw condition string newly exposes it (plan Decision J). + # Keying by the raw condition string exposes this; make.names() previously + # sanitized the names away. conditions <- c('0h "baseline"', "6h\\late") resolved <- stats::setNames(c(1, 0.9), conditions) comp_mat <- data.frame(GROUP = conditions, TimeVal = c(0, 6), @@ -575,7 +563,7 @@ test_that("build_turnover_analysis_code refuses to emit constants it cannot vouc tracer_constants = tracer_snapshot(stats::setNames(c(0.5, 0.9), c("0h", "0h ")))), "ambiguous for condition") # ...but a key repeated with the SAME value cannot mispair, and the all-1s - # default legitimately produces one, so it must still build. + # default legitimately produces one. expect_silent( MSstatsShiny:::build_turnover_analysis_code( list(assign_feature_weights = FALSE), @@ -590,11 +578,9 @@ test_that("build_turnover_analysis_code refuses to emit constants it cannot vouc }) test_that("build_turnover_analysis_code refuses a blank condition name", { - # `c("" = 1)` is a PARSE error in R, not a runtime one, so emitting a blank - # condition name produces a downloadable script that will not even load. This - # is reachable WITHOUT an upload: a blank Condition cell in the annotation - # reaches the all-1s default path, which runs none of the upload observer's - # name checks. + # `c("" = 1)` is a PARSE error, so a blank condition name produces a script + # that will not even load. Reachable without an upload: a blank Condition cell + # takes the all-1s default path, which runs none of the upload name checks. for (blank in list("", " ", NA_character_)) { comp_mat <- data.frame(GROUP = c(blank, "6h"), TimeVal = c(0, 6), stringsAsFactors = FALSE) @@ -626,7 +612,7 @@ test_that("a blank condition name cannot reach the script via the all-1s default test_that("build_turnover_analysis_code matches conditions ignoring surrounding whitespace", { # An Excel-sourced "0h " is not editable in the metadata table, so a strict - # match would be an unfixable dead end (plan section 0.4). + # match would be an unfixable dead end. comp_mat <- data.frame(GROUP = c("0h ", "6h"), TimeVal = c(0, 6), stringsAsFactors = FALSE) code <- MSstatsShiny:::build_turnover_analysis_code( @@ -639,9 +625,8 @@ test_that("build_turnover_analysis_code matches conditions ignoring surrounding test_that("exactly one tracer provenance comment is stamped into the script", { comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), stringsAsFactors = FALSE) - # Each marker is the phrase that DISTINGUISHES its state. Deliberately shorter - # than the full comment: a marker only usable in its entirety would not catch - # the overlap this test exists to prevent. + # Each marker is the phrase that DISTINGUISHES its state, deliberately shorter + # than the full comment so it can catch an overlap between them. markers <- c(upload = "uploaded on the data-processing page", none = "no file was supplied on the data-processing page", not_run = "the data-processing page was not run in this session") @@ -665,12 +650,9 @@ test_that("exactly one tracer provenance comment is stamped into the script", { info = paste("provenance comments must be mutually exclusive:", state)) } - # The markers must not be substrings of one another's comments. Before this - # was asserted, "uploaded on the data-processing page" matched the NO-upload - # comment ("...no tracer constants file was uploaded on the data-processing - # page"), so any grep for the upload state also matched the case where nothing - # was uploaded -- provenance that cannot be read unambiguously is not - # provenance. + # The markers must not be substrings of one another's comments: an earlier + # wording had "uploaded on the data-processing page" appear inside the + # NO-upload comment, so a grep for the upload state matched both. comments <- vapply(cases, MSstatsShiny:::build_tracer_provenance_comment, character(1)) for (owner in names(markers)) { @@ -709,10 +691,8 @@ test_that("format_r_double emits the shortest form that reads back identically", }) # --------------------------------------------------------------------------- -# Per-hop forwarding. The round-trip test above proves the generator is correct -# given the right input; these prove the right input actually reaches it. Both -# halves are needed -- the original bug was a correct generator wired to the -# wrong source. +# Per-hop forwarding: the round-trip tests above prove the generator is correct +# given the right input; these prove the right input reaches it. # --------------------------------------------------------------------------- test_that("generate_analysis_code forwards the tracer snapshot into the turnover script", { @@ -741,8 +721,7 @@ test_that("generate_analysis_code forwards the tracer snapshot into the turnover test_that("generate_analysis_code labels an unrun QC page as such rather than as no upload", { # Reachable, not a defect: the Download-code button only requires a contrast # matrix, and the upload-summarized-abundances flow never renders the tracer - # panel at all (plan section 0.6). The script must not claim the user declined - # a correction they were never offered. + # panel at all. mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") comp_mat <- data.frame(GROUP = c("0h", "6h"), TimeVal = c(0, 6), @@ -765,10 +744,8 @@ test_that("generate_analysis_code labels an unrun QC page as such rather than as test_that("generate_analysis_code resolves the NULL snapshot only inside the turnover branch", { # On the group-comparison path comp_mat is a bare MATRIX, where `$GROUP` # throws "$ operator is invalid for atomic vectors". Resolving the NULL - # snapshot at the top of the function -- rather than inside the turnover - # branch -- would therefore take the Download-code button out on every - # template. Verified against the existing matrix fixture shape used by - # test-utils-statmodel-server.R. + # snapshot at the top of the function rather than inside the turnover branch + # would therefore take the Download-code button out on every template. mockery::stub(generate_analysis_code, "preprocessDataCode", "# preprocess\n") comp_mat <- matrix(c(1, -1), nrow = 1, dimnames = list("C2-C1", c("C1", "C2"))) @@ -839,6 +816,7 @@ test_that("generate_analysis_code uses placeholder drug_name for non-turnover te expect_true(grepl("Enter drug name here", result), info = "Non-turnover code should use a placeholder drug name") }) + # ============================================================================ # Tests for the Turnover Ratios panel (register_qc_turnover) # ============================================================================ @@ -905,7 +883,7 @@ test_that("Download Ratios is enabled once ratios are calculated", { # ============================================================================ # The eight conditions of the working turnover dataset. Every fixture in -# data/tracer/ is keyed to these; see that directory's README. +# data/tracer/ is keyed to these. turnover_conditions <- c("0hr", "1hr", "4hr", "12hrs", "24hrs", "48hrs", "96hrs", "168hrs") @@ -958,7 +936,7 @@ test_that("a well-formed tracer file is accepted with one value per condition", test_that("every malformed tracer file is rejected rather than silently defaulted", { # Rejected, not absent: absent means "the user declined the correction" and - # runs with all 1s, which is the silent failure this feature exists to remove. + # runs with all 1s. rejected <- c("tracer_missing_col.csv", "tracer_nonnumeric.csv", "tracer_zero.csv", "tracer_tiny.csv", "tracer_over.csv", "tracer_unknown.csv", "tracer_partial.csv", "tracer_dup.csv", @@ -1072,18 +1050,15 @@ test_that("clearing the upload returns to the neutral all-ones state", { }) # ============================================================================ -# Step 4: the constants resolved at Run are the ones the fit actually receives +# The constants resolved at Run are the ones the fit actually receives # ============================================================================ -# The upload observer tests above stop at the reactiveVal. These carry the -# value the rest of the way, because "the state says valid" and "the fit -# divided by those numbers" are different claims -- the whole bug this feature -# removes was a UI that asserted the first while the second was false. -# -# calculateTurnoverRatios is stubbed so the assertion is on the tracer_constants -# argument itself rather than on downstream ratios, which would depend on -# MSstatsResponse's arithmetic and on turnover fixture data this repo does not -# have (plan section 8). +# The upload observer tests above stop at the reactiveVal; these carry the value +# the rest of the way. calculateTurnoverRatios is stubbed so the assertion is on +# the tracer_constants argument itself rather than on downstream ratios, which +# would depend on MSstatsResponse's arithmetic and on turnover fixture data this +# repo does not have. + # Two distinct runs per condition, so use_protein_level is TRUE and the # ProteinLevelData branch is taken. turnover_pld <- function() { @@ -1118,9 +1093,8 @@ turnover_fld <- function() { fld } -# template and preprocess are injectable so the divergence regressions below can -# switch the app template mid-session and make a second Run bail out early; -# their defaults keep every other caller on the original single-template setup. +# template and preprocess are injectable so the regressions below can switch the +# app template mid-session and make a second Run bail out early. tracer_run_server <- function(capture, conditions = reactive( data.frame(Condition = turnover_conditions, @@ -1189,12 +1163,12 @@ test_that("a valid upload reaches the fit; no upload sends all 1s", { expect_equal(capture$snapshot$values, expected, info = label) expect_identical(capture$snapshot$source, case$source, info = label) # The ProteinLevelData branch, not the FeatureLevelData one: the harness - # supplies two runs per condition. Asserted because the fake fit otherwise - # makes the two branches indistinguishable. + # supplies two runs per condition, and the fake fit otherwise makes the two + # branches indistinguishable. expect_identical(capture$fit_calls, 1L, info = label) expect_identical(nrow(capture$data_seen), 16L, info = label) - # Provenance is three-state (plan section 0.6), so "which file" has to - # survive alongside "from a file at all". + # Provenance is three-state, so "which file" has to survive alongside "from + # a file at all". if (is.null(case$fixture)) { expect_null(capture$snapshot$file, info = label) } else { @@ -1204,11 +1178,9 @@ test_that("a valid upload reaches the fit; no upload sends all 1s", { }) test_that("the FeatureLevelData branch also receives the tracer constants", { - # The single-replicate branch (R/qc-server-turnover.R). Every other fit test - # supplies two runs per condition and so only ever exercises the - # ProteinLevelData branch -- deleting tracer_constants = from this one would - # revert single-replicate turnover experiments to no correction with the rest - # of the suite still green. + # Every other fit test supplies two runs per condition and so only exercises + # the ProteinLevelData branch; without this one, dropping tracer_constants = + # from the single-replicate branch would leave the suite green. ctx <- with_stubbed_fit() capture <- ctx$capture server <- tracer_run_server( @@ -1227,9 +1199,8 @@ test_that("the FeatureLevelData branch also receives the tracer constants", { turnover_conditions) # Which branch ran: the fake fit is shared, so the data's column names are the - # only witness. INTENSITY means FeatureLevelData, LogIntensities would mean - # the harness silently fell back to the ProteinLevelData branch and this test - # would be asserting nothing new. + # only witness. INTENSITY means FeatureLevelData; LogIntensities would mean the + # harness fell back to the ProteinLevelData branch. expect_identical(capture$fit_calls, 1L) expect_true("INTENSITY" %in% names(capture$data_seen)) expect_false("LogIntensities" %in% names(capture$data_seen)) @@ -1238,12 +1209,11 @@ test_that("the FeatureLevelData branch also receives the tracer constants", { }) test_that("rejection messages name the tracer file, not the GROUP mapping upload", { - # plan section 0.7. qc_mapping_group_errors' defaults name "GROUP mapping" and + # qc_mapping_group_errors' defaults name "GROUP mapping" and # "ProteinLevelData"; the GROUP mapping is a DIFFERENT upload on this same # page, so the default wording sends a user who mis-typed a condition here off # to edit an unrelated file. The labels are supplied only at the call site in - # R/qc-server-turnover.R, so nothing else pins them -- reverting that call to - # the defaults leaves every other test green. + # R/qc-server-turnover.R, so nothing else pins them. cases <- list( list(fixture = "tracer_unknown.csv", reference = TRUE), list(fixture = "tracer_partial.csv", reference = TRUE), @@ -1288,10 +1258,9 @@ test_that("rejection messages name the tracer file, not the GROUP mapping upload }) test_that("Run is refused server-side while an upload is pending or rejected", { - # plan section 0.1. toggleState disables the button on the CLIENT, and - # shinyjs::onevent needs a server round trip to set "pending", so a click in - # that window reaches the server with the button still live. Falling back to - # all-1s there is the silent failure the feature exists to remove. + # toggleState disables the button on the CLIENT, and shinyjs::onevent needs a + # server round trip to set "pending", so a click in that window reaches the + # server with the button still live. for (fixture in c("tracer_partial.csv", "tracer_nonnumeric.csv")) { ctx <- with_stubbed_fit() capture <- ctx$capture @@ -1314,10 +1283,8 @@ test_that("Run is refused server-side while an upload is pending or rejected", { }) test_that("the snapshot never outlives the ratios it describes", { - # Decision I is a two-way guarantee: the snapshot must not drift ahead of the - # displayed ratios, and it must not survive them either. A snapshot left - # behind by a run that produced nothing would have the generated script cite - # tracer constants for an empty table. + # A snapshot left behind by a run that produced nothing would have the + # generated script cite tracer constants for an empty table. ctx <- with_stubbed_fit() capture <- ctx$capture template <- reactiveVal(TEMPLATES$protein_turnover) @@ -1357,12 +1324,10 @@ test_that("the snapshot never outlives the ratios it describes", { }) test_that("a refused re-Run clears the snapshot left by an earlier good Run", { - # The dangerous ordering: a good run banks a snapshot, then the user replaces - # the file with a bad one and presses Run again. The re-Run is refused, so - # the ratios table still shows the FIRST run's numbers -- but if the snapshot - # survived it would too, and the generated script would keep citing a file - # the app has since rejected. Clearing is what makes the refusal visible - # downstream instead of silently reusing stale provenance. + # A good run banks a snapshot, then the user replaces the file with a bad one + # and presses Run again. The re-Run is refused, so the ratios table still + # shows the FIRST run's numbers; a surviving snapshot would have the generated + # script keep citing a file the app has since rejected. ctx <- with_stubbed_fit() capture <- ctx$capture server <- tracer_run_server(capture) @@ -1388,8 +1353,8 @@ test_that("a refused re-Run clears the snapshot left by an earlier good Run", { }) test_that("the snapshot is taken at Run and does not follow a later upload", { - # Decision I. A live view of the upload would make the ratios table show one - # set of constants while the downloadable script emitted another. + # A live view of the upload would make the ratios table show one set of + # constants while the downloadable script emitted another. ctx <- with_stubbed_fit() capture <- ctx$capture server <- tracer_run_server(capture) @@ -1410,9 +1375,8 @@ test_that("the snapshot is taken at Run and does not follow a later upload", { }) test_that("the exposed constants reactive is NULL before Run and never errors", { - # Plan section 0.6's third provenance state, and Decision E: this value is - # read from the Download-code path on all four templates, so reading it - # before the QC page has run must not raise shiny.silent.error. + # This value is read from the Download-code path on all four templates, so + # reading it before the QC page has run must not raise shiny.silent.error. capture <- new.env() before <- "unset" testServer(tracer_upload_server(capture), { @@ -1426,9 +1390,8 @@ test_that("the exposed constants reactive is NULL before Run and never errors", # ============================================================================ # Wraps the real qcServer so its return value can be inspected. A shape -# assertion rather than a behavioural one: this hop is pure plumbing, and the -# way it breaks is a renamed or dropped key, which every downstream test would -# see only as a mysterious NULL. +# assertion rather than a behavioural one: this hop is plumbing, and it breaks +# by a renamed or dropped key. qc_server_return_capture <- function(capture, template = TEMPLATES$protein_turnover) { function(input, output, session) { capture$returned <- qcServer( @@ -1454,7 +1417,7 @@ test_that("qcServer exposes tracerConstants alongside the ratios", { is_reactive <<- is.function(capture$returned$tracerConstants) # Must be readable before anything has been run, on any template: server.R # hands it to statmodelServer, which reads it from the Download-code path - # for all four templates (plan Decision E). + # for all four templates. value <<- capture$returned$tracerConstants() }) @@ -1476,18 +1439,16 @@ test_that("qcServer's tracerConstants is readable on a non-turnover template", { }) # ============================================================================ -# Decision I regressions: the ratios table and the generated script must never -# disagree about which constants were used. Both cases below passed the whole -# suite while diverging, because every existing test reads the two values only -# at the moment of Run, when they necessarily agree. +# Divergence regressions: the ratios table and the generated script must never +# disagree about which constants were used. Both cases below are read after the +# divergence, not at Run, when the two values necessarily agree. # ============================================================================ test_that("a template round-trip clears the ratios table with its snapshot", { - # turnover_ratios is an eventReactive, so nothing but a fresh Run invalidates - # its cache -- the template observer cannot. It does clear the snapshot, so + # turnover_ratios is an eventReactive, so only a fresh Run invalidates its + # cache -- the template observer cannot, though it does clear the snapshot. So # switching away and back used to redraw a table carrying the uploaded - # correction while the script emitted all-1s stamped "not run in this - # session". Asserted after the round trip, not at Run, for that reason. + # correction while the script emitted all-1s stamped "not run in this session". ctx <- with_stubbed_fit() capture <- ctx$capture template <- reactiveVal(TEMPLATES$protein_turnover) @@ -1545,14 +1506,11 @@ test_that("the snapshot is committed only after the fit returns", { # A reactiveVal write is not rolled back when the eventReactive body aborts, # and calculateTurnoverRatios throws on plausible data (ProteinLevelData with # no "H" rows raises "Element `H` doesn't exist"). Committing before the fit - # therefore left the script citing constants -- and naming the uploaded file - # -- for a table that never drew. + # therefore left the script citing constants for a table that never drew. # - # Asserted by reading the snapshot from INSIDE the fit rather than by making - # the fit throw: an error there is unhandled in the observer that forces this - # eventReactive, which destroys the session and takes every reactive with it, - # so nothing would be readable afterwards. The ordering is the real subject - # anyway, and it is what distinguishes the two versions. + # The snapshot is read from INSIDE the fit rather than by making the fit throw: + # an error there is unhandled in the observer forcing this eventReactive, which + # destroys the session and leaves nothing readable afterwards. ctx <- with_stubbed_fit() capture <- ctx$capture ordering_fit <- function(data, ...) { diff --git a/tests/testthat/test-qc-data-upload.R b/tests/testthat/test-qc-data-upload.R index 995ecbfe..4e258c98 100644 --- a/tests/testthat/test-qc-data-upload.R +++ b/tests/testthat/test-qc-data-upload.R @@ -100,9 +100,8 @@ test_that("qc_mapping_to_condition_metadata renames GROUP to Condition (turnover test_that("qc_mapping_to_condition_metadata stores the same trimmed Condition that was validated", { # qc_mapping_group_errors compares TRIMMED values, so a quoted "DMSO " cell - # (fread's strip.white leaves quoted fields alone) passes validation. If the - # raw value were stored, it would then miss the ProteinLevelData join and - # silently drop that condition's rows. + # (fread's strip.white leaves quoted fields alone) passes validation but would + # miss the ProteinLevelData join if stored raw. parsed = data.frame(GROUP = c("DMSO ", " 6h"), TimeVal = c(0, 6), stringsAsFactors = FALSE) protein_groups = c("DMSO", "6h") @@ -219,23 +218,20 @@ test_that("qc_tracer_values_in_range accepts the inclusive [min, max] band", { in_range = function(x) MSstatsShiny:::qc_tracer_values_in_range( data.frame(TracerConstant = x, stringsAsFactors = FALSE), "TracerConstant") - # Both bounds are inclusive, and the band is populated in between. expect_true(in_range(tracer_min)) expect_true(in_range(tracer_max)) expect_true(in_range(c(tracer_min, 0.5, tracer_max))) # Just under the floor fails, so the boundary is >= and not >. expect_false(in_range(tracer_min - 0.001)) - # 0 divides to Inf; 1e-10 is worse because it passes a naive (0, 1] check and - # yields a huge H_frac whose L_frac is then silently clamped to 0. + # 0 divides to Inf; 1e-10 passes a naive (0, 1] check and yields a huge H_frac + # whose L_frac is then silently clamped to 0. expect_false(in_range(0)) expect_false(in_range(1e-10)) - # Above the ceiling, negative, and non-finite. expect_false(in_range(tracer_max + 0.5)) expect_false(in_range(-0.2)) expect_false(in_range(NA_real_)) expect_false(in_range(Inf)) - # One bad value among good ones fails the whole file. expect_false(in_range(c(0.5, NA_real_))) # A character column must be coerced before comparison: uncoerced, @@ -248,7 +244,6 @@ test_that("qc_tracer_values_in_range accepts the inclusive [min, max] band", { expect_false(in_range(character(0))) expect_false(in_range(numeric(0))) expect_false(MSstatsShiny:::qc_tracer_values_in_range(NULL, "TracerConstant")) - # Absent column. expect_false(MSstatsShiny:::qc_tracer_values_in_range( data.frame(GROUP = "0h", stringsAsFactors = FALSE), "TracerConstant")) }) @@ -260,7 +255,7 @@ test_that("qc_default_tracer_constants is all ones, named by condition", { expect_identical(defaults, c("0h" = 1, "6h" = 1, "24h" = 1)) # A named numeric(0) is not NULL, so it would pass calculateTurnoverRatios' - # own guard and make every H_frac NA. Error instead. + # own guard and make every H_frac NA. expect_error(MSstatsShiny:::qc_default_tracer_constants(character(0)), "no experimental conditions") }) @@ -291,7 +286,6 @@ test_that("qc_resolve_tracer_constants errors instead of reindexing to NA", { MSstatsShiny:::qc_resolve_tracer_constants(c("0h", "6h"), c("0h" = 0.98)), "missing for condition\\(s\\): 6h" ) - # Unreadable value rather than absent key. expect_error( MSstatsShiny:::qc_resolve_tracer_constants(c("0h"), c("0h" = NA_real_)), "could not be read for condition\\(s\\): 0h" @@ -312,9 +306,9 @@ test_that("qc_tracer_timepoint_hours mirrors the MSstatsResponse parser", { expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("1d"), 24) expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("6h_drug"), 144) expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours("2w"), 336) - # NA in, NA out. The upstream parser errors here ("NAs are not allowed in - # subscripted assignments") once the vector is long enough for the day/week - # subscript assignment to fire, so this needs a length > 1 case to bite. + # The upstream parser errors on NA ("NAs are not allowed in subscripted + # assignments") only once the vector is long enough for the day/week subscript + # assignment to fire, so a length > 1 case is needed too. expect_true(is.na(MSstatsShiny:::qc_tracer_timepoint_hours(NA_character_))) expect_equal(MSstatsShiny:::qc_tracer_timepoint_hours(c("1d", NA, "2w")), c(24, NA, 336)) @@ -329,14 +323,13 @@ test_that("qc_tracer_misleading_units flags a stray d or w, not any suffix", { expect_true(flags("24h_washout")) # A genuine day/week unit is not misleading. expect_equal(flags(c("1d", "2w", "3 days", "4 weeks", "5wk")), rep(FALSE, 5)) - # A suffix carrying no "d" or "w" never fires the multiplier, so leaving it - # alone avoids rejecting a run that would have been correct. + # A suffix carrying no "d" or "w" never fires the multiplier, so flagging it + # would reject a run that would have been correct. expect_equal(flags(c("0h", "24h_rep1", "168hrs", "12hrs")), rep(FALSE, 4)) expect_false(flags(NA_character_)) }) test_that("qc_tracer_timepoint_errors rejects unparseable and colliding names", { - # The working dataset's conditions all parse, and none collide. expect_equal( MSstatsShiny:::qc_tracer_timepoint_errors( c("0hr", "1hr", "4hr", "12hrs", "24hrs", "48hrs", "96hrs", "168hrs")), @@ -367,7 +360,6 @@ test_that("qc_tracer_timepoint_errors rejects unparseable and colliding names", expect_length(misleading, 1) expect_match(misleading, "6h_drug", fixed = TRUE) expect_match(misleading, "144 hours", fixed = TRUE) - # A suffix with no "d" or "w" is left alone. expect_equal(MSstatsShiny:::qc_tracer_timepoint_errors(c("0h", "24h_rep1")), character(0)) @@ -404,7 +396,7 @@ test_that("qc_resolve_tracer_constants matches on trimmed names", { # Matching is trimmed; the returned NAMES stay raw, because # calculateTurnoverRatios re-keys them through parse_timepoint. expect_equal(resolved, c("0h " = 0.98, "6h" = 0.95)) - # Case stays strict. + # Case is not folded. expect_error( MSstatsShiny:::qc_resolve_tracer_constants(c("0H"), c("0h" = 0.98)), "missing for condition" @@ -423,19 +415,17 @@ test_that("qc_resolve_tracer_constants rejects a condition listed twice", { test_that("qc_mapping_group_errors matches on trimmed names", { expect_equal(MSstatsShiny:::qc_mapping_group_errors(c("0h "), c("0h")), character(0)) - # Case is deliberately not folded. + # Case is not folded. expect_length(MSstatsShiny:::qc_mapping_group_errors(c("0H"), c("0h")), 2) }) test_that("qc_mapping_group_errors labels are parameterized, defaults unchanged", { - # Defaults still name the GROUP mapping and ProteinLevelData, so the existing - # caller's messages are untouched. default_msg = MSstatsShiny:::qc_mapping_group_errors(c("A"), c("A", "B")) expect_match(default_msg, "GROUP mapping is missing row(s) for ProteinLevelData GROUP(s): B.", fixed = TRUE) # A different upload names itself and its own reference, so the message does - # not send the user off to edit an unrelated file. + # not send the user to an unrelated file. tracer_msg = MSstatsShiny:::qc_mapping_group_errors( c("0h", "99h"), c("0h", "6h"), subject = "Tracer constants file", reference = "the annotation") From c42833c5c21517db91c3a2fb38ea45880ddc7242 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 09:40:18 -0400 Subject: [PATCH 05/10] remove unnecessary comments --- tests/testthat/test-module-qc-ui.R | 9 --------- tests/testthat/test-module-statmodel-server.R | 8 -------- 2 files changed, 17 deletions(-) diff --git a/tests/testthat/test-module-qc-ui.R b/tests/testthat/test-module-qc-ui.R index 77c9070c..31bb9e52 100644 --- a/tests/testthat/test-module-qc-ui.R +++ b/tests/testthat/test-module-qc-ui.R @@ -22,8 +22,6 @@ test_that("qcUI renders the namespaced processing-option input ids", { "standards", "reference_norm", "remove_norm_channel", "features_used", "censInt", "null1", "maxQC1", "MBi", "remove50", "typequant", "format", "summ", "fname", "run", "update_results", - # Addressed server-side through NAMESPACE_QC, so a renamed or - # un-namespaced id leaves the panel and Clear button inert. "tracer_constants_file", "tracer_constants_clear") for (id in input_ids) { expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), @@ -62,20 +60,13 @@ test_that("the collapsed normalization select keeps all label-free choices", { test_that("qcUI mounts the tracer-constants status output", { html <- render_qc_ui_html("test") - # uiOutput, not an input: without it the absent/pending/rejected/valid states - # have nowhere to render. expect_true(grepl('id="test-tracer_constants_status"', html, fixed = TRUE)) }) test_that("the tracer-constants help text quotes CONSTANTS_QC, not a literal", { html <- render_qc_ui_html("test") - # Fails if the bounds are revised in CONSTANTS_QC while the help text keeps a - # hardcoded number. expect_true(grepl(paste0("between ", CONSTANTS_QC$tracer_min, " and ", CONSTANTS_QC$tracer_max), html, fixed = TRUE)) - - # Scoped to the panel's own markup: page-wide, "GROUP" appears in unrelated - # uploads and would still match with this panel deleted. panel_start <- regexpr("test-tracer_constants_panel", html, fixed = TRUE) expect_gt(panel_start, 0) panel <- substr(html, panel_start, panel_start + 3000L) diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index 69e2e484..47de5bd2 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -792,10 +792,6 @@ test_that("create_download_plot_handler is invoked with all 6 arguments", { # ============================================================================ test_that("statmodelServer forwards the tracer_constants snapshot to generate_analysis_code", { - # Asserts the snapshot ARRIVES; test-module-turnover.R covers how the - # generator formats it. data_comparison_code is private to the module and only - # read by the download handler, so it is captured through - # create_download_handlers. captured = new.env(parent = emptyenv()) captured$code_reactive = NULL captured$args = NULL @@ -832,8 +828,6 @@ test_that("statmodelServer forwards the tracer_constants snapshot to generate_an session$setInputs(!!NAMESPACE_STATMODEL$comparison_mode := CONSTANTS_STATMODEL$comparison_mode_response_curve) - # Set only after the comparison mode, because the observer that builds the - # turnover contrast matrix req()s the response-curve mode. metadata(data.frame(Condition = c("0h", "6h"), TimeVal = c(0, 6), stringsAsFactors = FALSE)) session$setInputs(!!NAMESPACE_STATMODEL$modeling_start := 1) @@ -850,8 +844,6 @@ test_that("statmodelServer forwards the tracer_constants snapshot to generate_an }) test_that("statmodelServer defaults the tracer snapshot to NULL when no reactive is supplied", { - # Existing callers omit the argument, and the generator must see NULL (the - # "QC page never run" state) rather than a reactive it cannot coerce. captured = new.env(parent = emptyenv()) captured$code_reactive = NULL captured$args = NULL From ac6f47c188e77ea605c99c5f7979f28fbed1fbc9 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 10:05:27 -0400 Subject: [PATCH 06/10] remove unnecessary unit tests --- tests/testthat/test-module-qc-ui.R | 17 ---- tests/testthat/test-module-statmodel-server.R | 98 ------------------- 2 files changed, 115 deletions(-) diff --git a/tests/testthat/test-module-qc-ui.R b/tests/testthat/test-module-qc-ui.R index 31bb9e52..6120e2e2 100644 --- a/tests/testthat/test-module-qc-ui.R +++ b/tests/testthat/test-module-qc-ui.R @@ -57,20 +57,3 @@ test_that("the collapsed normalization select keeps all label-free choices", { info = paste("Missing normalization choice:", choice)) } }) - -test_that("qcUI mounts the tracer-constants status output", { - html <- render_qc_ui_html("test") - expect_true(grepl('id="test-tracer_constants_status"', html, fixed = TRUE)) -}) - -test_that("the tracer-constants help text quotes CONSTANTS_QC, not a literal", { - html <- render_qc_ui_html("test") - expect_true(grepl(paste0("between ", CONSTANTS_QC$tracer_min, " and ", - CONSTANTS_QC$tracer_max), html, fixed = TRUE)) - panel_start <- regexpr("test-tracer_constants_panel", html, fixed = TRUE) - expect_gt(panel_start, 0) - panel <- substr(html, panel_start, panel_start + 3000L) - for (column in get_qc_required_tracer_columns()) { - expect_true(grepl(column, panel, fixed = TRUE), info = column) - } -}) diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index 47de5bd2..2166249c 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -786,101 +786,3 @@ test_that("create_download_plot_handler is invoked with all 6 arguments", { } ) }) - -# ============================================================================ -# Tracer constants: the statmodelServer -> generate_analysis_code hop -# ============================================================================ - -test_that("statmodelServer forwards the tracer_constants snapshot to generate_analysis_code", { - captured = new.env(parent = emptyenv()) - captured$code_reactive = NULL - captured$args = NULL - - mockery::stub(statmodelServer, "create_download_handlers", - function(output, data_comparison, SignificantProteins, data_comparison_code) { - captured$code_reactive = data_comparison_code - }) - mockery::stub(statmodelServer, "generate_analysis_code", - function(...) { captured$args = list(...); "# generated\n" }) - - snapshot = list(values = stats::setNames(c(1, 0.9), c("0h", "6h")), - source = CONSTANTS_QC$tracer_source_upload, - file = "constants.csv") - metadata = reactiveVal(NULL) - - testServer( - statmodelServer, - args = list( - parent_session = MockShinySession$new(), - loadpage_input = reactive({ - list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0) - }), - qc_input = reactive({ list(normalization = "equalizeMedians") }), - get_data = reactive({ create_mock_raw_data() }), - preprocess_data = reactive({ create_mock_data("DDA", "protein") }), - app_template = reactive(TEMPLATES$protein_turnover), - condition_metadata = metadata, - tracer_constants = reactive(snapshot) - ), - { - expect_false(is.null(captured$code_reactive), - info = "create_download_handlers must receive the code reactive") - - session$setInputs(!!NAMESPACE_STATMODEL$comparison_mode := - CONSTANTS_STATMODEL$comparison_mode_response_curve) - metadata(data.frame(Condition = c("0h", "6h"), TimeVal = c(0, 6), - stringsAsFactors = FALSE)) - session$setInputs(!!NAMESPACE_STATMODEL$modeling_start := 1) - - captured$code_reactive() - - expect_equal(length(captured$args), 6, - info = "generate_analysis_code must be called with the tracer snapshot appended") - expect_identical(captured$args[[5]], TEMPLATES$protein_turnover) - expect_identical(captured$args[[6]], snapshot, - info = "the snapshot must arrive unwrapped and unmodified") - } - ) -}) - -test_that("statmodelServer defaults the tracer snapshot to NULL when no reactive is supplied", { - captured = new.env(parent = emptyenv()) - captured$code_reactive = NULL - captured$args = NULL - - mockery::stub(statmodelServer, "create_download_handlers", - function(output, data_comparison, SignificantProteins, data_comparison_code) { - captured$code_reactive = data_comparison_code - }) - mockery::stub(statmodelServer, "generate_analysis_code", - function(...) { captured$args = list(...); "# generated\n" }) - - metadata = reactiveVal(NULL) - - testServer( - statmodelServer, - args = list( - parent_session = MockShinySession$new(), - loadpage_input = reactive({ - list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0) - }), - qc_input = reactive({ list(normalization = "equalizeMedians") }), - get_data = reactive({ create_mock_raw_data() }), - preprocess_data = reactive({ create_mock_data("DDA", "protein") }), - app_template = reactive(TEMPLATES$protein_turnover), - condition_metadata = metadata - ), - { - session$setInputs(!!NAMESPACE_STATMODEL$comparison_mode := - CONSTANTS_STATMODEL$comparison_mode_response_curve) - metadata(data.frame(Condition = c("0h", "6h"), TimeVal = c(0, 6), - stringsAsFactors = FALSE)) - session$setInputs(!!NAMESPACE_STATMODEL$modeling_start := 1) - - captured$code_reactive() - - expect_equal(length(captured$args), 6) - expect_null(captured$args[[6]]) - } - ) -}) From c1908e479a6b07e52b2cd80a3265dbfe5a0b8e39 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 10:15:27 -0400 Subject: [PATCH 07/10] remove unnecessary comments --- R/statmodel-server-download-code.R | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 30f9438c..93239b8d 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -23,8 +23,6 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, codes = paste(codes, "library(MSstatsResponse)\n", sep = "") if (isTRUE(app_template == TEMPLATES$protein_turnover)) { - # Resolved here, not at the top of the function: on every other - # template comp_mat is a bare matrix, and `$GROUP` throws on it. if (is.null(tracer_constants)) { tracer_constants = list( values = qc_default_tracer_constants(as.character(comp_mat$GROUP)), @@ -236,9 +234,6 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, conditions <- as.character(comp_mat$GROUP) weighting <- isTRUE(qc_input[[NAMESPACE_QC$assign_feature_weights]]) - # tracer_constants is snapshotted at QC Run, so it can drift from comp_mat - # (rebuilt afterwards from editable condition metadata); an uncovered - # condition must fail loudly rather than emit a silently wrong script. values <- tracer_constants$values if (is.null(values) || length(values) == 0 || is.null(names(values))) { stop("Cannot generate reproducible code: no tracer constants are recorded ", @@ -249,17 +244,12 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, stop("Cannot generate reproducible code: the contrast matrix lists no ", "experimental conditions.") } - # A blank condition name cannot be written as an R argument name - # (`c("" = 1)` is a parse error), so it must be rejected before emitting code. blank_conditions <- is.na(conditions) | !nzchar(trimws(conditions)) if (any(blank_conditions)) { stop("Cannot generate reproducible code: ", sum(blank_conditions), " experimental condition(s) have a blank name. Give every condition a ", "name in the annotation file and load the data again.") } - # Keys are trimmed on both sides, matching qc_resolve_tracer_constants. - # Trimming can collapse two distinct keys onto one, so only flag a repeated - # key whose values actually differ as ambiguous. upload_keys <- trimws(as.character(names(values))) repeated <- unique(upload_keys[duplicated(upload_keys)]) ambiguous <- repeated[vapply(repeated, function(key) { @@ -278,7 +268,6 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, ". Re-run protein summarization on the data-processing page so the ", "constants match the current conditions.") } - # is.finite, not anyNA: Inf would pass an NA check and emit a literal `Inf`. tracer_vals <- suppressWarnings(as.numeric(values[matched])) if (!all(is.finite(tracer_vals))) { bad <- !is.finite(tracer_vals) @@ -287,9 +276,6 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, " is not a finite number.") } - # Keyed by the raw condition name, matching the app (calculateTurnoverRatios - # re-keys via parse_timepoint(names(x))). encodeString() rather than - # paste0-ing quotes, so a quote or backslash in the name still parses. tracer_pairs <- paste0(" ", encodeString(conditions, quote = "\""), " = ", vapply(tracer_vals, format_r_double, character(1)), collapse = ",\n") From c409f288b76186dd733de57d707a625ff0da24ed Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 10:19:18 -0400 Subject: [PATCH 08/10] fix comment in tracer redownloadable code --- R/statmodel-server-download-code.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 93239b8d..eaf2f60c 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -241,7 +241,7 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing, "data-processing page first.") } if (length(conditions) == 0) { - stop("Cannot generate reproducible code: the contrast matrix lists no ", + stop("Cannot generate reproducible code: there are no ", "experimental conditions.") } blank_conditions <- is.na(conditions) | !nzchar(trimws(conditions)) From 67e915757a8a94c0389cee359b08ca2b841b68f2 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 10:23:10 -0400 Subject: [PATCH 09/10] remove unnecessary comments --- R/qc-server-turnover.R | 41 ----------------------------------------- 1 file changed, 41 deletions(-) diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index dc123b7b..18bd23c8 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -12,18 +12,8 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, get_condition_metadata, preprocess_data) { - # ---- Tracer-constants CSV upload (optional; protein turnover only) ---- - # - # Three states: "absent" (no file; every condition gets 1), "rejected" - # (an uploaded file the app cannot honour; blocks Run rather than silently - # falling back to all-1s), and "pending" (upload in flight; also blocks Run). tracer_upload <- reactiveVal(list(state = "absent", values = NULL, file = NULL)) - # The constants that actually produced the displayed ratios, snapshotted at - # the moment of Run. NOT a live view of tracer_upload(): that would let the - # ratios table and the downloadable script disagree about which constants - # were used. NULL means the QC page has not been run in this session, which - # is distinct from "run, and no file was supplied" (source = "none"). tracer_constants_used <- reactiveVal(NULL) get_template <- function() if (is.null(app_template)) NULL else app_template() @@ -35,15 +25,10 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, as.character(meta$Condition) } - # shinyjs::reset() sets the value client-side only and does not dispatch - # "change", so clearing the upload cannot re-arm this handler. shinyjs::onevent("change", NAMESPACE_QC$tracer_constants_file, { tracer_upload(list(state = "pending", values = NULL, file = NULL)) }) - # input[[tracer_constants_file]] keeps its old name/datapath after a - # shinyjs::reset (client-side only), so tracer_upload() is the only - # trustworthy source of the resolved values. observeEvent(input[[NAMESPACE_QC$tracer_constants_clear]], { shinyjs::reset(NAMESPACE_QC$tracer_constants_file) tracer_upload(list(state = "absent", values = NULL, file = NULL)) @@ -52,8 +37,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, type = "message", duration = 6) }, ignoreInit = TRUE) - # A blocking tracer state must not outlive the template it belongs to: the - # tracer panel (and its Clear button) is only shown on protein turnover. observeEvent(get_template(), { if (identical(get_template(), TEMPLATES$protein_turnover)) return() @@ -83,8 +66,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # fread warns (rather than errors) on some malformed rows/files, so - # warnings are captured for reporting but are not relied on for detection. fread_warnings <- character(0) parsed <- withCallingHandlers( tryCatch( @@ -111,8 +92,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # fread keeps duplicate column names and `$` returns the first, so a - # duplicated TracerConstant column would silently use the stale one. duplicated_columns <- unique(colnames(parsed)[duplicated(colnames(parsed))]) if (length(duplicated_columns) > 0) { reject("The tracer constants file has more than one column named: ", @@ -131,10 +110,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, return() } - # A row fread cannot parse is silently dropped rather than erroring. Most - # such cases are still caught below by the group-coverage check; comparing - # counted source rows against parsed rows catches the rest (e.g. a - # duplicate row for a condition another row already covers). source_rows <- tryCatch( sum(nzchar(trimws(readLines(file$datapath, warn = FALSE)))) - 1L, error = function(e) NA_integer_ @@ -198,10 +173,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, type = "message", duration = 6) }) - # condition_metadata is a shared reactiveVal that ordinary actions (e.g. - # re-clicking proceed, uploading a GROUP mapping) can rewrite after a - # tracer upload; a valid upload whose conditions no longer match must be - # invalidated rather than silently reused or left to error later. if (!is.null(get_condition_metadata)) { observeEvent(get_condition_metadata(), { current <- tracer_upload() @@ -219,9 +190,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, }, ignoreInit = TRUE) } - # ---- Tracer panel visibility ---- - # Shown only on protein turnover, and only once data is loaded (or a tracer - # state is already in play, so a bad-upload dead end can still be cleared). observe({ loaded <- tryCatch(get_data(), error = function(e) NULL) shinyjs::toggle( @@ -251,7 +219,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios <- eventReactive(input$run, { - # Cleared up front so any early exit below leaves no stale snapshot. tracer_constants_used(NULL) req(!is.null(app_template) && !is.null(app_template()) && @@ -261,8 +228,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) conditions <- as.character(get_condition_metadata()$Condition) - # Snapshot the upload as it stands at Run; read from tracer_upload() and - # never from input[[tracer_constants_file]] (see the reset note above). upload <- tracer_upload() if (upload$state %in% c("pending", "rejected")) { @@ -329,8 +294,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, ) } - # Committed only once the fit has returned, so a run that fails leaves no - # snapshot behind (matches the clear at the top of this reactive). tracer_constants_used(list( values = tracer_consts, source = if (is.null(uploaded)) CONSTANTS_QC$tracer_source_none @@ -350,10 +313,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios_display <- reactive({ ratios <- turnover_ratios() req(ratios) - - # The snapshot is the authority for "are there ratios on screen"; without - # this guard, switching templates away and back could redraw the table - # from a cached ratios value after its snapshot had been cleared. req(tracer_constants_used()) if (isTRUE(input[[NAMESPACE_QC$assign_feature_weights]]) && nrow(ratios) > 0) { calculatePeptideWeights(ratios) From d9de42e789203a640ed21dafed8b8b87f2017610 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 31 Aug 2026 10:29:39 -0400 Subject: [PATCH 10/10] remove unnecessary comment --- R/qc-server-turnover.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index 18bd23c8..831bd1b9 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -70,8 +70,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, parsed <- withCallingHandlers( tryCatch( data.table::fread(file$datapath, - # An all-numeric GROUP column is otherwise typed - # integer, so "0010" would read back as "10". colClasses = list(character = "GROUP")), error = function(e) { reject("Could not read the tracer constants file: ", conditionMessage(e))