Merge the dynamic update of the metadata table and the options panel within Statistical Inference page in Development

R/constants.R

@@ -16,6 +16,7 @@ NAMESPACE_STATMODEL = list(
   modeling_response_curve_increasing_trend = "modeling_response_curve_increasing_trend",
   modeling_response_curve_log_xaxis = "modeling_response_curve_log_xaxis", 
   visualization_plot_options_conditional_panel = "plot_options_conditional_panel",
+  modeling_section_header = "modeling_section_header",
   visualization_plot_type = "visualization_plot_type", 
   visualization_logp_base = "visualization_logp_base", 
   visualization_which_protein = "visualization_which_protein", 

R/module-statmodel-server.R

@@ -62,12 +62,51 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input,
       })
 
       render_group_comparison_plot_inputs(output, session, Rownames, get_data, input, loadpage_input, condition_list,contrast)
+      output[[NAMESPACE_STATMODEL$modeling_section_header]] <- renderUI({
+        get_modeling_section_header(input[[NAMESPACE_STATMODEL$comparison_mode]])
+      })
 
+      # Filter visualization dropdown based on comparison mode
+      observeEvent(input[[NAMESPACE_STATMODEL$comparison_mode]], {
+        req(input[[NAMESPACE_STATMODEL$comparison_mode]])
+        mode <- input[[NAMESPACE_STATMODEL$comparison_mode]]
+        if (mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) {
+          updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type,
+            choices = c("Dose Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve)
+          )
+        } else {
+          updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type,
+            choices = c(
+              "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot,
+              "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap,
+              "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot
+            )
+          )
+        }
+      }, ignoreInit = TRUE)
+
       # Reset on configuration change
       observeEvent(c(input[[NAMESPACE_STATMODEL$comparison_mode]], loadpage_input()$proceed1), {
         contrast$matrix = NULL
         comp_list$dList = NULL
         significant$result = NULL
+
+        # Auto-build response curve metadata when dose response mode is selected
+        if (isTRUE(input[[NAMESPACE_STATMODEL$comparison_mode]] == 
+            CONSTANTS_STATMODEL$comparison_mode_response_curve)) {
+          tryCatch({
+            rc_matrix <- build_response_curve_matrix(condition_list())
+            if (is.null(rc_matrix) || nrow(rc_matrix) == 0) {
+              stop("Unable to auto-build group metadata from the current conditions.")
+            }
+            contrast$matrix <- rc_matrix
+            enable(NAMESPACE_STATMODEL$modeling_start)
+          }, error = function(e) {
+            contrast$matrix <- NULL
+            disable(NAMESPACE_STATMODEL$modeling_start)
+            showNotification(conditionMessage(e), type = "error", duration = 6)
+          })
+        }
       })
 
       # Validate contrast inputs
