Added synthesis/degradation toggle to turnover response curves

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 {

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)
     }
   }

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."
     }

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 {

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
 # ============================================================================