From 59c6f1b9ba65ea757f7fc0e3f1246c4a9dfec28e Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Tue, 21 Apr 2026 15:29:29 -0400 Subject: [PATCH 01/13] feat(chemoproteomics): Add chemoproteomics template with dose-response workflow - Add TEMPLATES/TEMPLATE_LABELS constants for default + chemoproteomics - Add template selector on home page - Add condition metadata (DoseVal, DrugName, DoseUnit) editable DT table on loadpage for chemoproteomics - Parse drug name, dose value, and unit from condition names with user-editable fallbacks - Convert dose values from measured unit to molar (M) before analysis - Block analysis when any '?' placeholder values remain in metadata - Set transform_dose=TRUE for chemoproteomics dose-response fitting - Remove log-scale checkbox; set transform_dose via template instead - Add app_template threading through loadpage, qc, statmodel, expdes servers - Refactor expdesServer to use app_template instead of statmodel_input - Remove numbered prefixes from QC page section headers Co-Authored-By: Claude Sonnet 4.6 --- R/constants.R | 9 ++ R/module-expdes-server.R | 21 +-- R/module-home-ui.R | 12 ++ R/module-loadpage-server.R | 71 +++++++++- R/module-qc-server.R | 2 +- R/module-qc-ui.R | 16 +-- R/module-statmodel-server.R | 174 +++++++++++++++++++++---- R/server.R | 17 ++- R/statmodel-server-comparisons.R | 47 ++++++- R/statmodel-server-download-code.R | 4 +- R/statmodel-server-options-modeling.R | 6 +- R/statmodel-server-visualization.R | 58 ++++++--- R/statmodel-ui-options-modeling.R | 22 ++-- R/statmodel-ui-options-visualization.R | 30 +++-- R/utils.R | 4 +- 15 files changed, 387 insertions(+), 106 deletions(-) diff --git a/R/constants.R b/R/constants.R index 358c1c0..353039d 100644 --- a/R/constants.R +++ b/R/constants.R @@ -1,3 +1,12 @@ +TEMPLATES = list( + default = "default", + chemoproteomics = "chemoproteomics" +) + +TEMPLATE_LABELS = list( + default = "Protein Differential Abundance Analysis", + chemoproteomics = "Chemoproteomics" +) NAMESPACE_STATMODEL = list( comparisons_conditional_panel = "comparisons_conditional_panel", diff --git a/R/module-expdes-server.R b/R/module-expdes-server.R index fd65b4f..c6aecdf 100644 --- a/R/module-expdes-server.R +++ b/R/module-expdes-server.R @@ -33,18 +33,6 @@ ) } -#' Check if the current analysis mode is dose response curve -#' -#' @param statmodel_input List. The input values from the statmodel module. -#' @return Logical. TRUE if dose response curve mode is selected. -#' @noRd -.is_response_curve_mode <- function(statmodel_input) { - !is.null(statmodel_input) && - !is.null(statmodel_input[[NAMESPACE_STATMODEL$comparison_mode]]) && - statmodel_input[[NAMESPACE_STATMODEL$comparison_mode]] == - CONSTANTS_STATMODEL$comparison_mode_response_curve -} - # ============================================================================ # Expdes Server Module # ============================================================================ @@ -57,7 +45,7 @@ #' @param parent_session session of the main calling module #' @param loadpage_input input object from loadpage UI #' @param qc_input input object from QC UI -#' @param statmodel_input input object from Statmodel UI +#' @param app_template reactive returning the selected template name #' @param data_comparison function for group comparisons #' @param preprocess_data function returning preprocessed data #' @param statmodel_contrast reactiveValues object containing the contrast matrix from statmodel @@ -69,8 +57,9 @@ #' NA #' expdesServer <- function(input, output, session, parent_session, loadpage_input, - qc_input, statmodel_input, data_comparison, - preprocess_data = NULL, statmodel_contrast = NULL) { + qc_input, app_template = reactive(TEMPLATES$default), + data_comparison, preprocess_data = NULL, + statmodel_contrast = NULL) { ns <- session$ns prepared_response_data <- reactive({ @@ -84,7 +73,7 @@ expdesServer <- function(input, output, session, parent_session, loadpage_input, }) is_response_curve <- reactive({ - .is_response_curve_mode(statmodel_input()) + app_template() %in% c(TEMPLATES$protein_turnover, TEMPLATES$chemoproteomics) }) # Render sidebar controls based on analysis mode diff --git a/R/module-home-ui.R b/R/module-home-ui.R index b18464d..6511210 100644 --- a/R/module-home-ui.R +++ b/R/module-home-ui.R @@ -40,6 +40,18 @@ homeUI <- function(id) { p("This tool is designed to increase the usability of the packages, \ providing an all in one, end to end, analysis pipeline for proteomic data."), + br(), + h2("Select a Template"), + selectInput( + inputId = "app_template", + label = "Choose a workflow template to pre-configure analysis options:", + choices = setNames( + unlist(TEMPLATES, use.names = FALSE), + unlist(TEMPLATE_LABELS, use.names = FALSE) + ), + selected = TEMPLATES$default, + width = "400px" + ), br(), h2("Please select from the following options to get started"), h4("1.", actionButton(inputId = ns("StartPipeline"), label = "Run MSstats Pipeline")), diff --git a/R/module-loadpage-server.R b/R/module-loadpage-server.R index dfd0db7..173c1a2 100644 --- a/R/module-loadpage-server.R +++ b/R/module-loadpage-server.R @@ -13,9 +13,12 @@ #' @examples #' NA #' -loadpageServer <- function(id, parent_session, is_web_server = FALSE) { +loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_template = NULL) { moduleServer(id, function(input, output, session) { - + + # Condition metadata for chemoproteomics: Condition -> DoseVal/DrugName/DoseUnit mapping + condition_metadata <- reactiveVal(NULL) + # == shinyFiles LOGIC FOR LOCAL FILE BROWSER ================================= # Define volumes for the file selection. if (!is_web_server) { @@ -396,11 +399,64 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE) { getSummary2(input,get_data()) }) + # Handle edits to the condition metadata DT table + observeEvent(input$condition_metadata_table_cell_edit, { + info <- input$condition_metadata_table_cell_edit + current <- condition_metadata() + if (is.null(current)) return() + if (info$col == 1) { + value_col <- if ("TimeVal" %in% colnames(current)) "TimeVal" else "DoseVal" + current[[value_col]][info$row] <- info$value + condition_metadata(current) + } else if (info$col == 2 && "DrugName" %in% colnames(current)) { + current[["DrugName"]][info$row] <- as.character(info$value) + condition_metadata(current) + } else if (info$col == 3 && "DoseUnit" %in% colnames(current)) { + current[["DoseUnit"]][info$row] <- as.character(info$value) + condition_metadata(current) + } + }) + + # Render the editable condition metadata table + output$condition_metadata_table <- DT::renderDT({ + req(!is.null(condition_metadata())) + meta <- condition_metadata() + caption_text <- "Click any cell to edit. Cells showing '?' could not be parsed and must be filled in before running analysis." + DT::datatable( + meta, + editable = list(target = "cell", disable = list(columns = c(0))), + rownames = FALSE, + selection = "none", + options = list(dom = 't', paging = FALSE), + caption = caption_text + ) + }) + onclick("proceed1", { get_data() get_annot() shinyjs::show("summary_tables") + # Initialize condition metadata for chemoproteomics template + if (!is.null(app_template) && app_template() == TEMPLATES$chemoproteomics) { + tryCatch({ + data <- get_data() + if (!is.null(data) && "Condition" %in% colnames(data)) { + conditions <- unique(as.character(data$Condition)) + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(trimws(conditions))) + parsed_drug <- parse_drug_name_from_conditions(conditions) + dose_vals <- as.character(autofill_condition_value(conditions)) + dose_vals[is.na(dose_vals) | dose_vals == "NA"] <- "?" + meta_df <- data.frame(Condition = conditions, + DoseVal = dose_vals, + DrugName = ifelse(is_ctrl, conditions, parsed_drug), + DoseUnit = parse_dose_unit_from_conditions(conditions), + stringsAsFactors = FALSE) + condition_metadata(meta_df) + } + }, error = function(e) {}) + } + ### outputs ### get_summary = reactive({ if(is.null(get_data())) { @@ -469,11 +525,19 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE) { }) output$summary_tables = renderUI({ ns <- session$ns + is_chemo <- !is.null(app_template) && app_template() == TEMPLATES$chemoproteomics tagList( tags$head( tags$style(HTML('#loadpage-proceed2{background-color:orange}')) ), actionButton(inputId = ns("proceed2"), label = "Next step"), + if (is_chemo) tagList( + tags$hr(), + h4("Condition doses"), + p("Dose values are auto-filled from condition names. Correct any values as needed before running the analysis."), + DT::dataTableOutput(ns("condition_metadata_table")), + tags$br() + ), h4("Summary of experimental design"), tableOutput(ns('summary1')), tags$br(), @@ -498,7 +562,8 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE) { return( list( input = input, - getData = get_data + getData = get_data, + getConditionMetadata = condition_metadata ) ) }) diff --git a/R/module-qc-server.R b/R/module-qc-server.R index 58277cd..de57dbd 100644 --- a/R/module-qc-server.R +++ b/R/module-qc-server.R @@ -16,7 +16,7 @@ #' @examples #' NA #' -qcServer <- function(input, output, session,parent_session, loadpage_input,get_data) { +qcServer <- function(input, output, session,parent_session, loadpage_input,get_data, app_template = NULL, get_condition_metadata = NULL) { # output$showplot = renderUI({ # print("****") diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index 3c20948..4dac0df 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -27,13 +27,13 @@ qcUI <- function(id) { sidebarPanel( # transformation conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", - h4("1. Peptide level normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + h4("Peptide level normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Global median normalization on peptide level data, equalizes medians across all the channels and runs", class = "icon-tooltip")), checkboxInput(ns("global_norm"), "Yes", value = TRUE)), conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'LType' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] != 'TMT'))", radioButtons(ns("log"), - label = h4("1. Log transformation",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + label = h4("Log transformation",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Logarithmic transformation applied to the Intensity column", class = "icon-tooltip")), c(log2 = "2", log10 = "10"))), @@ -42,7 +42,7 @@ qcUI <- function(id) { conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", selectInput(ns("summarization"), - h4("2. Summarization method",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + h4("Summarization method",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Select method to be used for protein summarization. For details on each option please see Help tab", class = "icon-tooltip")), c("MSstats" = "msstats", "Tukeys median polish" = "MedianPolish", @@ -58,14 +58,14 @@ qcUI <- function(id) { # Normalization conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'LType'", selectInput(ns("norm"), - label = h4("2. Normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + label = h4("Normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Normalization to remove systematic bias between MS runs. For more information visit the Help tab", class = "icon-tooltip")), c("none" = "FALSE", "equalize medians" = "equalizeMedians", "quantile" = "quantile", "global standards" = "globalStandards"), selected = "equalizeMedians")), conditionalPanel(condition = "input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] != 'TMT')", selectInput(ns("norm"), - label = h4("2. Normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + label = h4("Normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Normalization to remove systematic bias between MS runs. For more information visit the Help tab", class = "icon-tooltip")), c("none" = "FALSE", "equalize medians" = "equalizeMedians", "quantile" = "quantile"), @@ -78,11 +78,11 @@ qcUI <- function(id) { conditionalPanel( condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", - h4("3. Local protein normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + h4("Local protein normalization",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Reference channel based normalization between MS runs on protein level data. Requires one reference channel in each MS run, annotated by 'Norm' in Condition column of annotation file", class = "icon-tooltip")), checkboxInput(ns("reference_norm"), "Yes", value = TRUE), tags$hr(), - h4("4. Filtering"), + h4("Filtering"), checkboxInput(ns("remove_norm_channel"), "Remove normalization channel", value = TRUE) ), @@ -95,7 +95,7 @@ qcUI <- function(id) { #h4("3. Used features"), radioButtons(ns("features_used"), - label = h4("3. Feature subset",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + label = h4("Feature subset",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("What features to use in \ summarization. All features or a subset of \ features can be used.", class = "icon-tooltip")), diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 25fe728..7c5f91b 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -22,21 +22,54 @@ #' @examples #' NA #' -statmodelServer = function(id, parent_session, loadpage_input, qc_input, - get_data, preprocess_data) { +statmodelServer = function(id, parent_session, loadpage_input, qc_input, + get_data, preprocess_data, + app_template = reactive(TEMPLATES$default), + turnover_ratios = reactive(NULL), + condition_metadata = reactive(NULL)) { moduleServer( id, function(input, output, session) { - + # Initialize reactive values - condition_list = reactive({ - get_experimental_conditions(loadpage_input(), preprocess_data()) + condition_list = reactive({ + get_experimental_conditions(loadpage_input(), preprocess_data()) }) row = reactive({ rep(0, length(condition_list())) }) contrast = reactiveValues(matrix = NULL, row = NULL) comp_list = reactiveValues(dList = NULL) significant = reactiveValues(result = NULL) - + + # Apply template-specific defaults when the template selection changes. + observeEvent(app_template(), { + template = app_template() + if (template == TEMPLATES$chemoproteomics) { + updateRadioButtons(session, NAMESPACE_STATMODEL$comparison_mode, + choices = c("Create dose response curves" = CONSTANTS_STATMODEL$comparison_mode_response_curve), + selected = CONSTANTS_STATMODEL$comparison_mode_response_curve) + updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, + choices = c("Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve), + selected = CONSTANTS_STATMODEL$plot_type_response_curve) + updateCheckboxInput(session, NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend, value = FALSE) + } else { + updateRadioButtons(session, NAMESPACE_STATMODEL$comparison_mode, + choices = c( + "All possible pairwise comparisons" = CONSTANTS_STATMODEL$comparison_mode_all_pairwise, + "Compare all against one" = CONSTANTS_STATMODEL$comparison_mode_all_vs_one, + "Create custom pairwise comparisons" = CONSTANTS_STATMODEL$comparison_mode_custom_pairwise, + "Create custom non-pairwise comparisons" = CONSTANTS_STATMODEL$comparison_mode_custom_nonpairwise + ), + selected = character(0)) + 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 + )) + updateCheckboxInput(session, NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend, value = FALSE) + } + }, ignoreInit = TRUE) + # UI visibility observe({ if (loadpage_input()$DDA_DIA == "TMT" | loadpage_input()$BIO == "PTM") { @@ -61,7 +94,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, tryCatch({ rownames(matrix_build()) }, error = function(e) {}) }) - render_group_comparison_plot_inputs(output, session, Rownames, get_data, input, loadpage_input, condition_list,contrast) + render_group_comparison_plot_inputs(output, session, Rownames, get_data, input, loadpage_input, condition_list, contrast, app_template, turnover_ratios, condition_metadata) output[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]] <- renderUI({ req(input[[NAMESPACE_STATMODEL$comparison_mode]] == @@ -90,7 +123,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, 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) + choices = c("Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve) ) } else { updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, @@ -110,10 +143,30 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, significant$result = NULL # Auto-build response curve metadata when dose response mode is selected - if (isTRUE(input[[NAMESPACE_STATMODEL$comparison_mode]] == + if (isTRUE(input[[NAMESPACE_STATMODEL$comparison_mode]] == CONSTANTS_STATMODEL$comparison_mode_response_curve)) { tryCatch({ - rc_matrix <- build_response_curve_matrix(condition_list()) + if (app_template() == TEMPLATES$chemoproteomics) { + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (!is.null(meta) && nrow(meta) > 0 && "DoseVal" %in% colnames(meta)) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + rc_matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + } else { + showNotification( + "Please enter dose values for each condition on the data upload page.", + type = "warning", duration = 8 + ) + disable(NAMESPACE_STATMODEL$modeling_start) + return() + } + } else { + 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.") } @@ -127,10 +180,31 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, } }) - # Re-filter matrix when excluded conditions change + # Propagate loadpage metadata edits to contrast$matrix for chemoproteomics. + observeEvent(tryCatch(condition_metadata(), error = function(e) NULL), { + req(isTRUE(input[[NAMESPACE_STATMODEL$comparison_mode]] == + CONSTANTS_STATMODEL$comparison_mode_response_curve)) + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + req(!is.null(meta) && nrow(meta) > 0) + + if (isTRUE(app_template() == TEMPLATES$chemoproteomics) && + "DoseVal" %in% colnames(meta)) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + contrast$matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + enable(NAMESPACE_STATMODEL$modeling_start) + } + }, ignoreNULL = TRUE) + + # Re-filter matrix when excluded conditions change (default template only) observeEvent(input[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]], { req(input[[NAMESPACE_STATMODEL$comparison_mode]] == CONSTANTS_STATMODEL$comparison_mode_response_curve) + req(!isTRUE(app_template() %in% c(TEMPLATES$protein_turnover, TEMPLATES$chemoproteomics))) tryCatch({ all_conditions <- condition_list() excluded <- input[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]] @@ -177,8 +251,20 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, contrast$matrix = build_all_pair_contrast( input, condition_list(), contrast, comp_list, row(), loadpage_input()) } else if (input[[NAMESPACE_STATMODEL$comparison_mode]] == CONSTANTS_STATMODEL$comparison_mode_response_curve) { - contrast$matrix = build_response_curve_matrix( - condition_list()) + if (app_template() == TEMPLATES$chemoproteomics) { + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (!is.null(meta) && nrow(meta) > 0 && "DoseVal" %in% colnames(meta)) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + contrast$matrix = data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + } + } else { + contrast$matrix = build_response_curve_matrix(condition_list()) + } } enable(NAMESPACE_STATMODEL$modeling_start) @@ -194,7 +280,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, output[[NAMESPACE_STATMODEL$modeling_response_curve_fitting_options]] = renderUI({ get_response_curve_fitting_options( - input[[NAMESPACE_STATMODEL$comparison_mode]], session$ns) + input[[NAMESPACE_STATMODEL$comparison_mode]], session$ns, app_template()) }) output[[NAMESPACE_STATMODEL$modeling_tmt_moderation]] = renderUI({ @@ -205,9 +291,33 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { req(contrast$matrix) matrix = contrast$matrix - if (input[[NAMESPACE_STATMODEL$comparison_mode]] == + if (input[[NAMESPACE_STATMODEL$comparison_mode]] == CONSTANTS_STATMODEL$comparison_mode_response_curve) { - fitResponseCurves(input, matrix, preprocess_data()) + if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (!is.null(meta)) { + check_cols <- intersect(c("DoseVal", "DoseUnit"), colnames(meta)) + if (any(sapply(check_cols, function(col) "?" %in% meta[[col]]))) { + showNotification( + "Please fill in all '?' values in the condition metadata table on the data upload page before running the analysis.", + type = "error", duration = 8 + ) + req(FALSE) + } + } + meta <- condition_metadata() + req(!is.null(meta) && "DoseVal" %in% colnames(meta)) + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + fitResponseCurves(input, matrix, preprocess_data(), transform_dose = TRUE) + } else { + fitResponseCurves(input, matrix, preprocess_data(), transform_dose = TRUE) + } } else { dataComparison(input, qc_input(), loadpage_input(), matrix, preprocess_data()) } @@ -216,7 +326,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, data_comparison_code = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { req(contrast$matrix) comp_mat = contrast$matrix - generate_analysis_code(qc_input(), loadpage_input(), comp_mat, input) + generate_analysis_code(qc_input(), loadpage_input(), comp_mat, input, app_template()) }) SignificantProteins = eventReactive(input[[NAMESPACE_STATMODEL$modeling_start]], { @@ -247,6 +357,10 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, }) output$matrix = renderUI({ + if (!is.null(app_template) && !is.null(app_template()) && + app_template() %in% c(TEMPLATES$chemoproteomics)) { + return(NULL) + } ns = session$ns mode = input[[NAMESPACE_STATMODEL$comparison_mode]] matrix_title = if (isTRUE(mode == CONSTANTS_STATMODEL$comparison_mode_response_curve)) { @@ -281,7 +395,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, # Download handlers create_download_handlers(output, data_comparison, SignificantProteins, data_comparison_code) - create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input) + create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template, turnover_ratios, condition_metadata) # Plot rendering output[[NAMESPACE_STATMODEL$visualization_plot_output]] = renderUI({ @@ -295,21 +409,33 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ) }) - } else if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + } else if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_response_curve) { - matrix = contrast$matrix + if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { + meta <- condition_metadata() + req(!is.null(meta) && "DoseVal" %in% colnames(meta)) + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + } else { + matrix = contrast$matrix + } protein_level_data = merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP") dia_prepared = prepare_dose_response_fit(data = protein_level_data) - - output_plot = renderPlot({ + + output_plot = renderPlot({ visualizeResponseProtein( data = dia_prepared, protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]], drug_name = input[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]], 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]], + add_ci = TRUE, + transform_dose = TRUE, n_samples = 1000, increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) diff --git a/R/server.R b/R/server.R index c0969ae..7296d82 100644 --- a/R/server.R +++ b/R/server.R @@ -32,12 +32,15 @@ server = function(input, output, session) { selected = "Uploaddata") }) - loadpage_values = loadpageServer("loadpage", parent_session = session, is_web_server = isWebServer) + app_template = reactive(input$app_template) + + loadpage_values = loadpageServer("loadpage", parent_session = session, is_web_server = isWebServer, app_template = app_template) loadpage_input = loadpage_values$input get_data = loadpage_values$getData - + get_condition_metadata = loadpage_values$getConditionMetadata + # qcServer - update to direct call if refactored, otherwise keep callModule for now - qc_values = callModule(qcServer, "qc", session, reactive(loadpage_input), get_data) + qc_values = callModule(qcServer, "qc", session, reactive(loadpage_input), get_data, app_template, get_condition_metadata) qc_input = qc_values$input preprocess_data = qc_values$preprocessData @@ -47,15 +50,17 @@ server = function(input, output, session) { loadpage_input = reactive(loadpage_input), qc_input = reactive(qc_input), get_data = get_data, - preprocess_data = preprocess_data + preprocess_data = preprocess_data, + app_template = app_template, + condition_metadata = get_condition_metadata ) statmodel_input = statmodel_values$input data_comparison = statmodel_values$dataComparison statmodel_contrast = statmodel_values$contrast - + # expdesServer - keep callModule if not yet refactored callModule(expdesServer, "expdes", session, reactive(loadpage_input), - reactive(qc_input), reactive(statmodel_input), data_comparison, + reactive(qc_input), app_template, data_comparison, preprocess_data, statmodel_contrast) observeEvent(input$proceed, { diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 7c68d22..63ffded 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -2,6 +2,51 @@ # Contrast Matrix Building Functions # ============================================================================ +#' Convert dose values from their measured unit to molar (M) +#' @noRd +convert_dose_to_molar <- function(dose_val, dose_unit) { + multipliers <- c(nM=1e-9, nm=1e-9, uM=1e-6, um=1e-6, mM=1e-3, mm=1e-3, M=1, m=1) + if (length(dose_unit) == 1) dose_unit <- rep(dose_unit, length(dose_val)) + mult <- unname(multipliers[dose_unit]) + mult[is.na(mult)] <- 1 + dose_val * mult +} + +#' Parse dose unit from condition names (vectorized, per condition) +#' @noRd +parse_dose_unit_from_conditions <- function(conditions) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(trimws(conditions))) + measurement <- str_extract(conditions, "[0-9.]+[a-zA-Z]+") + unit <- str_extract(measurement, "[a-zA-Z]+") + unit[is_ctrl] <- "" + unit[!is_ctrl & (is.na(unit) | nchar(unit) == 0)] <- "?" + unit +} + +#' Parse drug name from condition names (returns "Treatment" if unparseable) +#' @noRd +parse_drug_name_from_conditions <- function(conditions) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(trimws(conditions))) + non_ctrl <- conditions[!is_ctrl] + if (length(non_ctrl) == 0) return("Treatment") + prefixes <- gsub("[_ .-]?[0-9.]+[a-zA-Z]+.*$", "", non_ctrl) + prefixes <- trimws(prefixes, whitespace = "[ _\t.-]") + prefixes <- prefixes[nchar(prefixes) > 0] + if (length(prefixes) == 0) return("Treatment") + drug_name <- names(sort(table(prefixes), decreasing = TRUE))[1] + if (is.null(drug_name) || nchar(drug_name) == 0) "Treatment" else drug_name +} + +#' Auto-fill numeric dose/time value from condition name +#' @noRd +autofill_condition_value <- function(conditions) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(trimws(conditions))) + measurement <- str_extract(conditions, "[0-9.]+[a-zA-Z]+") + value <- suppressWarnings(as.numeric(str_extract(measurement, "[0-9.]+"))) + value[is_ctrl] <- 0 + value +} + #' Get experimental conditions from preprocessed data #' #' @param loadpage_input List containing BIO, DDA_DIA, and filetype parameters @@ -312,7 +357,7 @@ build_response_curve_matrix = function(condition_list) { 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]+") + measurements = str_extract(GROUP, "[0-9.]+[a-zA-Z]+") ) controls = matrix %>% filter(is_control) %>% select(GROUP, is_control) treatments = matrix %>% filter(!is_control) %>% diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 41723fd..05dd4c4 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -1,4 +1,4 @@ -generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input) { +generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app_template = TEMPLATES$default) { codes = preprocessDataCode(qc_input, loadpage_input) # Check if this is a response curve analysis @@ -7,7 +7,7 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input) { if (is_response_curve) { increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] - transform_dose = input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]] + transform_dose = !isTRUE(app_template == TEMPLATES$protein_turnover) ratio_response = isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]) codes = paste(codes, "\n# Set up dose response analysis\n", sep = "") diff --git a/R/statmodel-server-options-modeling.R b/R/statmodel-server-options-modeling.R index c7f8b30..22fe00d 100644 --- a/R/statmodel-server-options-modeling.R +++ b/R/statmodel-server-options-modeling.R @@ -31,11 +31,11 @@ get_modeling_section_header <- function(mode) { #' Get response curve fitting options conditioned on if contrast mode is response curve #' @noRd -get_response_curve_fitting_options = function(mode, ns) { +get_response_curve_fitting_options = function(mode, ns, template = TEMPLATES$default) { if (!is.null(mode) && mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { + is_protein_turnover <- isTRUE(template == TEMPLATES$protein_turnover) tagList( - create_response_curve_log_xaxis_checkbox(ns), - create_response_curve_increasing_trend_checkbox(ns) + create_response_curve_increasing_trend_checkbox(ns, value = is_protein_turnover) ) } } diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 36bd98f..64181ed 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -2,24 +2,24 @@ # Visualization Options and Plotting Functions # ============================================================================ -render_group_comparison_plot_inputs = function(output, session, rownames, get_data, input, loadpage_input, condition_list, contrast) { +render_group_comparison_plot_inputs = function(output, session, rownames, get_data, input, loadpage_input, condition_list, contrast, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), condition_metadata = reactive(NULL)) { ns = session$ns - + output[[NAMESPACE_STATMODEL$visualization_which_comparison]] = renderUI({ selectInput(ns(NAMESPACE_STATMODEL$visualization_which_comparison), - label = h5("Select comparison to plot"), + label = h5("Select comparison to plot"), c("all", rownames()), selected = "all") }) - + output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({ selectInput(ns(NAMESPACE_STATMODEL$visualization_which_protein), - label = h4("which protein to plot"), + label = h4("which protein to plot"), unique(get_data()$ProteinName)) }) - + output[[NAMESPACE_STATMODEL$visualization_plot_options_conditional_panel]] = renderUI({ plot_type = input[[NAMESPACE_STATMODEL$visualization_plot_type]] - + if (plot_type == CONSTANTS_STATMODEL$plot_type_volcano_plot) { show_protein_name = !is.null(loadpage_input()$DDA_DIA) && loadpage_input()$DDA_DIA != "TMT" @@ -29,28 +29,44 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da } else if (plot_type == CONSTANTS_STATMODEL$plot_type_heatmap) { create_heatmap_options(ns) } else if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) { - create_response_curve_options(ns) + create_response_curve_options(ns, is_protein_turnover = !is.null(app_template) && app_template() == TEMPLATES$protein_turnover) } else { NULL } }) - + output[[NAMESPACE_STATMODEL$visualization_fold_change_input]] = renderUI({ req(input[[NAMESPACE_STATMODEL$visualization_fold_change_checkbox]]) if (input[[NAMESPACE_STATMODEL$visualization_fold_change_checkbox]]) { numericInput(ns(NAMESPACE_STATMODEL$visualization_fold_change_input), "Fold change cutoff", 1, 0, 100, 0.1) } }) - + output[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]] = renderUI({ req(contrast$matrix) - if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_response_curve) { - response_curve_setup_matrix = prepare_dose_response_fit(contrast$matrix) + if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (!is.null(meta) && "DoseVal" %in% colnames(meta)) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + rc_mat <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + } else { + rc_mat <- contrast$matrix + } + } else { + rc_mat <- contrast$matrix + } + response_curve_setup_matrix = prepare_dose_response_fit(rc_mat) 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 Treatment"), + label = h5("Select Treatment"), unique_drugs_without_control, selected = unique_drugs_without_control[[1]]) } else { NULL @@ -151,7 +167,7 @@ zip_and_copy_plot <- function(pdf_files, dest_file) { #' @importFrom ggplot2 ggsave #' @importFrom utils zip -create_download_plot_handler <- function(output, input, contrast, preprocess_data, data_comparison, loadpage_input) { +create_download_plot_handler <- function(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), condition_metadata = reactive(NULL)) { output[[NAMESPACE_STATMODEL$visualization_download_plot_results]] <- downloadHandler( filename = function() { get_download_plot_filename(input[[NAMESPACE_STATMODEL$visualization_plot_type]]) @@ -167,6 +183,18 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat showNotification("Please build a contrast matrix first.", type = "error") return(NULL) } + if (isTRUE(app_template() == TEMPLATES$chemoproteomics)) { + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (!is.null(meta) && "DoseVal" %in% colnames(meta)) { + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) + } + } protein_level_data <- merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP") dia_prepared <- prepare_dose_response_fit(data = protein_level_data) @@ -177,7 +205,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat 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]], + transform_dose = TRUE, n_samples = 1000, increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) diff --git a/R/statmodel-ui-options-modeling.R b/R/statmodel-ui-options-modeling.R index 6adce75..584392c 100644 --- a/R/statmodel-ui-options-modeling.R +++ b/R/statmodel-ui-options-modeling.R @@ -31,32 +31,32 @@ create_moderation_radio_buttons <- function(ns) { ) } -create_response_curve_log_xaxis_checkbox <- function(ns) { +create_response_curve_log_xaxis_checkbox <- function(ns, value = TRUE) { checkboxInput( - ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), + ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), label = tags$div("Log scale for treatment values", class = "icon-wrapper", icon("question-circle", lib = "font-awesome"), - div("Check this box to use a log scale for the x-axis of dose response curves. - This is typically used when doses are in a log scale (e.g. 0.1, 1, 10, 100). - But if your scale is linear, e.g. time 1, 2, 3 hours, then we recommend unchecking this box", + div("Check this box to use a log scale for the x-axis of dose response curves. + This is typically used when doses are in a log scale (e.g. 0.1, 1, 10, 100). + But if your scale is linear, e.g. time 1, 2, 3 hours, then we recommend unchecking this box", class = "icon-tooltip") ), - value = TRUE + value = value ) } -create_response_curve_increasing_trend_checkbox <- function(ns) { +create_response_curve_increasing_trend_checkbox <- function(ns, value = FALSE) { checkboxInput( - ns(NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend), + ns(NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend), label = tags$div("Increasing trend for dose response curves", class = "icon-wrapper", icon("question-circle", lib = "font-awesome"), - div("Check this box if you expect an increasing trend in your dose response curve, e.g. higher doses lead to higher protein abundance. - Uncheck if you expect a decreasing trend, e.g. higher doses lead to lower protein abundance.", + div("Check this box if you expect an increasing trend in your dose response curve, e.g. higher doses lead to higher protein abundance. + Uncheck if you expect a decreasing trend, e.g. higher doses lead to lower protein abundance.", class = "icon-tooltip") ), - value = FALSE + value = value ) } diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index ba68fd9..1e9cc2a 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -25,7 +25,7 @@ create_plot_type_selector <- function(ns) { "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, - "Dose Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve + "Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve ) ) ) @@ -101,22 +101,24 @@ create_heatmap_options <- function(ns) { #' Create response curve specific options #' @noRd -create_response_curve_options <- function(ns) { +create_response_curve_options <- function(ns, is_protein_turnover = FALSE) { tagList( uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)), 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 - ) + if (!is_protein_turnover) { + 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 + ) + } ) } diff --git a/R/utils.R b/R/utils.R index f156c7a..bca0664 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1448,13 +1448,13 @@ dataComparison <- function(statmodel_input,qc_input,loadpage_input,matrix,input_ } #' @importFrom MSstatsResponse doseResponseFit -fitResponseCurves <- function(statmodel_input, matrix, input_data) { +fitResponseCurves <- function(statmodel_input, matrix, input_data, transform_dose = TRUE) { protein_level_data <- merge(input_data$ProteinLevelData, matrix, by = "GROUP") dia_prepared <- prepare_dose_response_fit(protein_level_data) response_results <- doseResponseFit( data = dia_prepared, increasing = statmodel_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]], - transform_dose = statmodel_input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]], + transform_dose = transform_dose, ratio_response = FALSE ) return(list(ComparisonResult = response_results)) From c6b9e514378a6ab57c70b5741659e83693449690 Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Tue, 21 Apr 2026 16:18:30 -0400 Subject: [PATCH 02/13] bug fixes --- R/statmodel-ui-options-visualization.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 1e9cc2a..ce848d8 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -105,7 +105,7 @@ create_response_curve_options <- function(ns, is_protein_turnover = FALSE) { tagList( uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)), uiOutput(ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug)), - if (!is_protein_turnover) { + if (!isTRUE(is_protein_turnover)) { checkboxInput( ns(NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale), label = span( From 369f0aedeab6260f12a333e08a6ef90024f91ab8 Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Tue, 21 Apr 2026 16:24:51 -0400 Subject: [PATCH 03/13] reduce simulation time --- R/module-expdes-server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module-expdes-server.R b/R/module-expdes-server.R index c6aecdf..f14b8db 100644 --- a/R/module-expdes-server.R +++ b/R/module-expdes-server.R @@ -159,7 +159,7 @@ expdesServer <- function(input, output, session, parent_session, loadpage_input, dose_range = c(2, length(user_concs)), data = sim_data, protein = selected_protein, - n_proteins = 1000 + n_proteins = 300 ) simulation_results(results) remove_modal_spinner() From 4f3e01ea7a95b523ceb6a28b96e5ed7fec4fb250 Mon Sep 17 00:00:00 2001 From: tonywu1999 Date: Tue, 21 Apr 2026 17:12:44 -0400 Subject: [PATCH 04/13] convert to nM for sample size --- R/module-expdes-server.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/module-expdes-server.R b/R/module-expdes-server.R index f14b8db..a5403fc 100644 --- a/R/module-expdes-server.R +++ b/R/module-expdes-server.R @@ -135,9 +135,11 @@ expdesServer <- function(input, output, session, parent_session, loadpage_input, remove_modal_spinner() return() } + user_concs <- user_concs * 1e9 # simulations for chemoproteomics assume nM. # Check replicates per dose in user's data sim_data <- prepared_response_data() + sim_data$dose <- sim_data$dose * 1e9 # simulations for chemoproteomics assume nM. selected_protein <- input[[NAMESPACE_EXPDES$protein_select]] reps_per_dose <- .check_replicates_per_dose(sim_data, selected_protein) From cad82f73fa02349d45bfa2b3e07b95f09a36a14f Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 20:00:00 -0400 Subject: [PATCH 05/13] initial edits --- R/module-expdes-server.R | 2 +- R/module-loadpage-server.R | 12 ++++++++++-- R/module-qc-server.R | 2 +- 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/R/module-expdes-server.R b/R/module-expdes-server.R index a5403fc..a5f83a0 100644 --- a/R/module-expdes-server.R +++ b/R/module-expdes-server.R @@ -73,7 +73,7 @@ expdesServer <- function(input, output, session, parent_session, loadpage_input, }) is_response_curve <- reactive({ - app_template() %in% c(TEMPLATES$protein_turnover, TEMPLATES$chemoproteomics) + app_template() %in% c(TEMPLATES$chemoproteomics) }) # Render sidebar controls based on analysis mode diff --git a/R/module-loadpage-server.R b/R/module-loadpage-server.R index 173c1a2..084db0e 100644 --- a/R/module-loadpage-server.R +++ b/R/module-loadpage-server.R @@ -438,7 +438,8 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa shinyjs::show("summary_tables") # Initialize condition metadata for chemoproteomics template - if (!is.null(app_template) && app_template() == TEMPLATES$chemoproteomics) { + condition_metadata(NULL) + if (!is.null(app_template) && isTRUE(app_template() == TEMPLATES$chemoproteomics)) { tryCatch({ data <- get_data() if (!is.null(data) && "Condition" %in% colnames(data)) { @@ -454,7 +455,14 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa stringsAsFactors = FALSE) condition_metadata(meta_df) } - }, error = function(e) {}) + }, error = function(e) { + condition_metadata(NULL) + showNotification( + paste("Could not initialize condition metadata:", conditionMessage(e)), + type = "warning", + duration = 6 + ) + }) } ### outputs ### diff --git a/R/module-qc-server.R b/R/module-qc-server.R index de57dbd..58277cd 100644 --- a/R/module-qc-server.R +++ b/R/module-qc-server.R @@ -16,7 +16,7 @@ #' @examples #' NA #' -qcServer <- function(input, output, session,parent_session, loadpage_input,get_data, app_template = NULL, get_condition_metadata = NULL) { +qcServer <- function(input, output, session,parent_session, loadpage_input,get_data) { # output$showplot = renderUI({ # print("****") From 31cf4cf2896e68ec16aeab10d89a8bffb6e80a48 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 20:14:28 -0400 Subject: [PATCH 06/13] fix server code --- R/module-statmodel-server.R | 2 -- R/server.R | 11 +++++++++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 7c5f91b..e837a91 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -200,11 +200,9 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, } }, ignoreNULL = TRUE) - # Re-filter matrix when excluded conditions change (default template only) observeEvent(input[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]], { req(input[[NAMESPACE_STATMODEL$comparison_mode]] == CONSTANTS_STATMODEL$comparison_mode_response_curve) - req(!isTRUE(app_template() %in% c(TEMPLATES$protein_turnover, TEMPLATES$chemoproteomics))) tryCatch({ all_conditions <- condition_list() excluded <- input[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]] diff --git a/R/server.R b/R/server.R index 7296d82..a016a48 100644 --- a/R/server.R +++ b/R/server.R @@ -32,7 +32,14 @@ server = function(input, output, session) { selected = "Uploaddata") }) - app_template = reactive(input$app_template) + app_template = reactive({ + template <- input$app_template + if (is.null(template) || !nzchar(template)) { + TEMPLATES$default + } else { + template + } + }) loadpage_values = loadpageServer("loadpage", parent_session = session, is_web_server = isWebServer, app_template = app_template) loadpage_input = loadpage_values$input @@ -40,7 +47,7 @@ server = function(input, output, session) { get_condition_metadata = loadpage_values$getConditionMetadata # qcServer - update to direct call if refactored, otherwise keep callModule for now - qc_values = callModule(qcServer, "qc", session, reactive(loadpage_input), get_data, app_template, get_condition_metadata) + qc_values = callModule(qcServer, "qc", session, reactive(loadpage_input), get_data) qc_input = qc_values$input preprocess_data = qc_values$preprocessData From 692ace2c5fc0f04c690f98c0e44b2011f014274a Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:16:35 -0400 Subject: [PATCH 07/13] fix small pieces --- R/module-statmodel-server.R | 4 ++-- R/statmodel-server-download-code.R | 4 ++-- R/statmodel-server-options-modeling.R | 3 +-- R/statmodel-server-visualization.R | 6 +++--- R/statmodel-ui-options-modeling.R | 15 -------------- R/statmodel-ui-options-visualization.R | 28 ++++++++++++-------------- 6 files changed, 21 insertions(+), 39 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index e837a91..af4fc0e 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -94,7 +94,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, tryCatch({ rownames(matrix_build()) }, error = function(e) {}) }) - render_group_comparison_plot_inputs(output, session, Rownames, get_data, input, loadpage_input, condition_list, contrast, app_template, turnover_ratios, condition_metadata) + render_group_comparison_plot_inputs(output, session, Rownames, get_data, input, loadpage_input, condition_list, contrast, app_template, condition_metadata) output[[NAMESPACE_STATMODEL$comparisons_exclude_conditions]] <- renderUI({ req(input[[NAMESPACE_STATMODEL$comparison_mode]] == @@ -393,7 +393,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, # Download handlers create_download_handlers(output, data_comparison, SignificantProteins, data_comparison_code) - create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template, turnover_ratios, condition_metadata) + create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template, condition_metadata) # Plot rendering output[[NAMESPACE_STATMODEL$visualization_plot_output]] = renderUI({ diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 05dd4c4..8417f1f 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -1,4 +1,4 @@ -generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app_template = TEMPLATES$default) { +generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input) { codes = preprocessDataCode(qc_input, loadpage_input) # Check if this is a response curve analysis @@ -7,7 +7,7 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app if (is_response_curve) { increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] - transform_dose = !isTRUE(app_template == TEMPLATES$protein_turnover) + transform_dose = TRUE ratio_response = isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]) codes = paste(codes, "\n# Set up dose response analysis\n", sep = "") diff --git a/R/statmodel-server-options-modeling.R b/R/statmodel-server-options-modeling.R index 22fe00d..94db8de 100644 --- a/R/statmodel-server-options-modeling.R +++ b/R/statmodel-server-options-modeling.R @@ -33,9 +33,8 @@ get_modeling_section_header <- function(mode) { #' @noRd get_response_curve_fitting_options = function(mode, ns, template = TEMPLATES$default) { if (!is.null(mode) && mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) { - is_protein_turnover <- isTRUE(template == TEMPLATES$protein_turnover) tagList( - create_response_curve_increasing_trend_checkbox(ns, value = is_protein_turnover) + create_response_curve_increasing_trend_checkbox(ns, value = FALSE) ) } } diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 64181ed..4b6e0e7 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -2,7 +2,7 @@ # Visualization Options and Plotting Functions # ============================================================================ -render_group_comparison_plot_inputs = function(output, session, rownames, get_data, input, loadpage_input, condition_list, contrast, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), condition_metadata = reactive(NULL)) { +render_group_comparison_plot_inputs = function(output, session, rownames, get_data, input, loadpage_input, condition_list, contrast, app_template = reactive(TEMPLATES$default), condition_metadata = reactive(NULL)) { ns = session$ns output[[NAMESPACE_STATMODEL$visualization_which_comparison]] = renderUI({ @@ -29,7 +29,7 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da } else if (plot_type == CONSTANTS_STATMODEL$plot_type_heatmap) { create_heatmap_options(ns) } else if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) { - create_response_curve_options(ns, is_protein_turnover = !is.null(app_template) && app_template() == TEMPLATES$protein_turnover) + create_response_curve_options(ns) } else { NULL } @@ -167,7 +167,7 @@ zip_and_copy_plot <- function(pdf_files, dest_file) { #' @importFrom ggplot2 ggsave #' @importFrom utils zip -create_download_plot_handler <- function(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template = reactive(TEMPLATES$default), turnover_ratios = reactive(NULL), condition_metadata = reactive(NULL)) { +create_download_plot_handler <- function(output, input, contrast, preprocess_data, data_comparison, loadpage_input, app_template = reactive(TEMPLATES$default), condition_metadata = reactive(NULL)) { output[[NAMESPACE_STATMODEL$visualization_download_plot_results]] <- downloadHandler( filename = function() { get_download_plot_filename(input[[NAMESPACE_STATMODEL$visualization_plot_type]]) diff --git a/R/statmodel-ui-options-modeling.R b/R/statmodel-ui-options-modeling.R index 584392c..1abff00 100644 --- a/R/statmodel-ui-options-modeling.R +++ b/R/statmodel-ui-options-modeling.R @@ -31,21 +31,6 @@ create_moderation_radio_buttons <- function(ns) { ) } -create_response_curve_log_xaxis_checkbox <- function(ns, value = TRUE) { - checkboxInput( - ns(NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis), - label = tags$div("Log scale for treatment values", - class = "icon-wrapper", - icon("question-circle", lib = "font-awesome"), - div("Check this box to use a log scale for the x-axis of dose response curves. - This is typically used when doses are in a log scale (e.g. 0.1, 1, 10, 100). - But if your scale is linear, e.g. time 1, 2, 3 hours, then we recommend unchecking this box", - class = "icon-tooltip") - ), - value = value - ) -} - create_response_curve_increasing_trend_checkbox <- function(ns, value = FALSE) { checkboxInput( ns(NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend), diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index ce848d8..08f24db 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -101,24 +101,22 @@ create_heatmap_options <- function(ns) { #' Create response curve specific options #' @noRd -create_response_curve_options <- function(ns, is_protein_turnover = FALSE) { +create_response_curve_options <- function(ns) { tagList( uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)), uiOutput(ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug)), - if (!isTRUE(is_protein_turnover)) { - 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 - ) - } + 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 + ) ) } From 23705a5ec7fbd14b72d189be86bc6c0139b7fc21 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:24:11 -0400 Subject: [PATCH 08/13] remove build_response_curve_matrix --- R/module-statmodel-server.R | 20 ++++-- R/statmodel-server-comparisons.R | 67 +------------------- tests/testthat/test-utils-statmodel-server.R | 42 ------------ 3 files changed, 16 insertions(+), 113 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index af4fc0e..68dade6 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -164,8 +164,6 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, disable(NAMESPACE_STATMODEL$modeling_start) return() } - } else { - 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.") @@ -211,7 +209,21 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, showNotification("At least 2 conditions are required after exclusion.", type = "error") return() } - rc_matrix <- build_response_curve_matrix(filtered_conditions) + meta <- tryCatch(condition_metadata(), error = function(e) NULL) + if (is.null(meta) || nrow(meta) == 0 || !("DoseVal" %in% colnames(meta))) { + stop("Unable to build group metadata from the included conditions.") + } + meta <- meta[meta$Condition %in% filtered_conditions, , drop = FALSE] + if (nrow(meta) == 0) { + stop("Unable to build group metadata from the included conditions.") + } + is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(meta$Condition)) + rc_matrix <- data.frame( + GROUP = meta$Condition, + dose_value = convert_dose_to_molar(suppressWarnings(as.numeric(meta$DoseVal)), if ("DoseUnit" %in% colnames(meta)) meta$DoseUnit else "nM"), + drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), + stringsAsFactors = FALSE + ) if (is.null(rc_matrix) || nrow(rc_matrix) == 0) { stop("Unable to build group metadata from the included conditions.") } @@ -260,8 +272,6 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, stringsAsFactors = FALSE ) } - } else { - contrast$matrix = build_response_curve_matrix(condition_list()) } } diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 63ffded..13a728b 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -344,77 +344,12 @@ build_all_pair_contrast = function(input, condition_list, contrast, comp_list, r matrix[!(matrix$GROUP %in% excluded), , drop = FALSE] } -#' Build response curve matrix from condition list -#' -#' Parses condition names to extract dose, time, temperature, or treatment -#' information and creates a structured matrix for dose-response analysis. -#' -#' @param condition_list Character vector of condition names -#' -#' @return Data frame with parsed condition information -#' @noRd -build_response_curve_matrix = function(condition_list) { - matrix = data.frame(GROUP = as.character(condition_list)) - matrix = matrix %>% mutate( - is_control = str_detect(toupper(GROUP), "^(DMSO|CONTROL|VEHICLE)$"), - measurements = str_extract(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() - ) - ) - # Auto-fill empty drug names with "Treatment" for datasets without drug prefix - matrix$drug[is.na(matrix$drug) | matrix$drug == ""] <- "Treatment" - } - matrix = matrix %>% select(-is_control) - - return(matrix) -} - #' Prepare data for dose-response fitting #' #' Transforms data into MSstatsResponse-compatible format by selecting and #' renaming appropriate columns for dose-response analysis. #' -#' @param data Data frame from build_response_curve_matrix +#' @param data Data frame with GROUP, dose_value, and drug columns #' #' @return Data frame with columns: protein, drug, dose, response #' @noRd diff --git a/tests/testthat/test-utils-statmodel-server.R b/tests/testthat/test-utils-statmodel-server.R index 9b8728c..ede8b80 100644 --- a/tests/testthat/test-utils-statmodel-server.R +++ b/tests/testthat/test-utils-statmodel-server.R @@ -377,48 +377,6 @@ 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("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)) -}) - # ============================================================================ # Tests for update_matrix_from_edit # ============================================================================ From c1d3ff15565a6dcf95b968d2db260037061d7cf6 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:27:56 -0400 Subject: [PATCH 09/13] clean up chemo changes --- R/module-statmodel-server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 68dade6..0e18f35 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -68,7 +68,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, )) updateCheckboxInput(session, NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend, value = FALSE) } - }, ignoreInit = TRUE) + }, ignoreInit = FALSE) # UI visibility observe({ From 1209f4c77457d80fff1073429cc9cd5013a0467e Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:34:44 -0400 Subject: [PATCH 10/13] assume multiple drugs --- R/statmodel-server-comparisons.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 13a728b..7c8df5f 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -27,14 +27,15 @@ parse_dose_unit_from_conditions <- function(conditions) { #' @noRd parse_drug_name_from_conditions <- function(conditions) { is_ctrl <- grepl("^(dmso|control|vehicle)$", tolower(trimws(conditions))) - non_ctrl <- conditions[!is_ctrl] - if (length(non_ctrl) == 0) return("Treatment") - prefixes <- gsub("[_ .-]?[0-9.]+[a-zA-Z]+.*$", "", non_ctrl) + result <- character(length(conditions)) + result[is_ctrl] <- conditions[is_ctrl] + non_ctrl_idx <- which(!is_ctrl) + if (length(non_ctrl_idx) == 0) return(result) + prefixes <- gsub("[_ .-]?[0-9.]+[a-zA-Z]+.*$", "", conditions[non_ctrl_idx]) prefixes <- trimws(prefixes, whitespace = "[ _\t.-]") - prefixes <- prefixes[nchar(prefixes) > 0] - if (length(prefixes) == 0) return("Treatment") - drug_name <- names(sort(table(prefixes), decreasing = TRUE))[1] - if (is.null(drug_name) || nchar(drug_name) == 0) "Treatment" else drug_name + prefixes[nchar(prefixes) == 0] <- "Treatment" + result[non_ctrl_idx] <- prefixes + result } #' Auto-fill numeric dose/time value from condition name From 1cabfedafc8a919209aad7fd05f5c9c23f14d120 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:36:43 -0400 Subject: [PATCH 11/13] fire a warning for NA dose value --- R/statmodel-server-comparisons.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/statmodel-server-comparisons.R b/R/statmodel-server-comparisons.R index 7c8df5f..4f66be8 100644 --- a/R/statmodel-server-comparisons.R +++ b/R/statmodel-server-comparisons.R @@ -45,6 +45,18 @@ autofill_condition_value <- function(conditions) { measurement <- str_extract(conditions, "[0-9.]+[a-zA-Z]+") value <- suppressWarnings(as.numeric(str_extract(measurement, "[0-9.]+"))) value[is_ctrl] <- 0 + failed <- conditions[!is_ctrl & is.na(value)] + if (length(failed) > 0) { + showNotification( + paste0( + "Could not parse a dose value from: ", + paste(failed, collapse = ", "), + ". Edit the metadata table to enter values manually." + ), + type = "warning", + duration = 10 + ) + } value } From 55e98c70179b9e245e38e337afa89b3f6f06283d Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:42:25 -0400 Subject: [PATCH 12/13] fix viz --- R/statmodel-server-visualization.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 4b6e0e7..2bc49c3 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -56,15 +56,11 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da drug = ifelse(is_ctrl, meta$Condition, if ("DrugName" %in% colnames(meta)) meta$DrugName else parse_drug_name_from_conditions(meta$Condition)), stringsAsFactors = FALSE ) - } else { - rc_mat <- contrast$matrix } - } else { - rc_mat <- contrast$matrix } response_curve_setup_matrix = prepare_dose_response_fit(rc_mat) unique_drugs = unique(response_curve_setup_matrix$drug) - unique_drugs_without_control = unique_drugs[unique_drugs != "DMSO"] + unique_drugs_without_control = unique_drugs[!grepl("^(dmso|control|vehicle)$", tolower(unique_drugs))] selectInput(session$ns(NAMESPACE_STATMODEL$visualization_response_curve_which_drug), label = h5("Select Treatment"), unique_drugs_without_control, selected = unique_drugs_without_control[[1]]) From b567170f52be283d4c833c8b59643831dd118d71 Mon Sep 17 00:00:00 2001 From: Tony Wu Date: Tue, 21 Apr 2026 21:51:08 -0400 Subject: [PATCH 13/13] fix tests --- man/expdesServer.Rd | 4 +- man/loadpageServer.Rd | 2 +- man/statmodelServer.Rd | 5 ++- tests/testthat/test-module-expdes-server.R | 41 ------------------- tests/testthat/test-module-statmodel-server.R | 2 +- tests/testthat/test-utils-statmodel-server.R | 3 +- 6 files changed, 9 insertions(+), 48 deletions(-) diff --git a/man/expdesServer.Rd b/man/expdesServer.Rd index c1089d9..2deb8ec 100644 --- a/man/expdesServer.Rd +++ b/man/expdesServer.Rd @@ -11,7 +11,7 @@ expdesServer( parent_session, loadpage_input, qc_input, - statmodel_input, + app_template = reactive(TEMPLATES$default), data_comparison, preprocess_data = NULL, statmodel_contrast = NULL @@ -30,7 +30,7 @@ expdesServer( \item{qc_input}{input object from QC UI} -\item{statmodel_input}{input object from Statmodel UI} +\item{app_template}{reactive returning the selected template name} \item{data_comparison}{function for group comparisons} diff --git a/man/loadpageServer.Rd b/man/loadpageServer.Rd index 19d6f4e..d0bae84 100644 --- a/man/loadpageServer.Rd +++ b/man/loadpageServer.Rd @@ -4,7 +4,7 @@ \alias{loadpageServer} \title{Loadpage Server module for data selection and upload server.} \usage{ -loadpageServer(id, parent_session, is_web_server = FALSE) +loadpageServer(id, parent_session, is_web_server = FALSE, app_template = NULL) } \arguments{ \item{id}{namespace prefix for the module} diff --git a/man/statmodelServer.Rd b/man/statmodelServer.Rd index e5e423b..be4609a 100644 --- a/man/statmodelServer.Rd +++ b/man/statmodelServer.Rd @@ -10,7 +10,10 @@ statmodelServer( loadpage_input, qc_input, get_data, - preprocess_data + preprocess_data, + app_template = reactive(TEMPLATES$default), + turnover_ratios = reactive(NULL), + condition_metadata = reactive(NULL) ) } \arguments{ diff --git a/tests/testthat/test-module-expdes-server.R b/tests/testthat/test-module-expdes-server.R index ccca5c4..db06b14 100644 --- a/tests/testthat/test-module-expdes-server.R +++ b/tests/testthat/test-module-expdes-server.R @@ -39,47 +39,6 @@ test_that("get_concentrations_from_matrix returns sorted unique values", { expect_equal(result, c(0, 10, 100)) }) -# ============================================================================ -# EXPDES MODE BRANCHING TESTS -# ============================================================================ - -test_that("is_response_curve_mode returns TRUE for dose response mode", { - mock_input <- list() - mock_input[[NAMESPACE_STATMODEL$comparison_mode]] <- - CONSTANTS_STATMODEL$comparison_mode_response_curve - - expect_true(MSstatsShiny:::.is_response_curve_mode(mock_input)) -}) - -test_that("is_response_curve_mode returns FALSE for all standard comparison modes", { - standard_modes <- 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 - ) - - for (mode in standard_modes) { - mock_input <- list() - mock_input[[NAMESPACE_STATMODEL$comparison_mode]] <- mode - expect_false(MSstatsShiny:::.is_response_curve_mode(mock_input), - info = paste("Should be FALSE for mode:", mode)) - } -}) - -test_that("is_response_curve_mode returns FALSE for NULL input", { - expect_false(MSstatsShiny:::.is_response_curve_mode(NULL)) -}) - -test_that("is_response_curve_mode returns FALSE when comparison_mode is missing", { - mock_input <- list(some_other_field = "value") - expect_false(MSstatsShiny:::.is_response_curve_mode(mock_input)) -}) - -test_that("is_response_curve_mode returns FALSE for empty list", { - expect_false(MSstatsShiny:::.is_response_curve_mode(list())) -}) - # ============================================================================ # EXCLUDE CONDITIONS TESTS # ============================================================================ diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index e47aaae..7d6d35f 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -726,7 +726,7 @@ test_that("create_download_plot_handler is invoked with all 6 arguments", { { expect_true(handler_called, info = "create_download_plot_handler should be called during server init") - expect_equal(length(handler_args), 6, + expect_equal(length(handler_args), 8, info = "create_download_plot_handler should receive 6 arguments") } ) diff --git a/tests/testthat/test-utils-statmodel-server.R b/tests/testthat/test-utils-statmodel-server.R index ede8b80..23efbb5 100644 --- a/tests/testthat/test-utils-statmodel-server.R +++ b/tests/testthat/test-utils-statmodel-server.R @@ -464,13 +464,12 @@ test_that("generate_analysis_code passes response curve parameters correctly", { mock_input = list() mock_input[[NAMESPACE_STATMODEL$comparison_mode]] = CONSTANTS_STATMODEL$comparison_mode_response_curve mock_input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] = TRUE - mock_input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]] = FALSE mock_input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]] = FALSE result = generate_analysis_code(list(), list(), comp_mat, mock_input) expect_true(grepl("increasing = TRUE", result)) - expect_true(grepl("transform_dose = FALSE", result)) + expect_true(grepl("transform_dose = TRUE", result)) # doseResponseFit always hardcodes ratio_response = FALSE expect_true(grepl("doseResponseFit[^)]*ratio_response = FALSE", result)) # visualizeResponseProtein uses the checkbox value (FALSE in this case)