Add robust parsing for temperature, time, and dosage for response curves

DESCRIPTION

@@ -27,7 +27,7 @@ Depends: R (>= 4.2)
 Imports: shiny, shinyBS, shinyjs, shinybusy, dplyr, ggplot2, plotly, data.table, Hmisc, shinyFiles,
   MSstats,MSstatsBig, MSstatsTMT, MSstatsPTM, MSstatsConvert, gplots, marray, DT, readxl,
   ggrepel, uuid, utils, stats, htmltools, methods, tidyr, grDevices, graphics, mockery, MSstatsBioNet,
-  shinydashboard, arrow, tools, MSstatsResponse
+  shinydashboard, arrow, tools, MSstatsResponse, stringr
 Suggests: 
     rmarkdown,
     tinytest,

NAMESPACE

@@ -48,13 +48,13 @@ importFrom(MSstatsPTM,SkylinetoMSstatsPTMFormat)
 importFrom(MSstatsPTM,SpectronauttoMSstatsPTMFormat)
 importFrom(MSstatsPTM,dataProcessPlotsPTM)
 importFrom(MSstatsPTM,groupComparisonPlotsPTM)
-importFrom(MSstatsResponse,MSstatsPrepareDoseResponseFit)
-importFrom(MSstatsResponse,convertGroupToNumericDose)
 importFrom(MSstatsResponse,doseResponseFit)
 importFrom(MSstatsResponse,visualizeResponseProtein)
 importFrom(arrow,read_parquet)
 importFrom(data.table,copy)
 importFrom(dplyr,`%>%`)
+importFrom(dplyr,bind_rows)
+importFrom(dplyr,case_when)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
@@ -191,6 +191,11 @@ importFrom(stats,hclust)
 importFrom(stats,median)
 importFrom(stats,na.omit)
 importFrom(stats,qt)
+importFrom(stringr,str_detect)
+importFrom(stringr,str_extract)
+importFrom(stringr,str_extract_all)
+importFrom(stringr,str_trim)
+importFrom(tidyr,pivot_wider)
 importFrom(tidyr,unite)
 importFrom(tools,file_ext)
 importFrom(utils,capture.output)

R/MSstatsShiny.R

@@ -32,15 +32,16 @@
 #' @importFrom htmltools attachDependencies
 #' @importFrom uuid UUIDgenerate
 #' @importFrom Hmisc describe
-#' @importFrom dplyr `%>%` filter summarise n_distinct group_by ungroup select n mutate
-#' @importFrom tidyr unite
+#' @importFrom dplyr `%>%` filter summarise n_distinct group_by ungroup select n mutate case_when bind_rows 
+#' @importFrom tidyr unite pivot_wider
 #' @importFrom MSstatsConvert MSstatsLogsSettings
 #' @importFrom MSstatsPTM dataProcessPlotsPTM groupComparisonPlotsPTM MaxQtoMSstatsPTMFormat PDtoMSstatsPTMFormat FragPipetoMSstatsPTMFormat SkylinetoMSstatsPTMFormat SpectronauttoMSstatsPTMFormat
 #' @importFrom utils capture.output head packageVersion read.csv read.delim write.csv
 #' @importFrom stats aggregate
 #' @importFrom methods is
 #' @importFrom readxl read_excel
 #' @importFrom plotly plotlyOutput plot_ly layout renderPlotly
+#' @importFrom stringr str_detect str_extract_all str_extract str_trim
 #' @import mockery
 #' 
 #' @name MSstatsShiny

R/module-statmodel-server.R

@@ -202,10 +202,88 @@ build_all_pair_contrast = function(input, condition_list, contrast, comp_list, r
   return(contrast$matrix)
 }
 
