Merge ratio response for visualization of dose response in Development

R/constants.R

@@ -27,6 +27,7 @@ NAMESPACE_STATMODEL = list(
   visualization_heatmap_number_proteins = "visualization_heatmap_number_proteins",
   visualization_heatmap_cluster_option = "visualization_heatmap_cluster_option", 
   visualization_response_curve_which_drug = "visualization_response_curve_which_drug",
+  visualization_response_curve_ratio_scale = "visualization_response_curve_ratio_scale",
   visualization_view_results = "visualization_view_results", 
   visualization_download_plot_results = "visualization_download_plot_results",
   visualization_plot_output = "visualization_plot_output",

R/module-statmodel-server.R

@@ -230,7 +230,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input,
               data = dia_prepared,
               protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]],
               drug_name = input[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]],
-              ratio_response = TRUE,
+              ratio_response = isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]),
               show_ic50 = TRUE,
               add_ci = TRUE, 
               transform_dose = input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]], 

R/statmodel-ui-options-visualization.R

@@ -104,7 +104,19 @@ create_heatmap_options <- function(ns) {
 create_response_curve_options <- function(ns) {
   tagList(
     uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)),
-    uiOutput(ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug))
+    uiOutput(ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug)),
+    checkboxInput(
+      ns(NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale),
+      label = span(
+        "Use ratio scale",
+        class = "icon-wrapper",
+        icon("question-circle", lib = "font-awesome"),
+        div("When enabled, protein abundances are shown relative to the control (control = 1.0). Useful for chemoproteomic experiments to display fold-change vs. DMSO. Disable for non-chemoproteomic experiments (e.g., time courses) where protein abundance values are more meaningful.",
+            class = "icon-tooltip",
+            style = "max-width: 280px; width: max-content; white-space: normal; line-height: 1.4; text-align: left;")
+      ),
+      value = TRUE
+    )
   )
 }
 
@@ -127,4 +139,4 @@ create_plot_action_buttons <- function(ns) {
     actionButton(ns(NAMESPACE_STATMODEL$visualization_view_results), "View plot in browser (only for one comparison/protein)"),
     downloadButton(ns(NAMESPACE_STATMODEL$visualization_download_plot_results), "Save plot results as Zip")
   )
-}
+}

tests/testthat/test-module-statmodel-server.R

@@ -584,4 +584,53 @@ test_that("handles empty comparison list correctly", {
       expect_null(comp_list$dList)
     }
   )
+})
+
+# ============================================================================
+# RESPONSE CURVE RATIO SCALE CHECKBOX TESTS
+# ============================================================================
+
+test_that("Ratio scale checkbox input can be toggled", {
+  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")
+      })
+    ),
+    {
+      # Set ratio scale checkbox to TRUE
+      session$setInputs(
+        !!NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale := TRUE
+      )
+      expect_true(
+        isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]),
+        info = "ratio_response should be TRUE when checkbox is checked"
+      )
+
+      # Set ratio scale checkbox to FALSE
+      session$setInputs(
+        !!NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale := FALSE
+      )
+      expect_false(
+        isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]),
+        info = "ratio_response should be FALSE when checkbox is unchecked"
+      )
+    }
+  )
 })

tests/testthat/test-module-statmodel-ui.R

@@ -211,4 +211,48 @@ test_that("Informative messages are present", {
 
   expect_true(grepl("Please add a comparison matrix before modeling", ui_html),
               info = "Matrix requirement message should be present")
+})
+
+# ============================================================================
+# 12. RESPONSE CURVE RATIO SCALE CHECKBOX TESTS
+# ============================================================================
+
+test_that("Response curve ratio scale checkbox is present in response curve options", {
+  ui <- MSstatsShiny:::create_response_curve_options(shiny::NS("test"))
+  ui_html <- htmltools::renderTags(ui)$html
+
+  expect_true(grepl("Use ratio scale", ui_html),
+              info = "Ratio scale checkbox label should be present")
+  expect_true(grepl(MSstatsShiny:::NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale, ui_html),
+              info = "Ratio scale checkbox input ID should be present")
+})
+
+test_that("Response curve ratio scale checkbox has tooltip", {
+  ui <- MSstatsShiny:::create_response_curve_options(shiny::NS("test"))
+  ui_html <- htmltools::renderTags(ui)$html
+
+  expect_true(grepl("icon-tooltip", ui_html),
+              info = "Tooltip class should be present")
+  expect_true(grepl("fa-circle-question|question-circle", ui_html),
+              info = "Question mark icon should be present")
+  expect_true(grepl("protein abundances are shown relative to the control", ui_html),
+              info = "Tooltip text should describe ratio scale")
+  expect_true(grepl("chemoproteomic", ui_html),
+              info = "Tooltip text should mention chemoproteomic experiments")
+})
+
+test_that("Response curve ratio scale checkbox is checked by default", {
+  ui <- MSstatsShiny:::create_response_curve_options(shiny::NS("test"))
+  ui_html <- htmltools::renderTags(ui)$html
+
+  # Check for the value = TRUE in the checkbox definition
+  ratio_scale_id <- paste0("test-",
+    MSstatsShiny:::NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale)
+  expect_true(
+    grepl(
+      paste0('id="', ratio_scale_id, '"[^>]*checked|checked[^>]*id="', ratio_scale_id, '"'),
+      ui_html
+    ),
+    info = "Ratio scale checkbox should be checked by default"
+  )
 })