@@ -176,13 +215,17 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input,
 
       output$matrix = renderUI({
         ns = session$ns
+        mode = input[[NAMESPACE_STATMODEL$comparison_mode]]
+        matrix_title = if (isTRUE(mode == CONSTANTS_STATMODEL$comparison_mode_response_curve)) {
+          "Group Metadata"
+        } else {
+          "Comparison matrix"
+        }
         tagList(
-          # CSS rule to ensure text in editable cells is always black.
-          # This overrides conflicting styles that may turn the text white during editing.
           tags$head(tags$style(HTML(
             "table.dataTable td input { color: black !important; }"
           ))),
-          h2("Comparison matrix"),
+          h2(matrix_title),
           p(tags$i("This table is interactive. Click values to edit.")),
           if (!is.null(input[[NAMESPACE_STATMODEL$comparison_mode]]) &&
               input[[NAMESPACE_STATMODEL$comparison_mode]] %in% c(

R/statmodel-server-options-modeling.R

@@ -10,6 +10,25 @@ get_tmt_moderation_radio_button = function(loadpage_input, ns) {
   }
 }
 
+#' Get modeling section header based on comparison mode
+#'
+#' @param mode Character. The current comparison mode.
+#' @return A tagList with the appropriate heading and description.
+#' @noRd
+get_modeling_section_header <- function(mode) {
+  if (isTRUE(mode == CONSTANTS_STATMODEL$comparison_mode_response_curve)) {
+    tagList(
+      h4("2. Dose response analysis"),
+      p("Please configure the mapping between experimental groups and treatment concentrations.")
+    )
+  } else {
+    tagList(
+      h4("2. Group comparison"),
+      p("Please add a comparison matrix before modeling.")
+    )
+  }
+}
+
 #' Get response curve fitting options conditioned on if contrast mode is response curve
 #' @noRd
 get_response_curve_fitting_options = function(mode, ns) {

R/statmodel-ui-comparisons.R

@@ -85,8 +85,6 @@ build_custom_nonpairwise_panel <- function(ns) {
 #' @noRd
 build_response_curve_panel <- function(ns) {
   tagList(
-    h5("Set up response curve configuration:"),
-    actionButton(ns(NAMESPACE_STATMODEL$comparisons_submit), "Setup Metadata"),
     actionButton(ns(NAMESPACE_STATMODEL$comparisons_clear), "Reset")
   )
 }

R/statmodel-ui-options-modeling.R

@@ -7,8 +7,7 @@
 #' @noRd
 create_modeling_section <- function(ns) {
   tagList(
-    h4("2. Group comparison"),
-    p("Please add a comparison matrix before modeling."),
+    uiOutput(ns(NAMESPACE_STATMODEL$modeling_section_header)),
     disabled(actionButton(ns(NAMESPACE_STATMODEL$modeling_start), "Start")),
     tags$hr(),
     uiOutput(ns(NAMESPACE_STATMODEL$modeling_response_curve_fitting_options)),

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

@@ -11,24 +11,23 @@ test_that("UI components appear in correct order", {
   ui <- create_test_ui()
   ui_html <- htmltools::renderTags(ui)$html
 
-  # Extract positions of key elements
   pos_contrast <- regexpr("1\\. Define comparisons", ui_html)
-  pos_group_comp <- regexpr("2\\. Group comparison", ui_html)
+  pos_modeling <- regexpr(NAMESPACE_STATMODEL$modeling_section_header, ui_html)
   pos_viz <- regexpr("3\\. Visualization", ui_html)
 
-  # Verify order
-  expect_true(pos_contrast < pos_group_comp,
-              info = "Contrast matrix section should appear before group comparison")
-  expect_true(pos_group_comp < pos_viz,
-              info = "Group comparison should appear before visualization")
+  expect_true(pos_contrast < pos_modeling,
+              info = "Contrast matrix section should appear before modeling section")
+  expect_true(pos_modeling < pos_viz,
+              info = "Modeling section should appear before visualization")
 })
 
 test_that("Side panel contains all three main sections", {
   ui <- create_test_ui()
   ui_html <- htmltools::renderTags(ui)$html
 
   expect_true(grepl("1\\. Define comparisons", ui_html))
-  expect_true(grepl("2\\. Group comparison", ui_html))
+  expect_true(grepl(NAMESPACE_STATMODEL$modeling_section_header, ui_html),
+              info = "Modeling section header placeholder should be present")
   expect_true(grepl("3\\. Visualization", ui_html))
 })
 
@@ -209,8 +208,8 @@ test_that("Informative messages are present", {
   ui <- create_test_ui()
   ui_html <- htmltools::renderTags(ui)$html
 
-  expect_true(grepl("Please add a comparison matrix before modeling", ui_html),
-              info = "Matrix requirement message should be present")
+  expect_true(grepl(NAMESPACE_STATMODEL$modeling_section_header, ui_html),
+              info = "Modeling section header output should be present")
 })
 
 # ============================================================================

tests/testthat/test-statmodel-ui-options-contrasts.R

@@ -58,9 +58,22 @@ test_that("build_response_curve_panel creates correct UI structure", {
   ns <- function(id) paste0("statmodel-", id)
   ui <- build_response_curve_panel(ns)
   html <- as.character(ui)
-  expect_true(grepl("<h5>Set up response curve configuration:</h5>", html, fixed = TRUE))
-  expect_true(grepl(NAMESPACE_STATMODEL$comparisons_submit, html, fixed = TRUE))
+  # Setup Metadata button removed. Metadata auto-builds on radio selection
+  expect_false(grepl(NAMESPACE_STATMODEL$comparisons_submit, html, fixed = TRUE),
+               info = "Submit contrast matrix button should not be present")
   expect_true(grepl(NAMESPACE_STATMODEL$comparisons_clear, html, fixed = TRUE))
   expect_s3_class(ui, "shiny.tag.list")
-  expect_length(ui, 3)
+  expect_length(ui, 1)
+})
+
+# ============================================================================
+# DYNAMIC HEADING AND DROPDOWN TESTS
+# ============================================================================
+
+test_that("modeling section header placeholder exists in UI", {
+  ui <- MSstatsShiny::statmodelUI("statmodel")
+  ui_html <- htmltools::renderTags(ui)$html
+
+  expect_true(grepl(NAMESPACE_STATMODEL$modeling_section_header, ui_html),
+              info = "Modeling section header uiOutput placeholder should be present")
 })

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

@@ -595,4 +595,44 @@ test_that("generate_analysis_code produces groupComparisonTMT for TMT", {
 
   expect_true(grepl("groupComparisonTMT", result))
   expect_false(grepl("doseResponseFit", result))
+})
+
+# ============================================================================
+# MODELING SECTION HEADER TESTS
+# ============================================================================
+
+test_that("get_modeling_section_header returns dose response heading for response curve mode", {
+  result <- MSstatsShiny:::get_modeling_section_header(
+    CONSTANTS_STATMODEL$comparison_mode_response_curve
+  )
+  html <- as.character(result)
+  expect_true(grepl("Dose response analysis", html),
+              info = "Should show dose response heading")
+  expect_true(grepl("configure the mapping", html),
+              info = "Should show dose response description")
+  expect_false(grepl("Group comparison", html),
+               info = "Should not show group comparison heading")
+})
+
+test_that("get_modeling_section_header returns group comparison heading for other modes", {
+  for (mode in c(
+    CONSTANTS_STATMODEL$comparison_mode_all_pairwise,
+    CONSTANTS_STATMODEL$comparison_mode_all_vs_one,
+    CONSTANTS_STATMODEL$comparison_mode_custom_pairwise,
+    CONSTANTS_STATMODEL$comparison_mode_custom_nonpairwise
+  )) {
+    result <- MSstatsShiny:::get_modeling_section_header(mode)
+    html <- as.character(result)
+    expect_true(grepl("Group comparison", html),
+                info = paste("Should show group comparison for mode:", mode))
+    expect_false(grepl("Dose response", html),
+                 info = paste("Should not show dose response for mode:", mode))
+  }
+})
+
+test_that("get_modeling_section_header handles NULL mode", {
+  result <- MSstatsShiny:::get_modeling_section_header(NULL)
+  html <- as.character(result)
+  expect_true(grepl("Group comparison", html),
+              info = "NULL mode should default to group comparison")
 })