-#' @importFrom MSstatsResponse convertGroupToNumericDose
 build_response_curve_matrix = function(condition_list) {
-  condition_to_metadata_table = convertGroupToNumericDose(condition_list)
-  return(data.frame(GROUP = condition_list, condition_to_metadata_table))
+  matrix = data.frame(GROUP = as.character(condition_list))
+  matrix = matrix %>% mutate(
+    is_control = str_detect(toupper(GROUP), "^(DMSO|CONTROL|VEHICLE)$"),
+    measurements = str_extract_all(GROUP, "[0-9.]+[a-zA-Z]+")
+  )
+  controls = matrix %>% filter(is_control) %>% select(GROUP, is_control)
+  treatments = matrix %>% filter(!is_control) %>%
+    mutate(
+      value = as.numeric(str_extract(measurements, "[0-9.]+")),
+      unit = str_extract(measurements, "[a-zA-Z]+"),
+      measurement_type = case_when(
+        unit %in% c("nM", "uM", "mM", "M", "mg", "ug") ~ "dose",
+        unit %in% c("h", "hr", "hrs", "min", "d", "day") ~ "time",
+        unit %in% c("C", "F", "K") ~ "temperature",
+        TRUE ~ "treatment"
+      )
+    ) 
+    if (length(unique(treatments$unit)) > 1) {
+      showNotification(
+        paste("Multiple units of measurement detected in group names: ",
+              paste(unique(treatments$unit), collapse = ", "),
+              " Edit the metadata table to ensure consistent units."),
+        type = "warning",
+        duration = 10
+      )
+    }
+    treatments = treatments %>%
+      pivot_wider(
+        id_cols = c(GROUP, is_control),
+        names_from = measurement_type,
+        values_from = c(value, unit),
+        names_glue = "{measurement_type}_{.value}"
+      )
+    matrix = bind_rows(controls, treatments)
+    value_cols = grep("_value$", colnames(matrix), value = TRUE)
+    for (col in value_cols) {
+      matrix[[col]][matrix$is_control] = 0
+    }
+    if ("dose_value" %in% colnames(matrix)) {
+      matrix = matrix %>% 
+        mutate(
+          drug = ifelse(
+            is_control,
+            GROUP,
+            str_extract(GROUP, "^[^_0-9]+") %>% str_trim()
+          )
+        )
+    }
+    matrix = matrix %>% select(-is_control)
+
+    return(matrix)
+}
+
+# A hacky function to make metadata compatible with MSstatsResponse format
+# based on build_response_curve_matrix output
+prepare_dose_response_fit = function(data) {
+  if (!("drug" %in% colnames(data))) {
+    column_names = colnames(data)
+    intervention_cols = grep("time|temperature|treatment", column_names, 
+                             ignore.case = TRUE, value = TRUE)
+    if (length(intervention_cols) > 0) {
+      intervention_type = sub("_.*", "", intervention_cols[1])
+      data$drug = intervention_type
+      intervention_value = paste0(intervention_type, "_value")
+    } else {
+      stop("No intervention columns found (time, temperature, or treatment)")
+    }
+  } else {
+    intervention_value = "dose_value"
+  }
+
+  cols_to_use <- c(
+    protein = if("Protein" %in% colnames(data)) "Protein" else NA,
+    drug = "drug",
+    dose = intervention_value,
+    response = if("LogIntensities" %in% colnames(data)) "LogIntensities" else NA
+  )
+  cols_to_use <- cols_to_use[!is.na(cols_to_use)]
+  subset_df <- data[, cols_to_use, drop = FALSE]
+  colnames(subset_df) <- names(cols_to_use)
+  return(subset_df)
 }
 
 #' Update a matrix or data frame from a DT cell edit event
