diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index bac7a12..7efa844 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -353,10 +353,11 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, } if (app_template() == TEMPLATES$protein_turnover) { ratios <- turnover_ratios() - dia_prepared <- prepare_turnover_for_dose_response(ratios) + increasing <- isTRUE(input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]) + dia_prepared <- prepare_turnover_for_dose_response(ratios, increasing = increasing) response_results <- doseResponseFit( data = dia_prepared, - increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]], + increasing = increasing, transform_dose = FALSE, ratio_response = FALSE, precalculated_ratios = TRUE @@ -466,7 +467,8 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, CONSTANTS_STATMODEL$plot_type_response_curve) { if (app_template() == TEMPLATES$protein_turnover) { req(turnover_ratios()) - dia_prepared <- prepare_turnover_for_dose_response(turnover_ratios(), add_zero_timepoint = TRUE) + 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) } else { meta <- condition_metadata() req(!is.null(meta) && "DoseVal" %in% colnames(meta)) @@ -492,11 +494,11 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, add_ci = FALSE, transform_dose = FALSE, n_samples = 1000, - increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]], + increasing = increasing, precalculated_ratios = TRUE, color_by = "BaseSequence", target_response = 0.5, - y_lab = "relative abundance", + y_lab = "Turnover Ratio", x_lab = "time (hrs)" ) } else { diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index fdef38b..2f9e778 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -364,15 +364,21 @@ build_all_pair_contrast = function(input, condition_list, contrast, comp_list, r #' matrix stored in contrast$matrix as the dose axis. #' #' @param ratios Data frame from calculateTurnoverRatios (Protein, GROUP, -#' H_frac columns required) +#' 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. +#' @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). #' @return Data frame with columns: protein, drug, dose, response #' @noRd -prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALSE) { - result <- ratios[!is.na(ratios$H_frac), ] +prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALSE, increasing = TRUE) { + frac_col <- if (isTRUE(increasing)) "H_frac" else "L_frac" + result <- ratios[!is.na(ratios[[frac_col]]), ] result$protein <- as.character(result$Protein) result$drug <- "time" result$dose <- as.numeric(result$TimeVal) - result$response <- result$H_frac + result$response <- result[[frac_col]] keep_cols <- c("protein", "drug", "dose", "response") if ("BaseSequence" %in% colnames(result)) { keep_cols <- c(keep_cols, "BaseSequence") @@ -394,7 +400,9 @@ prepare_turnover_for_dose_response <- function(ratios, add_zero_timepoint = FALS zero_rows <- needs_zero zero_rows$drug <- "time" zero_rows$dose <- 0 - zero_rows$response <- 0 + # 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 result <- rbind(zero_rows[, keep_cols], result) } } diff --git a/R/statmodel-server-options-modeling.R b/R/statmodel-server-options-modeling.R index c1a8a2e..0c17df2 100644 --- a/R/statmodel-server-options-modeling.R +++ b/R/statmodel-server-options-modeling.R @@ -43,12 +43,12 @@ get_response_curve_fitting_options = function(mode, ns, template = TEMPLATES$def if (!is.null(mode) && mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { is_turnover <- isTRUE(template == TEMPLATES$protein_turnover) label_text <- if (is_turnover) { - "Increasing heavy-isotope incorporation over time" + "Synthesis (heavy-isotope incorporation, increasing)" } else { "Increasing trend for dose-response curves" } tooltip_text <- if (is_turnover) { - "Check this box if you expect the heavy-isotope fraction to increase over time (typical for pulse-chase turnover experiments)." + "Check for synthesis (H_frac, increasing over time). Uncheck for degradation (L_frac, decreasing over time)." } else { "Check this box if you expect an increasing trend in your dose-response curve, e.g. higher doses lead to higher protein abundance. Uncheck if you expect a decreasing trend, e.g. higher doses lead to lower protein abundance." } diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index a2aefbc..2c71c0a 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -221,7 +221,8 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat showNotification("Turnover ratios not yet calculated.", type = "error") return(NULL) } - dia_prepared <- prepare_turnover_for_dose_response(ratios, add_zero_timepoint = TRUE) + increasing <- isTRUE(input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]) + dia_prepared <- prepare_turnover_for_dose_response(ratios, add_zero_timepoint = TRUE, increasing = increasing) } else { if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { meta <- tryCatch(condition_metadata(), error = function(e) NULL) @@ -249,11 +250,11 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat add_ci = FALSE, transform_dose = FALSE, n_samples = 1000, - increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]], + increasing = increasing, precalculated_ratios = TRUE, color_by = "BaseSequence", target_response = 0.5, - y_lab = "relative abundance", + y_lab = "Turnover Ratio", x_lab = "time (hrs)" ) } else { diff --git a/tests/testthat/test-module-turnover.R b/tests/testthat/test-module-turnover.R index fc616b4..926f68c 100644 --- a/tests/testthat/test-module-turnover.R +++ b/tests/testthat/test-module-turnover.R @@ -131,6 +131,109 @@ test_that("prepare_turnover_for_dose_response coerces TimeVal to numeric dose", expect_equal(result$dose, 4) }) +test_that("prepare_turnover_for_dose_response selects H_frac when increasing = TRUE (synthesis)", { + ratios <- data.frame( + Protein = c("ProtA", "ProtB"), + TimeVal = c(1, 2), + H_frac = c(0.3, 0.7), + L_frac = c(0.7, 0.3), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios, increasing = TRUE) + + expect_equal(result$response, c(0.3, 0.7), + info = "increasing = TRUE should map response to H_frac") +}) + +test_that("prepare_turnover_for_dose_response selects L_frac when increasing = FALSE (degradation)", { + ratios <- data.frame( + Protein = c("ProtA", "ProtB"), + TimeVal = c(1, 2), + H_frac = c(0.3, 0.7), + L_frac = c(0.7, 0.3), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios, increasing = FALSE) + + expect_equal(result$response, c(0.7, 0.3), + info = "increasing = FALSE should map response to L_frac (degradation)") +}) + +test_that("prepare_turnover_for_dose_response defaults to H_frac (synthesis) when increasing is unset", { + ratios <- data.frame( + Protein = c("ProtA"), + TimeVal = c(1), + H_frac = c(0.4), + L_frac = c(0.6), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios) + + expect_equal(result$response, 0.4, + info = "default behavior should remain H_frac for backward compatibility") +}) + +test_that("prepare_turnover_for_dose_response zero timepoint is 0 for synthesis", { + 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), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response( + ratios, add_zero_timepoint = TRUE, increasing = TRUE + ) + + zero_row <- result[result$dose == 0, ] + expect_equal(nrow(zero_row), 1, + info = "exactly one synthetic zero-timepoint row added") + expect_equal(zero_row$response, 0, + info = "synthesis: zero timepoint response is 0 (no heavy incorporated yet)") +}) + +test_that("prepare_turnover_for_dose_response zero timepoint is 1 for degradation", { + 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), + stringsAsFactors = FALSE + ) + + result <- MSstatsShiny:::prepare_turnover_for_dose_response( + ratios, add_zero_timepoint = TRUE, increasing = FALSE + ) + + zero_row <- result[result$dose == 0, ] + expect_equal(nrow(zero_row), 1, + info = "exactly one synthetic zero-timepoint row added") + expect_equal(zero_row$response, 1, + info = "degradation: zero timepoint response is 1 (pre-existing light pool intact)") +}) + +test_that("prepare_turnover_for_dose_response drops NA on the selected fraction column", { + ratios <- data.frame( + Protein = c("ProtA", "ProtB", "ProtC"), + TimeVal = c(1, 2, 4), + H_frac = c(0.3, NA, 0.8), + L_frac = c(NA, 0.5, 0.2), + stringsAsFactors = FALSE + ) + + syn <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios, increasing = TRUE) + deg <- MSstatsShiny:::prepare_turnover_for_dose_response(ratios, increasing = FALSE) + + expect_equal(syn$response, c(0.3, 0.8), + info = "synthesis: drops the row with NA H_frac") + expect_equal(deg$response, c(0.5, 0.2), + info = "degradation: drops the row with NA L_frac") +}) + # ============================================================================ # Tests for get_modeling_section_header with protein_turnover template # ============================================================================