refactor(chemoproteomics): Create a template for chemoproteomics workflows

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",

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$chemoproteomics)
   })
 
   # Render sidebar controls based on analysis mode
@@ -146,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)
 
@@ -170,7 +161,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()

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")),

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,72 @@ 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
+      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)) {
+            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) {
+            condition_metadata(NULL)
+            showNotification(
+                paste("Could not initialize condition metadata:", conditionMessage(e)),
+                type = "warning",
+                duration = 6
+            )
+        })
+      }
+
       ### outputs ###
       get_summary = reactive({
         if(is.null(get_data())) {
@@ -469,11 +533,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 +570,8 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE) {
     return(
       list(
         input = input,
-        getData = get_data
+        getData = get_data,
+        getConditionMetadata = condition_metadata
       )
     )
   })

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")),