diff --git a/R/constants.R b/R/constants.R index 4900342..12c8454 100644 --- a/R/constants.R +++ b/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", diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 3b91112..0881e62 100644 --- a/R/module-statmodel-server.R +++ b/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]], diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 01609d5..ba68fd9 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/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") ) -} \ No newline at end of file +} diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index a6d9d24..a40f2d8 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/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" + ) + } + ) }) \ No newline at end of file diff --git a/tests/testthat/test-module-statmodel-ui.R b/tests/testthat/test-module-statmodel-ui.R index 7413436..45ad295 100644 --- a/tests/testthat/test-module-statmodel-ui.R +++ b/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" + ) }) \ No newline at end of file