diff --git a/DESCRIPTION b/DESCRIPTION index e9a357a..1209299 100644 --- a/DESCRIPTION +++ b/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, diff --git a/NAMESPACE b/NAMESPACE index 1690c4b..15e2803 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/MSstatsShiny.R b/R/MSstatsShiny.R index c378098..e61eeca 100644 --- a/R/MSstatsShiny.R +++ b/R/MSstatsShiny.R @@ -32,8 +32,8 @@ #' @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 @@ -41,6 +41,7 @@ #' @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 diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 40f66cd..a73bab0 100644 --- a/R/module-statmodel-server.R +++ b/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( diff --git a/R/utils.R b/R/utils.R index e2dee6b..778458f 100644 --- a/R/utils.R +++ b/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, diff --git a/tests/testthat/test-utils-statmodel-server.R b/tests/testthat/test-utils-statmodel-server.R index 69c9e47..b4ffe96 100644 --- a/tests/testthat/test-utils-statmodel-server.R +++ b/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)) }) # ============================================================================