@@ -295,11 +373,11 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da
   output[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]] = renderUI({
     if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == 
         CONSTANTS_STATMODEL$plot_type_response_curve) {
-        response_curve_setup_matrix = contrast$matrix
+        response_curve_setup_matrix = prepare_dose_response_fit(contrast$matrix)
         unique_drugs = unique(response_curve_setup_matrix$drug)
         unique_drugs_without_control = unique_drugs[unique_drugs != "DMSO"]
         selectInput(session$ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug),
-                    label = h5("Select Drug"), 
+                    label = h5("Select Treatment"), 
                     unique_drugs_without_control, selected = unique_drugs_without_control[[1]])
     } else {
       NULL
@@ -705,13 +783,8 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input,
                    CONSTANTS_STATMODEL$plot_type_response_curve) {
           matrix = contrast$matrix
           protein_level_data <- merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP")
-          dia_prepared <- MSstatsPrepareDoseResponseFit(
-            data = protein_level_data,
-            dose_column = "dose_nM",
-            drug_column = "drug",
-            protein_column = "Protein",
-            log_abundance_column = "LogIntensities",
-            transform_nM_to_M = TRUE  
+          dia_prepared <- prepare_dose_response_fit(
+            data = protein_level_data
           )
           output$comp_plots = renderPlot({ 
             visualizeResponseProtein(

R/utils.R

@@ -1302,17 +1302,10 @@ dataComparison <- function(statmodel_input,qc_input,loadpage_input,matrix,input_
   return(model)
 }
 
-#' @importFrom MSstatsResponse MSstatsPrepareDoseResponseFit doseResponseFit
+#' @importFrom MSstatsResponse doseResponseFit
 fitResponseCurves <- function(statmodel_input, matrix, input_data) {
   protein_level_data <- merge(input_data$ProteinLevelData, matrix, by = "GROUP")
-  dia_prepared <- MSstatsPrepareDoseResponseFit(
-    data = protein_level_data,
-    dose_column = "dose_nM",
-    drug_column = "drug",
-    protein_column = "Protein",
-    log_abundance_column = "LogIntensities",
-    transform_nM_to_M = TRUE  
-  )
+  dia_prepared <- prepare_dose_response_fit(protein_level_data)
   response_results <- doseResponseFit(
     data = dia_prepared,
     increasing = FALSE,

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

@@ -379,14 +379,44 @@ test_that("get_contrast_panel_ui returns correct UI for each mode", {
 
 test_that("build_response_curve_matrix returns correct columns", {
   condition_list = c("Dasatinib_001nM", "Dasatinib_001uM", "DMSO")
+  mock_warning_different_units = mock()
+  stub(build_response_curve_matrix, "showNotification", mock_warning_different_units)
+  result = build_response_curve_matrix(condition_list)
+
+  # This test requires the MSstatsResponse package to be installed
+  expect_equal(nrow(result), 3)
+  expect_equal(ncol(result), 4)
+  expect_true("GROUP" %in% colnames(result))
+  expect_true("drug" %in% colnames(result))
+  expect_true("dose_value" %in% colnames(result))
+  expect_true("dose_unit" %in% colnames(result))
+  expect_called(mock_warning_different_units, 1) 
+})
+
+test_that("build_response_curve_matrix returns correct columns for time", {
+  condition_list = c("time_1h", "time_5hrs", "time_3h")
+  stub(build_response_curve_matrix, "showNotification", function(...) {})
   result <- build_response_curve_matrix(condition_list)
 
   # This test requires the MSstatsResponse package to be installed
   expect_equal(nrow(result), 3)
   expect_equal(ncol(result), 3)
   expect_true("GROUP" %in% colnames(result))
-  expect_true("drug" %in% colnames(result))
-  expect_true("dose_nM" %in% colnames(result))
+  expect_true("time_value" %in% colnames(result))
+  expect_true("time_unit" %in% colnames(result))
+})
+
+test_that("build_response_curve_matrix returns correct columns for temperature", {
+  condition_list = c("exp_5F", "time_3F")
+  stub(build_response_curve_matrix, "showNotification", function(...) {})
+  result <- build_response_curve_matrix(condition_list)
+
+  # This test requires the MSstatsResponse package to be installed
+  expect_equal(nrow(result), 2)
+  expect_equal(ncol(result), 3)
+  expect_true("GROUP" %in% colnames(result))
+  expect_true("temperature_value" %in% colnames(result))
+  expect_true("temperature_unit" %in% colnames(result))
 })
 
 # ============================================================================