From 1e7e86b47af756c944f3003108db63d936550b4c Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 20 Jul 2026 15:15:43 -0400 Subject: [PATCH 1/7] feat(turnover): Add peptide weighting feature for protein turnover --- NAMESPACE | 1 + R/MSstatsShiny.R | 2 +- R/constants.R | 3 + R/module-qc-ui.R | 42 ++++++-- R/module-statmodel-server.R | 5 + R/qc-server-sidebar.R | 31 ++++++ R/qc-server-turnover.R | 23 +++- R/statmodel-server-comparisons.R | 14 ++- R/statmodel-server-download-code.R | 124 ++++++++++++++++++++++ R/statmodel-server-visualization.R | 3 + man/get_download_plot_filename.Rd | 17 --- man/loadpageServer.Rd | 27 ++++- tests/testthat/test-module-turnover.R | 110 +++++++++++++++++++ tests/testthat/test-qc-server-rendering.R | 18 ++++ 14 files changed, 385 insertions(+), 35 deletions(-) delete mode 100644 man/get_download_plot_filename.Rd diff --git a/NAMESPACE b/NAMESPACE index 51808bae..b9f40aac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ importFrom(MSstatsPTM,SkylinetoMSstatsPTMFormat) importFrom(MSstatsPTM,SpectronauttoMSstatsPTMFormat) importFrom(MSstatsPTM,dataProcessPlotsPTM) importFrom(MSstatsPTM,groupComparisonPlotsPTM) +importFrom(MSstatsResponse,calculatePeptideWeights) importFrom(MSstatsResponse,calculateTurnoverRatios) importFrom(MSstatsResponse,doseResponseFit) importFrom(MSstatsResponse,futureExperimentSimulation) diff --git a/R/MSstatsShiny.R b/R/MSstatsShiny.R index e4ef1eb6..9d0ff37a 100644 --- a/R/MSstatsShiny.R +++ b/R/MSstatsShiny.R @@ -38,7 +38,7 @@ #' @importFrom MSstats MSstatsQualityMetricsPlot #' @importFrom MSstatsPTM dataProcessPlotsPTM groupComparisonPlotsPTM MaxQtoMSstatsPTMFormat PDtoMSstatsPTMFormat FragPipetoMSstatsPTMFormat SkylinetoMSstatsPTMFormat MetamorpheusToMSstatsPTMFormat SpectronauttoMSstatsPTMFormat #' @importFrom MSstatsBioNet exportNetworkToHTML deleteEdgeFromNetwork -#' @importFrom MSstatsResponse futureExperimentSimulation run_tpr_simulation plot_tpr_power_curve calculateTurnoverRatios +#' @importFrom MSstatsResponse futureExperimentSimulation run_tpr_simulation plot_tpr_power_curve calculateTurnoverRatios calculatePeptideWeights #' @importFrom utils capture.output head packageVersion write.csv #' @importFrom stats aggregate #' @importFrom methods is diff --git a/R/constants.R b/R/constants.R index dc7d5301..6d6dae90 100644 --- a/R/constants.R +++ b/R/constants.R @@ -146,6 +146,7 @@ NAMESPACE_QC = list( reference_norm = "reference_norm", remove_norm_channel = "remove_norm_channel", features_used = "features_used", + assign_feature_weights = "assign_feature_weights", n_feat = "n_feat", cens_int = "censInt", null1 = "null1", @@ -175,6 +176,8 @@ NAMESPACE_QC = list( standards_type_section = "standards_type_section", reference_norm_panel = "reference_norm_panel", lf_options_panel = "lf_options_panel", + feature_subset_panel = "feature_subset_panel", + feature_weights_panel = "feature_weights_panel", features_topn_panel = "features_topn_panel", censoring_section = "censoring_section", mbi_panel = "mbi_panel", diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index 76093af6..894ef4e0 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -106,17 +106,39 @@ qcUI <- function(id) { # features #h4("Used features"), - radioButtons(ns("features_used"), - label = h4("Feature subset",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), - div("What features to use in \ - summarization. All features or a subset of \ - features can be used.", class = "icon-tooltip")), - c("Use all features" = "all", "Use top N features" = "topN", - "Remove uninformative features & outliers" = "highQuality")), - #), + # Feature subset picker: shown for every label-free workflow except the + # protein-turnover template, which always summarizes on all features and + # instead exposes the feature-weighting checkbox below. + div( + id = ns(NAMESPACE_QC$feature_subset_panel), + radioButtons(ns("features_used"), + label = h4("Feature subset",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + div("What features to use in \ + summarization. All features or a subset of \ + features can be used.", class = "icon-tooltip")), + c("Use all features" = "all", "Use top N features" = "topN", + "Remove uninformative features & outliers" = "highQuality")), + #), + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$features_topn_panel), + uiOutput(ns("features")) + )) + ), + # Feature weighting: protein-turnover template only. When checked, the + # Turnover Ratios tab adds per-peptide quality-weight columns from + # MSstatsResponse::calculatePeptideWeights. shinyjs::hidden(div( - id = ns(NAMESPACE_QC$features_topn_panel), - uiOutput(ns("features")) + id = ns(NAMESPACE_QC$feature_weights_panel), + checkboxInput( + ns(NAMESPACE_QC$assign_feature_weights), + label = h4("Assign feature weights", class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Compute per-peptide quality weights (coverage, \ + intensity, monotonicity, validity) and add them as \ + extra columns to the Turnover Ratios table.", + class = "icon-tooltip")), + value = FALSE + ) )), #uiOutput("features"), tags$hr(), diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 208f3642..51b92baf 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -362,8 +362,10 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ratios <- turnover_ratios() increasing <- isTRUE(input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]) dia_prepared <- prepare_turnover_for_dose_response(ratios, increasing = increasing) + turnover_weights <- if ("weight" %in% colnames(dia_prepared)) dia_prepared$weight else NULL response_results <- doseResponseFit( data = dia_prepared, + weights = turnover_weights, increasing = increasing, transform_dose = FALSE, ratio_response = FALSE, @@ -476,6 +478,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, req(turnover_ratios()) increasing <- isTRUE(input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]) dia_prepared <- prepare_turnover_for_dose_response(turnover_ratios(), add_zero_timepoint = TRUE, increasing = increasing) + turnover_weights <- if ("weight" %in% colnames(dia_prepared)) dia_prepared$weight else NULL } else { meta <- condition_metadata() req(!is.null(meta) && "DoseVal" %in% colnames(meta)) @@ -496,6 +499,8 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data = dia_prepared, protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]], drug_name = "time", + weights = turnover_weights, + show_weights = !is.null(turnover_weights), ratio_response = FALSE, show_ic50 = TRUE, add_ci = FALSE, diff --git a/R/qc-server-sidebar.R b/R/qc-server-sidebar.R index 52a77065..ba069309 100644 --- a/R/qc-server-sidebar.R +++ b/R/qc-server-sidebar.R @@ -55,6 +55,19 @@ qc_show_log_section <- function(dda_dia, bio, template) { qc_show_lf(dda_dia, bio) && !isTRUE(template == TEMPLATES$protein_turnover) } +#' Show the feature-subset radio: label-free branch, but hidden for the +#' protein-turnover template (which always summarizes on all features). +#' @noRd +qc_show_feature_subset <- function(dda_dia, bio, template) { + qc_show_lf(dda_dia, bio) && !isTRUE(template == TEMPLATES$protein_turnover) +} + +#' Show the feature-weighting checkbox: protein-turnover template only. +#' @noRd +qc_show_feature_weights <- function(template) { + isTRUE(template == TEMPLATES$protein_turnover) +} + #' Show the profile-plot options (summary toggle, feature legend). #' @noRd qc_show_profileplot_options <- function(type1) { @@ -175,6 +188,24 @@ register_qc_visibility_observers <- function(input, session, loadpage_input, app ) }) + # Feature-subset radio vs feature-weighting checkbox. The turnover template + # summarizes on all features, so it hides the subset radio and shows the + # weighting checkbox instead. + observe({ + shinyjs::toggle( + NAMESPACE_QC$feature_subset_panel, + condition = qc_show_feature_subset( + loadpage_input()$DDA_DIA, loadpage_input()$BIO, app_template() + ) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$feature_weights_panel, + condition = qc_show_feature_weights(app_template()) + ) + }) + # Plot-tab option panels. observe({ shinyjs::toggle( diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index 56e81bae..f7040639 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -91,6 +91,21 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios() }, ignoreInit = TRUE) + # When "Assign feature weights" is checked, augment the ratios with the + # per-peptide quality-weight columns from calculatePeptideWeights (coverage, + # light-intensity, monotonicity, validity, and the combined weight). Kept in a + # separate reactive so toggling the checkbox updates the table and download + # without re-running summarization. + turnover_ratios_display <- reactive({ + ratios <- turnover_ratios() + req(ratios) + if (isTRUE(input[[NAMESPACE_QC$assign_feature_weights]]) && nrow(ratios) > 0) { + calculatePeptideWeights(ratios) + } else { + ratios + } + }) + output$turnover_ratios_panel <- renderUI({ req(!is.null(app_template) && !is.null(app_template()) && app_template() == TEMPLATES$protein_turnover) @@ -106,14 +121,14 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, }) output$turnover_ratios_table_ui <- renderUI({ - req(turnover_ratios()) + req(turnover_ratios_display()) ns <- session$ns enable("download_turnover_ratios") dataTableOutput(ns("turnover_ratios_table")) }) output$turnover_ratios_table <- renderDataTable({ - turnover_ratios() + turnover_ratios_display() }) output$download_turnover_ratios <- downloadHandler( @@ -121,9 +136,9 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, paste0("Turnover_Ratios-", Sys.Date(), ".csv") }, content = function(file) { - write.csv(turnover_ratios(), file, row.names = FALSE) + write.csv(turnover_ratios_display(), file, row.names = FALSE) } ) - turnover_ratios + turnover_ratios_display } diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 2f9e7788..1bc59f2e 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -366,7 +366,7 @@ build_all_pair_contrast = function(input, condition_list, contrast, comp_list, r #' @param ratios Data frame from calculateTurnoverRatios (Protein, GROUP, #' H_frac and L_frac columns required). #' @param add_zero_timepoint If TRUE, inserts a synthetic dose=0 / response=0 -#' row for any (protein[, BaseSequence]) group missing one. +#' row for any group missing one. #' @param increasing If TRUE (default), models synthesis from H_frac #' (increasing trend over time). If FALSE, models degradation from L_frac #' (decreasing trend over time). @@ -383,6 +383,13 @@ prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALS if ("BaseSequence" %in% colnames(result)) { keep_cols <- c(keep_cols, "BaseSequence") } + # Carry per-peptide quality weights through when present (added by + # calculatePeptideWeights) so they can be passed to doseResponseFit / + # visualizeResponseProtein via their `weights` argument, row-aligned with + # the returned data frame. + if ("weight" %in% colnames(result)) { + keep_cols <- c(keep_cols, "weight") + } result <- result[, keep_cols] if (add_zero_timepoint) { @@ -403,6 +410,11 @@ prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALS # Synthesis (H_frac): heavy fraction is 0 at t=0 (no incorporation yet). # Degradation (L_frac): light fraction is 1 at t=0 (pre-existing pool intact). zero_rows$response <- if (isTRUE(increasing)) 0 else 1 + # Synthetic anchor points are a known biological constraint, not a noisy + # measurement, so they are fully trusted (weight 1). + if ("weight" %in% keep_cols) { + zero_rows$weight <- 1 + } result <- rbind(zero_rows[, keep_cols], result) } } diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index e783c43d..e95dbdb9 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -13,6 +13,14 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app codes = paste(codes, "\n# Set up dose response analysis\n", sep = "") codes = paste(codes, "library(MSstatsResponse)\n", sep = "") + # Protein turnover reproduces a distinct pipeline: turnover-ratio + # calculation, optional per-peptide weighting, then a weighted fit / + # visualization. The generic protein-level path below does not apply. + if (isTRUE(app_template == TEMPLATES$protein_turnover)) { + codes = paste(codes, build_turnover_analysis_code(qc_input, comp_mat, increasing), sep = "") + return(codes) + } + # Serialize the contrast matrix as a data frame codes = paste(codes, "group_metadata = data.frame(\n", sep = "") codes = paste(codes, " GROUP = c(\"", paste(comp_mat$GROUP, collapse = "\",\""), "\"),\n", sep = "") @@ -148,4 +156,120 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app } return(codes) +} + + +#' 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 +#' "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 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. +#' @return A character scalar of R code, appended after `library(MSstatsResponse)`. +#' @noRd +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]]) + + # 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") + + code <- paste0( + "\n# Tracer constants entered per condition on the data-processing page\n", + "tracer_constants = c(\n", tracer_pairs, "\n)\n", + + "\n# Calculate turnover (Heavy/Light) ratios. Use protein-level data when any\n", + "# condition has replicate runs; otherwise fall back to feature-level data.\n", + "pld = summarized$ProteinLevelData\n", + "samples_per_condition = tapply(pld$RUN, pld$GROUP, function(x) length(unique(x)))\n", + "if (any(samples_per_condition > 1)) {\n", + " turnover_ratios = calculateTurnoverRatios(\n", + " summarized$ProteinLevelData,\n", + " channel_col = \"LABEL\", heavy_label = \"H\", light_label = \"L\",\n", + " time_col = \"GROUP\", peptide_col = \"Protein\", protein_col = \"Protein\",\n", + " intensity_col = \"LogIntensities\", run_col = \"RUN\",\n", + " agg_function = max, normalize_tracer = TRUE, tracer_constants = tracer_constants)\n", + "} else {\n", + " turnover_ratios = calculateTurnoverRatios(\n", + " summarized$FeatureLevelData,\n", + " channel_col = \"LABEL\", heavy_label = \"H\", light_label = \"L\",\n", + " time_col = \"GROUP\", peptide_col = \"PEPTIDE\", protein_col = \"PROTEIN\",\n", + " intensity_col = \"INTENSITY\", run_col = \"RUN\",\n", + " agg_function = max, normalize_tracer = TRUE, tracer_constants = tracer_constants)\n", + "}\n" + ) + + if (weighting) { + code <- paste0( + code, + "\n# Assign per-peptide quality weights (coverage, intensity, monotonicity,\n", + "# validity). Adds a 'weight' column used to down-weight low-quality peptides.\n", + "turnover_ratios = calculatePeptideWeights(turnover_ratios)\n" + ) + } + + # Column mapping matches prepare_turnover_for_dose_response(). Real turnover + # designs include a 0hr baseline, so no synthetic t=0 anchor is needed here. + frac_col <- if (isTRUE(increasing)) "H_frac" else "L_frac" + keep_cols <- if (weighting) { + "c(\"protein\", \"drug\", \"dose\", \"response\", \"BaseSequence\", \"weight\")" + } else { + "c(\"protein\", \"drug\", \"dose\", \"response\", \"BaseSequence\")" + } + + code <- paste0( + code, + "\n# Map columns to the dose-response format\n", + "frac_col = \"", frac_col, "\"\n", + "prepared_data = turnover_ratios[!is.na(turnover_ratios[[frac_col]]), ]\n", + "prepared_data$protein = as.character(prepared_data$Protein)\n", + "prepared_data$drug = \"time\"\n", + "prepared_data$dose = as.numeric(prepared_data$TimeVal)\n", + "prepared_data$response = prepared_data[[frac_col]]\n", + "prepared_data = prepared_data[, ", keep_cols, "]\n" + ) + + weights_arg <- if (weighting) " weights = prepared_data$weight,\n" else "" + + code <- paste0( + code, + "\n# Fit turnover time-course curves\n", + "response_results = doseResponseFit(\n", + " data = prepared_data,\n", + weights_arg, + " increasing = ", increasing, ",\n", + " transform_dose = FALSE,\n", + " ratio_response = FALSE,\n", + " precalculated_ratios = TRUE\n)\n", + + "\n# Visualize a single protein's turnover curve\n", + "visualizeResponseProtein(\n", + " data = prepared_data,\n", + " protein_name = \"Enter protein name here\",\n", + " drug_name = \"time\",\n", + if (weighting) " weights = prepared_data$weight,\n show_weights = TRUE,\n" else "", + " ratio_response = FALSE,\n", + " show_ic50 = TRUE,\n", + " add_ci = FALSE,\n", + " transform_dose = FALSE,\n", + " n_samples = 1000,\n", + " increasing = ", increasing, ",\n", + " precalculated_ratios = TRUE,\n", + " color_by = \"BaseSequence\",\n", + " target_response = 0.5\n)\n" + ) + + code } \ No newline at end of file diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 8416a3c6..66384649 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -238,6 +238,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat } increasing <- isTRUE(input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]) dia_prepared <- prepare_turnover_for_dose_response(ratios, add_zero_timepoint = TRUE, increasing = increasing) + turnover_weights <- if ("weight" %in% colnames(dia_prepared)) dia_prepared$weight else NULL } else { if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { meta <- tryCatch(condition_metadata(), error = function(e) NULL) @@ -260,6 +261,8 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat data = dia_prepared, protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]], drug_name = "time", + weights = turnover_weights, + show_weights = !is.null(turnover_weights), ratio_response = FALSE, show_ic50 = TRUE, add_ci = FALSE, diff --git a/man/get_download_plot_filename.Rd b/man/get_download_plot_filename.Rd deleted file mode 100644 index 57cbbea8..00000000 --- a/man/get_download_plot_filename.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/statmodel-server-visualization.R -\name{get_download_plot_filename} -\alias{get_download_plot_filename} -\title{Get filename for plot download based on plot type} -\usage{ -get_download_plot_filename(plot_type) -} -\arguments{ -\item{plot_type}{the current plot type string} -} -\value{ -filename string ending in .zip -} -\description{ -Get filename for plot download based on plot type -} diff --git a/man/loadpageServer.Rd b/man/loadpageServer.Rd index d0bae842..99e726a3 100644 --- a/man/loadpageServer.Rd +++ b/man/loadpageServer.Rd @@ -12,13 +12,36 @@ loadpageServer(id, parent_session, is_web_server = FALSE, app_template = NULL) \item{parent_session}{session of the main calling module} \item{is_web_server}{boolean indicating if the app is running on a web server} + +\item{app_template}{reactive (or NULL) returning the selected template} } \value{ input object with user selected options } \description{ -This function sets up the loadpage server where it consists of several, -options for users to select and upload files. +This function sets up the loadpage server where it consists of several +options for users to select and upload files. After the Phase 2 split, +the orchestrator below keeps only: +} +\details{ +\itemize{ +\item the module signature and \code{condition_metadata} reactiveVal, +\item the shinyFiles browser block (it produces the +\code{local_big_file_path} / \code{local_big_diann_path} reactives that the +proceed-validation helper consumes, so it must remain co-located +with the module's reactive scope), +\item the six helper registrations in order +(\code{register_loadpage_preview}, +\code{register_loadpage_visibility_observers}, +\code{register_loadpage_converter_ui}, +\code{register_loadpage_proceed_validation}, +\code{register_loadpage_data_loaders}, +\code{register_loadpage_summary}), +\item the final public \code{return(list(input, getData, getConditionMetadata))}. +} + +Each helper lives in its own file (\verb{R/loadpage-server-*.R}); see those +files for the moved code blocks. } \examples{ NA diff --git a/tests/testthat/test-module-turnover.R b/tests/testthat/test-module-turnover.R index 926f68c4..e20fd58b 100644 --- a/tests/testthat/test-module-turnover.R +++ b/tests/testthat/test-module-turnover.R @@ -234,6 +234,62 @@ test_that("prepare_turnover_for_dose_response drops NA on the selected fraction info = "degradation: drops the row with NA L_frac") }) +# ============================================================================ +# Tests for per-peptide weight passthrough (calculatePeptideWeights -> fit) +# ============================================================================ + +test_that("prepare_turnover_for_dose_response carries the weight column when present", { + ratios <- data.frame( + Protein = c("ProtA", "ProtA"), + TimeVal = c(1, 2), + H_frac = c(0.3, 0.6), + L_frac = c(0.7, 0.4), + weight = c(0.5, 0.9), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios) + + expect_true("weight" %in% colnames(result), + info = "weight column should be preserved for the fit's weights argument") + expect_equal(result$weight, c(0.5, 0.9), + info = "weights should stay row-aligned with the prepared data") +}) + +test_that("prepare_turnover_for_dose_response omits weight column when absent", { + ratios <- data.frame( + Protein = c("ProtA", "ProtA"), + TimeVal = c(1, 2), + H_frac = c(0.3, 0.6), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios) + + expect_false("weight" %in% colnames(result), + info = "no weight column should appear when the input has none") +}) + +test_that("prepare_turnover_for_dose_response assigns weight 1 to synthetic zero rows", { + ratios <- data.frame( + Protein = c("ProtA", "ProtA"), + TimeVal = c(2, 4), + H_frac = c(0.3, 0.6), + L_frac = c(0.7, 0.4), + weight = c(0.5, 0.9), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response( + ratios, add_zero_timepoint = TRUE, increasing = TRUE + ) + + expect_false(any(is.na(result$weight)), + info = "synthetic zero rows must not leave NA weights that misalign the vector") + expect_equal(result$weight[result$dose == 0], 1, + info = "synthetic anchor points are fully trusted (weight 1)") +}) + # ============================================================================ # Tests for get_modeling_section_header with protein_turnover template # ============================================================================ @@ -345,6 +401,60 @@ test_that("generate_analysis_code produces turnover-specific code for protein_tu info = "Turnover code should set target_response = 0.5") expect_true(grepl("visualizeResponseProtein", result), info = "Turnover code should call visualizeResponseProtein") + expect_true(grepl("calculateTurnoverRatios", result, fixed = TRUE), + info = "Turnover code should recompute turnover ratios") +}) + +# ============================================================================ +# Tests for build_turnover_analysis_code (weighted reproducible script) +# ============================================================================ + +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) + has <- function(p) grepl(p, code, fixed = TRUE) + + expect_true(has("calculatePeptideWeights(turnover_ratios)"), + info = "weighted script must add the calculatePeptideWeights step") + expect_true(has("weights = prepared_data$weight"), + info = "weighted script must pass weights to doseResponseFit / visualizeResponseProtein") + expect_true(has("show_weights = TRUE"), + info = "weighted script should scale plot points by weight") + 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") +}) + +test_that("build_turnover_analysis_code omits weighting when the checkbox is disabled", { + comp_mat <- data.frame(GROUP = c("T0h", "T4h"), TimeVal = c(0, 4), + stringsAsFactors = FALSE) + qc_input <- list(assign_feature_weights = FALSE) + + code <- MSstatsShiny:::build_turnover_analysis_code(qc_input, comp_mat, increasing = FALSE) + + expect_false(grepl("calculatePeptideWeights", code, fixed = TRUE), + info = "unweighted script must not compute peptide weights") + expect_false(grepl("weights = prepared_data", code, fixed = TRUE), + info = "unweighted script must not pass a weights argument") + expect_true(grepl("frac_col = \"L_frac\"", code, fixed = TRUE), + info = "increasing = FALSE selects the degradation (L_frac) response") +}) + +test_that("build_turnover_analysis_code emits syntactically valid R", { + comp_mat <- data.frame(GROUP = c("T0h", "T4h", "T8h"), TimeVal = c(0, 4, 8), + stringsAsFactors = FALSE) + for (flag in c(TRUE, FALSE)) { + code <- MSstatsShiny:::build_turnover_analysis_code( + list(assign_feature_weights = flag), comp_mat, increasing = TRUE + ) + expect_silent(parse(text = code)) + } }) test_that("generate_analysis_code does not set precalculated_ratios for chemoproteomics template", { diff --git a/tests/testthat/test-qc-server-rendering.R b/tests/testthat/test-qc-server-rendering.R index 90b393fb..a6202d24 100644 --- a/tests/testthat/test-qc-server-rendering.R +++ b/tests/testthat/test-qc-server-rendering.R @@ -54,6 +54,24 @@ test_that("qc_show_features_topn needs the label-free branch AND the topN subset expect_false(MSstatsShiny:::qc_show_features_topn("LType", "Protein", NULL)) }) +test_that("qc_show_feature_subset shows the subset radio for label-free non-turnover only", { + expect_true(MSstatsShiny:::qc_show_feature_subset("LType", "Protein", TEMPLATES$default)) + expect_true(MSstatsShiny:::qc_show_feature_subset("LType", "Protein", TEMPLATES$chemoproteomics)) + + # Hidden for the turnover template (always summarizes on all features) and off + # the label-free branch entirely. + expect_false(MSstatsShiny:::qc_show_feature_subset("LType", "Protein", TEMPLATES$protein_turnover)) + expect_false(MSstatsShiny:::qc_show_feature_subset("TMT", "Protein", TEMPLATES$default)) +}) + +test_that("qc_show_feature_weights shows the weighting checkbox for the turnover template only", { + expect_true(MSstatsShiny:::qc_show_feature_weights(TEMPLATES$protein_turnover)) + + expect_false(MSstatsShiny:::qc_show_feature_weights(TEMPLATES$default)) + expect_false(MSstatsShiny:::qc_show_feature_weights(TEMPLATES$chemoproteomics)) + expect_false(MSstatsShiny:::qc_show_feature_weights(NULL)) +}) + test_that("qc_show_mbi needs the label-free branch AND a censoring assumption", { expect_true(MSstatsShiny:::qc_show_mbi("LType", "Protein", "NA")) expect_true(MSstatsShiny:::qc_show_mbi("LType", "Protein", "0")) From 4649d7ed3f094f3bb77331d25f5b00f993a09643 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 20 Jul 2026 15:21:14 -0400 Subject: [PATCH 2/7] fix feature weighting component look --- R/module-qc-ui.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index 894ef4e0..cf397f00 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -129,14 +129,15 @@ qcUI <- function(id) { # MSstatsResponse::calculatePeptideWeights. shinyjs::hidden(div( id = ns(NAMESPACE_QC$feature_weights_panel), + h4("Feature Weighting"), checkboxInput( ns(NAMESPACE_QC$assign_feature_weights), - label = h4("Assign feature weights", class = "icon-wrapper", - icon("question-circle", lib = "font-awesome"), - div("Compute per-peptide quality weights (coverage, \ - intensity, monotonicity, validity) and add them as \ - extra columns to the Turnover Ratios table.", - class = "icon-tooltip")), + label = tags$div("Assign feature weights", class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("Compute per-peptide quality weights (coverage, \ + intensity, monotonicity, validity) and add them as \ + extra columns to the Turnover Ratios table.", + class = "icon-tooltip")), value = FALSE ) )), From 4c34d8bfb5b2b378613445d6e62b3a445684b65d Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 20 Jul 2026 15:56:39 -0400 Subject: [PATCH 3/7] make turnover table scrollable --- R/qc-server-turnover.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index f7040639..f4e84011 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -129,7 +129,7 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, output$turnover_ratios_table <- renderDataTable({ turnover_ratios_display() - }) + }, options = list(scrollX = TRUE)) output$download_turnover_ratios <- downloadHandler( filename = function() { From 7b4ef3299469480bd98538763ba88a68ef173535 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 20 Jul 2026 16:14:08 -0400 Subject: [PATCH 4/7] fix docs --- R/module-qc-ui.R | 10 ---------- R/qc-server-sidebar.R | 3 --- R/qc-server-turnover.R | 5 ----- R/statmodel-server-comparisons.R | 8 +------- R/statmodel-server-download-code.R | 3 --- 5 files changed, 1 insertion(+), 28 deletions(-) diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index cf397f00..3d03c86c 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -102,13 +102,6 @@ qcUI <- function(id) { # Feature subset, missing-value handling, imputation and summary method: label-free branch shinyjs::hidden(div( id = ns(NAMESPACE_QC$lf_options_panel), - - # features - - #h4("Used features"), - # Feature subset picker: shown for every label-free workflow except the - # protein-turnover template, which always summarizes on all features and - # instead exposes the feature-weighting checkbox below. div( id = ns(NAMESPACE_QC$feature_subset_panel), radioButtons(ns("features_used"), @@ -124,9 +117,6 @@ qcUI <- function(id) { uiOutput(ns("features")) )) ), - # Feature weighting: protein-turnover template only. When checked, the - # Turnover Ratios tab adds per-peptide quality-weight columns from - # MSstatsResponse::calculatePeptideWeights. shinyjs::hidden(div( id = ns(NAMESPACE_QC$feature_weights_panel), h4("Feature Weighting"), diff --git a/R/qc-server-sidebar.R b/R/qc-server-sidebar.R index ba069309..77f8c4f9 100644 --- a/R/qc-server-sidebar.R +++ b/R/qc-server-sidebar.R @@ -188,9 +188,6 @@ register_qc_visibility_observers <- function(input, session, loadpage_input, app ) }) - # Feature-subset radio vs feature-weighting checkbox. The turnover template - # summarizes on all features, so it hides the subset radio and shows the - # weighting checkbox instead. observe({ shinyjs::toggle( NAMESPACE_QC$feature_subset_panel, diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R index f4e84011..f6dbe727 100644 --- a/R/qc-server-turnover.R +++ b/R/qc-server-turnover.R @@ -91,11 +91,6 @@ register_qc_turnover <- function(input, output, session, app_template, get_data, turnover_ratios() }, ignoreInit = TRUE) - # When "Assign feature weights" is checked, augment the ratios with the - # per-peptide quality-weight columns from calculatePeptideWeights (coverage, - # light-intensity, monotonicity, validity, and the combined weight). Kept in a - # separate reactive so toggling the checkbox updates the table and download - # without re-running summarization. turnover_ratios_display <- reactive({ ratios <- turnover_ratios() req(ratios) diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 1bc59f2e..60a66ee7 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -366,7 +366,7 @@ build_all_pair_contrast = function(input, condition_list, contrast, comp_list, r #' @param ratios Data frame from calculateTurnoverRatios (Protein, GROUP, #' H_frac and L_frac columns required). #' @param add_zero_timepoint If TRUE, inserts a synthetic dose=0 / response=0 -#' row for any group missing one. +#' row for any peptide group missing one. #' @param increasing If TRUE (default), models synthesis from H_frac #' (increasing trend over time). If FALSE, models degradation from L_frac #' (decreasing trend over time). @@ -383,10 +383,6 @@ prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALS if ("BaseSequence" %in% colnames(result)) { keep_cols <- c(keep_cols, "BaseSequence") } - # Carry per-peptide quality weights through when present (added by - # calculatePeptideWeights) so they can be passed to doseResponseFit / - # visualizeResponseProtein via their `weights` argument, row-aligned with - # the returned data frame. if ("weight" %in% colnames(result)) { keep_cols <- c(keep_cols, "weight") } @@ -410,8 +406,6 @@ prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALS # Synthesis (H_frac): heavy fraction is 0 at t=0 (no incorporation yet). # Degradation (L_frac): light fraction is 1 at t=0 (pre-existing pool intact). zero_rows$response <- if (isTRUE(increasing)) 0 else 1 - # Synthetic anchor points are a known biological constraint, not a noisy - # measurement, so they are fully trusted (weight 1). if ("weight" %in% keep_cols) { zero_rows$weight <- 1 } diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index e95dbdb9..994b9bff 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -13,9 +13,6 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app codes = paste(codes, "\n# Set up dose response analysis\n", sep = "") codes = paste(codes, "library(MSstatsResponse)\n", sep = "") - # Protein turnover reproduces a distinct pipeline: turnover-ratio - # calculation, optional per-peptide weighting, then a weighted fit / - # visualization. The generic protein-level path below does not apply. if (isTRUE(app_template == TEMPLATES$protein_turnover)) { codes = paste(codes, build_turnover_analysis_code(qc_input, comp_mat, increasing), sep = "") return(codes) From 3eca89edb9cce9e0740be3ceb8a0e00d91e30c72 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Mon, 20 Jul 2026 17:46:30 -0400 Subject: [PATCH 5/7] remove comment --- R/module-qc-ui.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index 3d03c86c..4c7fd219 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -111,7 +111,6 @@ qcUI <- function(id) { features can be used.", class = "icon-tooltip")), c("Use all features" = "all", "Use top N features" = "topN", "Remove uninformative features & outliers" = "highQuality")), - #), shinyjs::hidden(div( id = ns(NAMESPACE_QC$features_topn_panel), uiOutput(ns("features")) From 6e6db1a5911a4592486fae8ebd34492310c77da1 Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Mon, 20 Jul 2026 17:55:06 -0400 Subject: [PATCH 6/7] Update R/statmodel-server-download-code.R Co-authored-by: coderabbitai[bot] <136622811+coderabbitai[bot]@users.noreply.github.com> --- R/statmodel-server-download-code.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 994b9bff..196dfac8 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -220,7 +220,7 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing) { # Column mapping matches prepare_turnover_for_dose_response(). Real turnover # designs include a 0hr baseline, so no synthetic t=0 anchor is needed here. frac_col <- if (isTRUE(increasing)) "H_frac" else "L_frac" - keep_cols <- if (weighting) { + target_cols <- if (weighting) { "c(\"protein\", \"drug\", \"dose\", \"response\", \"BaseSequence\", \"weight\")" } else { "c(\"protein\", \"drug\", \"dose\", \"response\", \"BaseSequence\")" @@ -235,7 +235,8 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing) { "prepared_data$drug = \"time\"\n", "prepared_data$dose = as.numeric(prepared_data$TimeVal)\n", "prepared_data$response = prepared_data[[frac_col]]\n", - "prepared_data = prepared_data[, ", keep_cols, "]\n" + "keep_cols = intersect(", target_cols, ", colnames(prepared_data))\n", + "prepared_data = prepared_data[, keep_cols, drop = FALSE]\n" ) weights_arg <- if (weighting) " weights = prepared_data$weight,\n" else "" From b96ca2ad585c7091d00f2b7fd177c84c08e5e73e Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Mon, 20 Jul 2026 17:56:06 -0400 Subject: [PATCH 7/7] Update R/statmodel-server-download-code.R Co-authored-by: coderabbitai[bot] <136622811+coderabbitai[bot]@users.noreply.github.com> --- 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 196dfac8..c2e5c051 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -191,7 +191,7 @@ build_turnover_analysis_code <- function(qc_input, comp_mat, increasing) { "# condition has replicate runs; otherwise fall back to feature-level data.\n", "pld = summarized$ProteinLevelData\n", "samples_per_condition = tapply(pld$RUN, pld$GROUP, function(x) length(unique(x)))\n", - "if (any(samples_per_condition > 1)) {\n", + "if (any(samples_per_condition > 1, na.rm = TRUE)) {\n", " turnover_ratios = calculateTurnoverRatios(\n", " summarized$ProteinLevelData,\n", " channel_col = \"LABEL\", heavy_label = \"H\", light_label = \"L\",\n",