From 498ae4bac9da766d19df156b674e579e36f06882 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Tue, 30 Jun 2026 13:21:48 -0400 Subject: [PATCH 1/2] Refactor the QC page --- R/constants.R | 53 +- R/module-qc-server.R | 637 +--------------------- R/module-qc-ui.R | 254 +++++---- R/qc-server-downloads.R | 84 +++ R/qc-server-plots.R | 207 +++++++ R/qc-server-sidebar.R | 345 ++++++++++++ R/qc-server-summary.R | 80 +++ R/qc-server-turnover.R | 129 +++++ tests/testthat/test-module-qc-ui.R | 56 ++ tests/testthat/test-qc-server-rendering.R | 131 +++++ 10 files changed, 1242 insertions(+), 734 deletions(-) create mode 100644 R/qc-server-downloads.R create mode 100644 R/qc-server-plots.R create mode 100644 R/qc-server-sidebar.R create mode 100644 R/qc-server-summary.R create mode 100644 R/qc-server-turnover.R create mode 100644 tests/testthat/test-module-qc-ui.R create mode 100644 tests/testthat/test-qc-server-rendering.R diff --git a/R/constants.R b/R/constants.R index 8c9bbfd..de0be09 100644 --- a/R/constants.R +++ b/R/constants.R @@ -113,11 +113,62 @@ NAMESPACE_LOADPAGE = list( tmt_options_ui = "tmt_options_ui" ) +NAMESPACE_QC = list( + # Sidebar processing-option input ids + global_norm = "global_norm", + log = "log", + summarization = "summarization", + null = "null", + max_qc = "maxQC", + norm = "norm", + standards = "standards", + names = "names", + reference_norm = "reference_norm", + remove_norm_channel = "remove_norm_channel", + features_used = "features_used", + n_feat = "n_feat", + cens_int = "censInt", + null1 = "null1", + max_qc_censored = "maxQC1", + mbi = "MBi", + remove50 = "remove50", + summary_method = "summaryMethod", + # Summarized-results, plot and download-tab input ids + typequant = "typequant", + format = "format", + summ = "summ", + fname = "fname", + type1 = "type1", + which = "which", + quality_metric = "quality_metric", + qm_protein = "qm_protein", + run = "run", + update_results = "update_results", + proceed6 = "proceed6", + # Server-toggled sidebar visibility containers + global_norm_panel = "global_norm_panel", + log_section = "log_section", + summarization_panel = "summarization_panel", + maxqc_msstats_panel = "maxqc_msstats_panel", + norm_panel = "norm_panel", + standards_panel = "standards_panel", + standards_type_section = "standards_type_section", + reference_norm_panel = "reference_norm_panel", + lf_options_panel = "lf_options_panel", + features_topn_panel = "features_topn_panel", + censoring_section = "censoring_section", + mbi_panel = "mbi_panel", + # Server-toggled plot-tab and download-tab visibility containers + profileplot_options_panel = "profileplot_options_panel", + qualitymetrics_options_panel = "qualitymetrics_options_panel", + nonptm_downloads_panel = "nonptm_downloads_panel", + ptm_downloads_panel = "ptm_downloads_panel" +) + NAMESPACE_EXPDES = list( sidebar_controls = "sidebar_controls", protein_select = "protein_select", rep_range = "rep_range", run_simulation = "run_simulation", - result_plot = "result_plot", download_future = "download_future" ) \ No newline at end of file diff --git a/R/module-qc-server.R b/R/module-qc-server.R index 6611e22..c95341b 100644 --- a/R/module-qc-server.R +++ b/R/module-qc-server.R @@ -9,227 +9,18 @@ #' @param parent_session session of the main calling module #' @param loadpage_input input object from loadpage UI #' @param get_data stored function that returns the data from loadpage -#' +#' #' @return input object with user selected options #' #' @export #' @examples #' NA -#' +#' qcServer <- function(input, output, session, parent_session, loadpage_input, get_data, app_template = NULL, get_condition_metadata = NULL) { - output$Names = renderUI({ - ns <- session$ns - - if (!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) { - return(selectizeInput(ns("names"), "Standard name", - choices = "unlabeled", selected = "unlabeled", - multiple = TRUE)) - } - - if (input$standards == "Proteins") { - selectizeInput(ns("names"), "choose standard", unique(get_data()$ProteinName), multiple = TRUE) - } - else if (input$standards == "Peptides") { - selectizeInput(ns("names"), "choose standard", unique(get_data()$PeptideSequence), multiple = TRUE) - } - - }) - - observeEvent(app_template(), { - req(!is.null(app_template)) - if (app_template() == TEMPLATES$protein_turnover) { - showTab(inputId = "qc_tabs", target = "Turnover Ratios", session = session) - shinyjs::hide("log_section") - shinyjs::hide("censoring_section") - shinyjs::hide("standards_type_section") - updateSelectInput(session, "norm", - choices = c("none" = "FALSE", "global standards" = "globalStandards"), - selected = "FALSE") - updateRadioButtons(session, "features_used", - choices = c("Use all features" = "all"), - selected = "all") - } else { - hideTab(inputId = "qc_tabs", target = "Turnover Ratios", session = session) - shinyjs::show("log_section") - shinyjs::show("censoring_section") - shinyjs::show("standards_type_section") - updateSelectInput(session, "norm", - choices = c("none" = "FALSE", "equalize medians" = "equalizeMedians", - "quantile" = "quantile", "global standards" = "globalStandards"), - selected = "equalizeMedians") - updateRadioButtons(session, "features_used", - choices = c("Use all features" = "all", "Use top N features" = "topN", - "Remove uninformative features & outliers" = "highQuality"), - selected = "all") - } - }, ignoreNULL = TRUE) - - # toggle censoring input based on type of experiment - - observe({ - if(!is.null(loadpage_input()$filetype)) { - runjs("$('[type=radio][name=censInt]:disabled').parent().parent().parent().find('div.radio').css('opacity', 1)") - enable("censInt") - if (loadpage_input()$filetype == "sky" || loadpage_input()$filetype == "prog" || loadpage_input()$filetype == "spec") { - disable(selector = "[type=radio][value=NA]") - runjs("$.each($('[type=radio][name=censInt]:disabled'), function(_, e){ $(e).parent().parent().css('opacity', 0.4) })") - } - else if (loadpage_input()$filetype == "maxq" || loadpage_input()$filetype == "PD" || loadpage_input()$filetype == "open") { - disable(selector = "[type=radio][value=0]") - runjs("$.each($('[type=radio][name=censInt]:disabled'), function(_, e){ $(e).parent().parent().css('opacity', 0.4) })") - } - } - }) - - observe ({ - shinyjs::toggleState("maxQC", input$null == FALSE) - }) - - - # features - - output$features = renderUI({ - ns <- session$ns - req(get_data()) - max_feat = reactive({ - ## Old code for only 20 features. Meena thought this should be all uniques - ## TODO: Need to fix this bc hard to be specific with slider. - # if (nrow(unique(get_data()[1])) < 20) { - # m_feat = nrow(unique(get_data()[1])) - # } - # else - # { - # m_feat = 20 - # } - - if (loadpage_input()$BIO =="PTM"){ - m_feat = nrow(unique(get_data()$PTM[1])) - } else { - m_feat = nrow(unique(get_data()[1])) - } - - return(m_feat) - }) - sliderInput(ns("n_feat"), "Number of top features to use", 1, - as.numeric(max_feat()), 1) - }) - - observe ({ - toggleState("n_feat", input$all_feat == FALSE) - }) - - # which protein to plot (will add "all" for QCPlot) - - output$Which = renderUI({ - ns <- session$ns - req(input$type1) - if (input$type1 == "QualityMetricsPlot") { - return(NULL) - } - if ((loadpage_input()$BIO!="PTM" && input$type1 == "QCPlot")) { - selectizeInput(ns("which"), "Show plot for", - choices = c("", "ALL PROTEINS" = "allonly", - unique(get_data()$ProteinName))) - } else if (loadpage_input()$BIO == "PTM"){ - if (input$type1 == "QCPlot"){ - selectizeInput(ns("which"), "Show plot for", - choices = c("", "ALL PROTEINS" = "allonly", - unique(get_data()$PTM[1]))) - } else { - selectizeInput(ns("which"), "Show plot for", - choices = c("", unique(get_data()$PTM[1]))) - } - } else { - selectizeInput(ns("which"), "Show plot for", - choices = c("", unique(get_data()$ProteinName))) - } - }) - - output$plotTypeUI <- renderUI({ - ns <- session$ns - - choices <- c("Quality Control Plots" = "QCPlot", - "Profile Plots" = "ProfilePlot") - - if (.anomaly_scores_enabled(loadpage_input())) { - choices <- c(choices, "Quality Metrics Plots" = "QualityMetricsPlot") - } - - selectInput(ns("type1"), - label = h5("Select plot type", - class = "icon-wrapper", - icon("question-circle", lib = "font-awesome"), - div("For details on plotting options please see the Help tab.", - class = "icon-tooltip")), - choices = choices) - }) - - output$qualityMetricSelector <- renderUI({ - ns <- session$ns - req(get_data()) - - std_cols <- c("ProteinName", "PeptideSequence", "PeptideModifiedSequence", - "PrecursorCharge", "FragmentIon", "ProductCharge", - "IsotopeLabelType", "Condition", "BioReplicate", "Run", - "TechReplicate", "StandardType", "Fraction", - "DetectionQValue", "Intensity") - data_cols <- colnames(get_data()) - metric_cols <- setdiff(data_cols, std_cols) - - if ("AnomalyScores" %in% metric_cols) { - metric_cols <- c("AnomalyScores", setdiff(metric_cols, "AnomalyScores")) - } - - if (length(metric_cols) == 0) { - return(p("No quality metric columns found in the data.")) - } + # ---- Core summarization reactives ---- - protein_choices <- unique(get_data()$ProteinName) - - tagList( - selectInput(ns("quality_metric"), - label = h5("Quality metric"), - choices = metric_cols, - selected = metric_cols[1]), - selectizeInput(ns("qm_protein"), - label = h5("Show plot for"), - choices = c("", protein_choices)) - ) - }) - - output$summaryMethodUI <- renderUI({ - ns <- session$ns - - # Default choices - choices <- c("TMP" = "TMP") - tooltip_text <- "Run-level summarization method. TMP is Tukey's Median Polish. " - selected <- "TMP" - - # Conditionally add MSstats+ if anomaly score calculation is checked - # (Spectronaut, regular DIANN, or big-file DIANN). - if (.anomaly_scores_enabled(loadpage_input())) { - choices <- c(choices, "MSstats+" = "linear") - tooltip_text <- paste0(tooltip_text, "MSstats+ uses a weighted linear model.") - selected = "linear" - } - - radioButtons( - ns("summaryMethod"), - label = h4( - "6. Summarization", - class = "icon-wrapper", - icon("question-circle", lib = "font-awesome"), - div(tooltip_text, class = "icon-tooltip") - ), - choices = choices, - selected = selected - ) - }) - - # preprocess data preprocess_data = eventReactive(input$run, { qc_input <- reactive({ @@ -266,436 +57,50 @@ qcServer <- function(input, output, session, parent_session, loadpage_input, get }) preprocessDataCode(qc_input(),loadpage_input()) }) - - plotresult = function(saveFile, protein, summary, original, file) { - if (input$which != "") { - if (loadpage_input()$BIO == "PTM"){ - plot = dataProcessPlotsPTM(preprocess_data(), - type=input$type1, - which.PTM = protein, - originalPlot = original, - summaryPlot = input$summ, - address = file, - isPlotly = TRUE - )[[1]] - return(plot) - } else if(loadpage_input()$DDA_DIA == "TMT"){ - plot <- dataProcessPlotsTMT(preprocess_data(), - type=input$type1, - featureName = input$fname, - ylimUp = FALSE, - ylimDown = FALSE, - which.Protein = protein, - originalPlot = original, - summaryPlot = input$summ, - address = file, isPlotly = TRUE - )[[1]] - return(plot) - } else { - plot <- dataProcessPlots(data = ordered_preprocess_data(), - type=input$type1, - featureName = input$fname, - ylimUp = FALSE, - ylimDown = FALSE, - scale = input$cond_scale, - interval = input$interval, - which.Protein = protein, - originalPlot = original, - summaryPlot = input$summ, - save_condition_plot_result = FALSE, - address = file, - isPlotly = TRUE - )[[1]] - return(plot) - } - } - else { - return(NULL) - } - } - - # statistics (for ConditionPlot) - - statistics = reactive({ - sub = preprocess_data()$ProteinLevelData[which(preprocess_data()$ProteinLevelData$Protein == input$which),] - len = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, length, data = sub) - colnames(len)[colnames(len)=="sub$LogIntensities"] = "Number_of_Measurements" - sd = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, sd, data = sub) - colnames(sd)[colnames(sd)=="sub$LogIntensities"] = "Standard_Deviation" - mean = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, mean, data = sub) - colnames(mean)[colnames(mean)=="sub$LogIntensities"] = "Mean" - tab = merge(len, sd, by="sub$GROUP_ORIGINAL") - tab = merge(mean, tab, by="sub$GROUP_ORIGINAL") - colnames(tab)[colnames(tab)=="sub$GROUP_ORIGINAL"] = "Condition" - SE = tab$Standard_Deviation/sqrt(tab$Number_of_Measurements) - tab$CI_width = qt(.975, df=tab$Number_of_Measurement)*SE - CI_Limits = c(tab$Mean-tab$CI, tab$Mean+tab$CI) - - return(tab) - }) - - + # ---- Run caption and "Next step" navigation to the statistical model page ---- + cap = eventReactive(input$run, { text_output = "Protein abundance have been estimated, use the tabs below to download and plot the results." }) - + observeEvent(input$run, { output$submit.button = renderUI({ ns <- session$ns actionButton(inputId = ns("proceed6"),label = "Next step") }) - - + + }) - + output$caption = renderText({ cap() }) - - observeEvent(input$run,{ - - if(loadpage_input()$BIO=="PTM"){ - enable("prepr_csv_ptm") - enable("summ_csv_ptm") - enable("prepr_csv_prot") - enable("summ_csv_prot") - } else { - enable("prepr_csv") - enable("summ_csv") - } - - }) - - # download preprocessed data - - output$prepr_csv = downloadHandler( - filename = function() { - paste("Feature_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - if(loadpage_input()$DDA_DIA=='TMT'){ - - write.csv(preprocess_data()$FeatureLevelData, file, row.names = FALSE) - - } - else{ - - write.csv(preprocess_data()$FeatureLevelData, file, row.names = FALSE) - } - - } - ) - - output$prepr_csv_ptm = downloadHandler( - filename = function() { - paste("PTM_Feature_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(preprocess_data()$PTM$FeatureLevelData, file, row.names = FALSE) - } - ) - - output$prepr_csv_prot = downloadHandler( - filename = function() { - paste("Protein_Feature_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(preprocess_data()$PROTEIN$FeatureLevelData, file, row.names = FALSE) - } - ) - - output$summ_csv = downloadHandler( - filename = function() { - paste("Protein_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(preprocess_data()$ProteinLevelData, file, row.names = FALSE) - } - ) - - output$summ_csv_ptm = downloadHandler( - filename = function() { - paste("PTM_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(preprocess_data()$PTM$ProteinLevelData, file, row.names = FALSE) - } - ) - - output$summ_csv_prot = downloadHandler( - filename = function() { - paste("Protein_level_data-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(preprocess_data()$PROTEIN$ProteinLevelData, file, row.names = FALSE) - } - ) - - # download/view plots - output$saveplot = downloadHandler( - filename = function() { - paste("SummaryPlot-", Sys.Date(), ".pdf", sep="") - }, - content = function(file) { - pdf(file) - plotresult(TRUE, input$which, FALSE, TRUE, FALSE) - dev.off() - } - ) - - output$showplot = renderUI({ - ns<- session$ns - output$theplot = renderPlotly(theplot()) - op <- div( - style = "overflow-x: auto; width: 100%;", - div( - style = "min-width: 1400px;", - plotlyOutput(ns("theplot"), width = "100%") - ) - ) - tagList( - op, - conditionalPanel(condition = "input['qc-type'] == 'ConditionPlot' && input['qc-which'] != ''", - tableOutput(ns("stats"))), - tags$br(), - enable("saveplot") - ) - }) - - theplot = reactive({ - if (!is.null(input$type1) && input$type1 == "QualityMetricsPlot") { - req(get_data()) - req(input$quality_metric) - req(input$qm_protein != "") - return(MSstats::MSstatsQualityMetricsPlot( - get_data(), - metric = input$quality_metric, - which.Protein = input$qm_protein, - isPlotly = TRUE - )) - } - if (input$summ == FALSE) { - output = plotresult(FALSE, input$which, FALSE, TRUE, FALSE) - } - else if (input$summ == TRUE) { - output = plotresult(FALSE, input$which, TRUE, FALSE, FALSE) - } - return(output) - }) - - # quantification - - abundant = reactiveValues() - - observeEvent(loadpage_input()$proceed1, { - abundant$results = NULL - }) - - abundance = eventReactive(input$update_results, { - validate(need(preprocess_data(), - message = "PLEASE COMPLETE DATA PROCESSING")) - - if (loadpage_input()$BIO == "PTM" && loadpage_input()$DDA_DIA == "TMT"){ - temp = copy(preprocess_data()) - setnames(temp$PTM$ProteinLevelData, - c("Abundance", "Condition", "BioReplicate"), - c("LogIntensities", "GROUP", "SUBJECT")) - abundant$results = quantification(temp$PTM, - type = input$typequant, - format = input$format, - use_log_file = FALSE) - } else if (loadpage_input()$BIO == "PTM" && loadpage_input()$DDA_DIA != "TMT"){ - temp = copy(preprocess_data()) - abundant$results =quantification(temp$PTM, - type = input$typequant, - format = input$format, - use_log_file = FALSE) - } else if (loadpage_input()$DDA_DIA == "TMT"){ - temp = copy(preprocess_data()) - temp$ProteinLevelData = copy(temp$ProteinLevelData) - setnames(temp$ProteinLevelData, - c("Abundance", "Condition", "BioReplicate"), - c("LogIntensities", "GROUP", "SUBJECT")) - abundant$results = quantification(temp, - type = input$typequant, - format = input$format, - use_log_file = FALSE) - } else if (!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) { - # TODO: Refactor quantification function to handle LABEL column - abundant$results <- preprocess_data()$ProteinLevelData - } else{ - temp = copy(preprocess_data()) - abundant$results =quantification(temp, - type = input$typequant, - format = input$format, - use_log_file = FALSE) - } - - return(abundant$results) - }) - - output$stats = renderTable(statistics()) - - output$abundance = renderUI({ - ns <- session$ns - req(abundance()) - if (is.null(abundant$results)) { - tagList( - tags$br()) - } else { - tagList( - dataTableOutput(ns("abundanceTable")) ) - } - }) - output$abundanceTable = renderDataTable(abundance()) - - + enable("proceed6") observeEvent(preprocess_data(),{ enable("proceed6") }) - + onclick("proceed6", { updateTabsetPanel(session = parent_session, inputId = "tablist", selected = "StatsModel") }) - - # downloads - - output$download_summary = downloadHandler( - filename = function() { - paste("Abundance-", Sys.Date(), ".csv", sep="") - }, - content = function(file) { - write.csv(abundance(), file) - } - ) - + # not used observeEvent(input$proceed4, { updateTabsetPanel(session = parent_session, inputId = "tablist", selected = "StatsModel") }) - # ---- Protein Turnover: tracer constants form and ratio calculation ---- - - output$turnover_ratios_sidebar <- renderUI({ - req(!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) - req(get_data()) - - req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) - ns <- session$ns - conditions <- as.character(get_condition_metadata()$Condition) - - tracer_inputs <- lapply(conditions, function(cond) { - input_id <- ns(paste0("tracer_", make.names(cond))) - fluidRow( - column(6, p(strong(cond))), - column(6, numericInput(input_id, NULL, value = 1.0, min = 0, max = 1, step = 0.001)) - ) - }) - - tagList( - tags$hr(), - h4("Turnover Ratio Calculation"), - p("Enter tracer constants (0 to 1) for each condition:"), - tagList(tracer_inputs) - ) - }) - turnover_ratios <- eventReactive(input$run, { - req(!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) - req(preprocess_data()) - - req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) - conditions <- as.character(get_condition_metadata()$Condition) - tracer_consts <- sapply(conditions, function(cond) { - val <- input[[paste0("tracer_", make.names(cond))]] - if (is.null(val)) 1.0 else as.numeric(val) - }) - names(tracer_consts) <- conditions + # ---- Tab-specific server logic ---- - # Use ProteinLevelData when any condition has more than one sample (run); - # fall back to FeatureLevelData for purely single-replicate designs. - pld <- preprocess_data()$ProteinLevelData - samples_per_condition <- tapply(pld$RUN, pld$GROUP, function(x) length(unique(x))) - use_protein_level <- any(samples_per_condition > 1) - - if (use_protein_level) { - calculateTurnoverRatios( - pld, - channel_col = "LABEL", - heavy_label = "H", - light_label = "L", - time_col = "GROUP", - peptide_col = "Protein", - protein_col = "Protein", - intensity_col = "LogIntensities", - run_col = "RUN", - peptide_selector = NULL, - agg_function = max, - normalize_tracer = TRUE, - tracer_constants = tracer_consts - ) - } else { - calculateTurnoverRatios( - preprocess_data()$FeatureLevelData, - channel_col = "LABEL", - heavy_label = "H", - light_label = "L", - time_col = "GROUP", - peptide_col = "PEPTIDE", - protein_col = "PROTEIN", - intensity_col = "INTENSITY", - run_col = "RUN", - peptide_selector = NULL, - agg_function = max, - normalize_tracer = TRUE, - tracer_constants = tracer_consts - ) - } - }) - - observeEvent(input$run, { - req(!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) - turnover_ratios() - }, ignoreInit = TRUE) - - output$turnover_ratios_panel <- renderUI({ - req(!is.null(app_template) && !is.null(app_template()) && - app_template() == TEMPLATES$protein_turnover) - - ns <- session$ns - tagList( - tags$br(), - p("Run protein summarization after filling in tracer constants in the side panel."), - uiOutput(ns("turnover_ratios_table_ui")), - tags$br(), - disabled(downloadButton(ns("download_turnover_ratios"), "Download Ratios")) - ) - }) - - output$turnover_ratios_table_ui <- renderUI({ - req(turnover_ratios()) - ns <- session$ns - enable("download_turnover_ratios") - dataTableOutput(ns("turnover_ratios_table")) - }) - - output$turnover_ratios_table <- renderDataTable({ - turnover_ratios() - }) - - output$download_turnover_ratios <- downloadHandler( - filename = function() { - paste0("Turnover_Ratios-", Sys.Date(), ".csv") - }, - content = function(file) { - write.csv(turnover_ratios(), file, row.names = FALSE) - } - ) + register_qc_visibility_observers(input, session, loadpage_input, app_template) + register_qc_sidebar_options(input, output, session, loadpage_input, get_data, app_template) + register_qc_plots(input, output, session, loadpage_input, get_data, + preprocess_data, ordered_preprocess_data) + register_qc_summary(input, output, session, loadpage_input, preprocess_data, app_template) + register_qc_downloads(input, output, session, loadpage_input, preprocess_data) + turnover_ratios <- register_qc_turnover(input, output, session, app_template, get_data, + get_condition_metadata, preprocess_data) return( list( diff --git a/R/module-qc-ui.R b/R/module-qc-ui.R index f729573..2ac9085 100644 --- a/R/module-qc-ui.R +++ b/R/module-qc-ui.R @@ -1,16 +1,16 @@ #' QC UI module for data processing UI. #' -#' This function sets up the QC UI where it consists of several, +#' This function sets up the QC UI where it consists of several, #' options for users to process data based on previously selected fragments. #' #' @param id namespace prefix for the module -#' +#' #' @return This function returns nothing, as it sets up the QC UI #' #' @export #' @examples #' NA -#' +#' qcUI <- function(id) { ns <- NS(id) tagList( @@ -25,95 +25,105 @@ qcUI <- function(id) { p("Feature summarization and missing value imputation. Includes options for visualizing summarization through data tables and multiple plots. Summarized tables and processed datasets are available to download in CSV format. Imputation runs only when a feature is observed in some other run AND the protein has at least one observed feature in the current run."), tags$br(), sidebarPanel( - # transformation - conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", - 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)), - - div(id = ns("log_section"), - 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("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"))) - ), - - + # Peptide-level (global median) normalization: TMT branch + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$global_norm_panel), + 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) + )), + + # Log transformation: label-free branch, also hidden for protein turnover + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$log_section), + radioButtons(ns("log"), + 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")) + )), + + tags$hr(), - - conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", - selectInput(ns("summarization"), - 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", - "Log(Sum)" = "LogSum","Median" = "Median"), - selected = "log")), - - conditionalPanel(condition = "(input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))) && input['qc-summarization'] == 'msstats'", - checkboxInput(ns("null"), label =tags$div("Do not apply cutoff",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), - div("Maximum quantile for deciding censored missing values, default is 0.999", class = "icon-tooltip")) - ), - numericInput(ns("maxQC"), NULL, 0.999, 0.000, 1.000, 0.001)), - - # Normalization - conditionalPanel(condition = "input['loadpage-DDA_DIA'] == 'LType'", - selectInput(ns("norm"), - 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("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"), - selected = "equalizeMedians")), - conditionalPanel(condition = "input['qc-norm'] == 'globalStandards' && (input['loadpage-BIO'] !== 'PTM' && input['loadpage-DDA_DIA'] !== 'TMT')", - div(id = ns("standards_type_section"), - radioButtons(ns("standards"), "Choose type of standards", - c("Proteins", "Peptides")) - ), - uiOutput(ns("Names"))), + + # Summarization method: TMT branch + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$summarization_panel), + selectInput(ns("summarization"), + 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", + "Log(Sum)" = "LogSum","Median" = "Median"), + selected = "log") + )), + + # Maximum censored quantile: TMT branch with MSstats summarization + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$maxqc_msstats_panel), + checkboxInput(ns("null"), label =tags$div("Do not apply cutoff",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + div("Maximum quantile for deciding censored missing values, default is 0.999", class = "icon-tooltip")) + ), + numericInput(ns("maxQC"), NULL, 0.999, 0.000, 1.000, 0.001) + )), + + # Normalization: label-free branch + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$norm_panel), + selectInput(ns("norm"), + 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") + )), + + # Global-standards selection: label-free, non-PTM, when norm is globalStandards + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$standards_panel), + div(id = ns(NAMESPACE_QC$standards_type_section), + radioButtons(ns("standards"), "Choose type of standards", + c("Proteins", "Peptides")) + ), + uiOutput(ns("Names")) + )), tags$hr(), - - conditionalPanel( - condition = "input['loadpage-DDA_DIA'] == 'TMT' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] == 'TMT'))", + + # Reference-channel normalization and filtering: TMT branch + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$reference_norm_panel), 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("Filtering"), checkboxInput(ns("remove_norm_channel"), "Remove normalization channel", value = TRUE) - - ), - - - conditionalPanel( - condition = "input['loadpage-DDA_DIA'] == 'LType' || (input['loadpage-BIO'] == 'PTM' && (input['loadpage-BIO'] == 'PTM' && input['loadpage-DDA_DIA'] != 'TMT'))", - + )), + + # Feature subset, missing-value handling, imputation and summary method: label-free branch + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$lf_options_panel), + # features - + #h4("3. Used features"), radioButtons(ns("features_used"), label = h4("Feature subset",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), - div("What features to use in \ + div("What features to use in \ summarization. All features or a subset of \ features can be used.", class = "icon-tooltip")), - c("Use all features" = "all", "Use top N features" = "topN", + c("Use all features" = "all", "Use top N features" = "topN", "Remove uninformative features & outliers" = "highQuality")), #), #checkboxInput("all_feat", "Use all features", value = TRUE), - conditionalPanel(condition = "input['qc-features_used'] =='topN'", - uiOutput(ns("features"))), + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$features_topn_panel), + uiOutput(ns("features")) + )), #uiOutput("features"), tags$hr(), - + ### censoring - div(id = ns("censoring_section"), + div(id = ns(NAMESPACE_QC$censoring_section), h4("Missing values (not random missing or censored)"), radioButtons(ns('censInt'), @@ -139,30 +149,32 @@ qcUI <- function(id) { # MBi h4("Imputation"), - conditionalPanel(condition = "input['qc-censInt'] == 'NA' || input['qc-censInt'] == '0'", - checkboxInput(ns("MBi"), label=tags$div("Model based imputation",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), - div("Fills in missing intensities only when (a) the protein has at least one observed feature in that run, AND (b) the missing feature is observed in at least one other run. Proteins entirely missing from a run, and features never observed in the dataset, are not imputed. If unchecked, the cutoff for censored values is used instead.", class = "icon-tooltip")),value = TRUE - )), + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$mbi_panel), + checkboxInput(ns("MBi"), label=tags$div("Model based imputation",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + div("Fills in missing intensities only when (a) the protein has at least one observed feature in that run, AND (b) the missing feature is observed in at least one other run. Proteins entirely missing from a run, and features never observed in the dataset, are not imputed. If unchecked, the cutoff for censored values is used instead.", class = "icon-tooltip")),value = TRUE + ) + )), # # cutoff for censored # conditionalPanel(condition = "input.censInt == 'NA' || input.censInt == '0'", - # selectInput("cutoff", "cutoff value for censoring", - # c("min value per feature"="minFeature", - # "min value per feature and run"="minFeatureNRun", + # selectInput("cutoff", "cutoff value for censoring", + # c("min value per feature"="minFeature", + # "min value per feature and run"="minFeatureNRun", # "min value per run"="minRun"))), - - + + tags$hr(), tags$style(HTML('#qc-run{background-color:orange}')), ### summary method - + uiOutput(ns("summaryMethodUI")), tags$hr(), - - # remove features with more than 50% missing - checkboxInput(ns("remove50"), "remove runs with over 50% missing values"), - - ), - + + # remove features with more than 50% missing + checkboxInput(ns("remove50"), "remove runs with over 50% missing values") + + )), + tags$hr(), uiOutput(ns("turnover_ratios_sidebar")), actionButton(ns("run"), "Run protein summarization"), @@ -170,21 +182,21 @@ qcUI <- function(id) { ), column(width = 8, mainPanel( - + h3("Please run protein summarization in the side panel."), h3(textOutput(ns("caption"), container = span)), - + tabsetPanel(id = ns("qc_tabs"), tabPanel("Summarized Results", wellPanel( fluidRow( h4("Download summary of protein abundance",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), div("Model-based quantification for each condition or for each biological samples per protein.", class = "icon-tooltip")), - radioButtons(ns("typequant"), - label = h4("Type of summarization"), - c("Sample level summarization" = "Sample", + radioButtons(ns("typequant"), + label = h4("Type of summarization"), + c("Sample level summarization" = "Sample", "Group level summarization" = "Group")), - radioButtons(ns("format"), "Save as", c("Wide format" = "matrix", + radioButtons(ns("format"), "Save as", c("Wide format" = "matrix", "Long format" = "long")), actionButton(ns("update_results"), "Update Summarized Results"), downloadButton(ns("download_summary"), "Download") @@ -198,18 +210,22 @@ qcUI <- function(id) { tabPanel("Summarization Plots", wellPanel( uiOutput(ns("plotTypeUI")), - conditionalPanel(condition = "input['qc-type1'] === 'ProfilePlot'", - checkboxInput(ns("summ"), "Show plot with summary"), - selectInput(ns("fname"), - label = h5("Feature legend",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), - div("Type of legend to use in plot", class = "icon-tooltip")), - c("Transition level"="Transition", - "Peptide level"="Peptide", - "No feature legend"="NA")) - ), - conditionalPanel(condition = "input['qc-type1'] === 'QualityMetricsPlot'", - uiOutput(ns("qualityMetricSelector")) - ), + # Profile-plot options: shown when plot type is ProfilePlot + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$profileplot_options_panel), + checkboxInput(ns("summ"), "Show plot with summary"), + selectInput(ns("fname"), + label = h5("Feature legend",class = "icon-wrapper",icon("question-circle", lib = "font-awesome"), + div("Type of legend to use in plot", class = "icon-tooltip")), + c("Transition level"="Transition", + "Peptide level"="Peptide", + "No feature legend"="NA")) + )), + # Quality-metric selectors: shown when plot type is QualityMetricsPlot + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$qualitymetrics_options_panel), + uiOutput(ns("qualityMetricSelector")) + )), uiOutput(ns("Which")), tags$br() ), @@ -227,17 +243,21 @@ qcUI <- function(id) { # tags$h4("Calculation in progress...")), #tags$div(id='download_buttons') tags$br(), - conditionalPanel(condition="input['loadpage-BIO'] !== 'PTM'", - disabled(downloadButton(ns("prepr_csv"),"Download .csv of feature level data")), - disabled(downloadButton(ns("summ_csv"),"Download .csv of protein level data")) - ), - conditionalPanel(condition="input['loadpage-BIO'] == 'PTM'", - disabled(downloadButton(ns("prepr_csv_ptm"),"Download .csv of PTM feature level data")), - disabled(downloadButton(ns("summ_csv_ptm"),"Download .csv of PTM level data")), - tags$br(), - disabled(downloadButton(ns("prepr_csv_prot"),"Download .csv of unmod protein feature level data")), - disabled(downloadButton(ns("summ_csv_prot"),"Download .csv of protein level data")) - ) + # Non-PTM feature/protein CSV downloads + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$nonptm_downloads_panel), + disabled(downloadButton(ns("prepr_csv"),"Download .csv of feature level data")), + disabled(downloadButton(ns("summ_csv"),"Download .csv of protein level data")) + )), + # PTM and unmodified-protein CSV downloads + shinyjs::hidden(div( + id = ns(NAMESPACE_QC$ptm_downloads_panel), + disabled(downloadButton(ns("prepr_csv_ptm"),"Download .csv of PTM feature level data")), + disabled(downloadButton(ns("summ_csv_ptm"),"Download .csv of PTM level data")), + tags$br(), + disabled(downloadButton(ns("prepr_csv_prot"),"Download .csv of unmod protein feature level data")), + disabled(downloadButton(ns("summ_csv_prot"),"Download .csv of protein level data")) + )) ) ) ), diff --git a/R/qc-server-downloads.R b/R/qc-server-downloads.R new file mode 100644 index 0000000..f063aa1 --- /dev/null +++ b/R/qc-server-downloads.R @@ -0,0 +1,84 @@ +# QC Download Data tab: enable and serve the feature- and protein-level CSV +# downloads (regular, PTM, and unmodified-protein). + +#' Register the QC Download Data tab handlers. +#' @noRd +register_qc_downloads <- function(input, output, session, loadpage_input, preprocess_data) { + + observeEvent(input$run,{ + + if(loadpage_input()$BIO=="PTM"){ + enable("prepr_csv_ptm") + enable("summ_csv_ptm") + enable("prepr_csv_prot") + enable("summ_csv_prot") + } else { + enable("prepr_csv") + enable("summ_csv") + } + + }) + + output$prepr_csv = downloadHandler( + filename = function() { + paste("Feature_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + if(loadpage_input()$DDA_DIA=='TMT'){ + + write.csv(preprocess_data()$FeatureLevelData, file, row.names = FALSE) + + } + else{ + + write.csv(preprocess_data()$FeatureLevelData, file, row.names = FALSE) + } + + } + ) + + output$prepr_csv_ptm = downloadHandler( + filename = function() { + paste("PTM_Feature_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(preprocess_data()$PTM$FeatureLevelData, file, row.names = FALSE) + } + ) + + output$prepr_csv_prot = downloadHandler( + filename = function() { + paste("Protein_Feature_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(preprocess_data()$PROTEIN$FeatureLevelData, file, row.names = FALSE) + } + ) + + output$summ_csv = downloadHandler( + filename = function() { + paste("Protein_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(preprocess_data()$ProteinLevelData, file, row.names = FALSE) + } + ) + + output$summ_csv_ptm = downloadHandler( + filename = function() { + paste("PTM_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(preprocess_data()$PTM$ProteinLevelData, file, row.names = FALSE) + } + ) + + output$summ_csv_prot = downloadHandler( + filename = function() { + paste("Protein_level_data-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(preprocess_data()$PROTEIN$ProteinLevelData, file, row.names = FALSE) + } + ) +} diff --git a/R/qc-server-plots.R b/R/qc-server-plots.R new file mode 100644 index 0000000..884e793 --- /dev/null +++ b/R/qc-server-plots.R @@ -0,0 +1,207 @@ +# QC Summarization Plots tab: plot-type and protein selectors, the +# profile/QC/quality-metric plot builders, and the plot + per-condition +# statistics outputs. + +#' Register the QC Summarization Plots tab outputs. +#' @noRd +register_qc_plots <- function(input, output, session, loadpage_input, get_data, + preprocess_data, ordered_preprocess_data) { + + output$plotTypeUI <- renderUI({ + ns <- session$ns + + choices <- c("Quality Control Plots" = "QCPlot", + "Profile Plots" = "ProfilePlot") + + if (.anomaly_scores_enabled(loadpage_input())) { + choices <- c(choices, "Quality Metrics Plots" = "QualityMetricsPlot") + } + + selectInput(ns("type1"), + label = h5("Select plot type", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div("For details on plotting options please see the Help tab.", + class = "icon-tooltip")), + choices = choices) + }) + + output$qualityMetricSelector <- renderUI({ + ns <- session$ns + req(get_data()) + + std_cols <- c("ProteinName", "PeptideSequence", "PeptideModifiedSequence", + "PrecursorCharge", "FragmentIon", "ProductCharge", + "IsotopeLabelType", "Condition", "BioReplicate", "Run", + "TechReplicate", "StandardType", "Fraction", + "DetectionQValue", "Intensity") + data_cols <- colnames(get_data()) + metric_cols <- setdiff(data_cols, std_cols) + + if ("AnomalyScores" %in% metric_cols) { + metric_cols <- c("AnomalyScores", setdiff(metric_cols, "AnomalyScores")) + } + + if (length(metric_cols) == 0) { + return(p("No quality metric columns found in the data.")) + } + + protein_choices <- unique(get_data()$ProteinName) + + tagList( + selectInput(ns("quality_metric"), + label = h5("Quality metric"), + choices = metric_cols, + selected = metric_cols[1]), + selectizeInput(ns("qm_protein"), + label = h5("Show plot for"), + choices = c("", protein_choices)) + ) + }) + + # which protein to plot (will add "all" for QCPlot) + output$Which = renderUI({ + ns <- session$ns + req(input$type1) + if (input$type1 == "QualityMetricsPlot") { + return(NULL) + } + if ((loadpage_input()$BIO!="PTM" && input$type1 == "QCPlot")) { + selectizeInput(ns("which"), "Show plot for", + choices = c("", "ALL PROTEINS" = "allonly", + unique(get_data()$ProteinName))) + } else if (loadpage_input()$BIO == "PTM"){ + if (input$type1 == "QCPlot"){ + selectizeInput(ns("which"), "Show plot for", + choices = c("", "ALL PROTEINS" = "allonly", + unique(get_data()$PTM[1]))) + } else { + selectizeInput(ns("which"), "Show plot for", + choices = c("", unique(get_data()$PTM[1]))) + } + } else { + selectizeInput(ns("which"), "Show plot for", + choices = c("", unique(get_data()$ProteinName))) + } + }) + + plotresult = function(saveFile, protein, summary, original, file) { + if (input$which != "") { + if (loadpage_input()$BIO == "PTM"){ + plot = dataProcessPlotsPTM(preprocess_data(), + type=input$type1, + which.PTM = protein, + originalPlot = original, + summaryPlot = input$summ, + address = file, + isPlotly = TRUE + )[[1]] + return(plot) + } else if(loadpage_input()$DDA_DIA == "TMT"){ + plot <- dataProcessPlotsTMT(preprocess_data(), + type=input$type1, + featureName = input$fname, + ylimUp = FALSE, + ylimDown = FALSE, + which.Protein = protein, + originalPlot = original, + summaryPlot = input$summ, + address = file, isPlotly = TRUE + )[[1]] + return(plot) + } else { + plot <- dataProcessPlots(data = ordered_preprocess_data(), + type=input$type1, + featureName = input$fname, + ylimUp = FALSE, + ylimDown = FALSE, + scale = input$cond_scale, + interval = input$interval, + which.Protein = protein, + originalPlot = original, + summaryPlot = input$summ, + save_condition_plot_result = FALSE, + address = file, + isPlotly = TRUE + + )[[1]] + return(plot) + } + } + else { + return(NULL) + } + } + + # per-condition statistics for the ConditionPlot summary table + statistics = reactive({ + sub = preprocess_data()$ProteinLevelData[which(preprocess_data()$ProteinLevelData$Protein == input$which),] + len = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, length, data = sub) + colnames(len)[colnames(len)=="sub$LogIntensities"] = "Number_of_Measurements" + sd = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, sd, data = sub) + colnames(sd)[colnames(sd)=="sub$LogIntensities"] = "Standard_Deviation" + mean = aggregate(sub$LogIntensities~sub$GROUP_ORIGINAL, mean, data = sub) + colnames(mean)[colnames(mean)=="sub$LogIntensities"] = "Mean" + tab = merge(len, sd, by="sub$GROUP_ORIGINAL") + tab = merge(mean, tab, by="sub$GROUP_ORIGINAL") + colnames(tab)[colnames(tab)=="sub$GROUP_ORIGINAL"] = "Condition" + SE = tab$Standard_Deviation/sqrt(tab$Number_of_Measurements) + tab$CI_width = qt(.975, df=tab$Number_of_Measurement)*SE + CI_Limits = c(tab$Mean-tab$CI, tab$Mean+tab$CI) + + return(tab) + }) + + theplot = reactive({ + if (!is.null(input$type1) && input$type1 == "QualityMetricsPlot") { + req(get_data()) + req(input$quality_metric) + req(input$qm_protein != "") + return(MSstats::MSstatsQualityMetricsPlot( + get_data(), + metric = input$quality_metric, + which.Protein = input$qm_protein, + isPlotly = TRUE + )) + } + if (input$summ == FALSE) { + output = plotresult(FALSE, input$which, FALSE, TRUE, FALSE) + } + else if (input$summ == TRUE) { + output = plotresult(FALSE, input$which, TRUE, FALSE, FALSE) + } + return(output) + }) + + output$showplot = renderUI({ + ns<- session$ns + output$theplot = renderPlotly(theplot()) + op <- div( + style = "overflow-x: auto; width: 100%;", + div( + style = "min-width: 1400px;", + plotlyOutput(ns("theplot"), width = "100%") + ) + ) + tagList( + op, + conditionalPanel(condition = "input['qc-type'] == 'ConditionPlot' && input['qc-which'] != ''", + tableOutput(ns("stats"))), + tags$br(), + enable("saveplot") + ) + }) + + output$saveplot = downloadHandler( + filename = function() { + paste("SummaryPlot-", Sys.Date(), ".pdf", sep="") + }, + content = function(file) { + pdf(file) + plotresult(TRUE, input$which, FALSE, TRUE, FALSE) + dev.off() + } + ) + + output$stats = renderTable(statistics()) +} diff --git a/R/qc-server-sidebar.R b/R/qc-server-sidebar.R new file mode 100644 index 0000000..ccfc905 --- /dev/null +++ b/R/qc-server-sidebar.R @@ -0,0 +1,345 @@ +# QC sidebar: pure visibility predicates for the processing-option panels, the +# server-side shinyjs toggles + protein-turnover template setup that drive them, +# and the dynamic sidebar option inputs (standard names, top-N feature slider, +# run-level summarization method). + +# ---------------------------------------------------------------------------- +# Visibility predicates. Pure functions of their driver values so they can be +# unit-tested directly; each gates on the complete condition for its panel, not +# just the immediate driver. +# ---------------------------------------------------------------------------- + +#' Show the TMT-branch processing panels (peptide normalization, summarization +#' method, reference-channel normalization). +#' @noRd +qc_show_tmt <- function(dda_dia, bio) { + isTRUE(dda_dia == "TMT") || (isTRUE(bio == "PTM") && isTRUE(dda_dia == "TMT")) +} + +#' Show the label-free-branch processing panels (normalization, feature subset, +#' censoring, imputation, summary method). +#' @noRd +qc_show_lf <- function(dda_dia, bio) { + isTRUE(dda_dia == "LType") || (isTRUE(bio == "PTM") && !isTRUE(dda_dia == "TMT")) +} + +#' Show the maximum-censored-quantile inputs: TMT branch with MSstats summarization. +#' @noRd +qc_show_maxqc_msstats <- function(dda_dia, bio, summarization) { + qc_show_tmt(dda_dia, bio) && isTRUE(summarization == "msstats") +} + +#' Show the global-standards picker: label-free non-PTM with globalStandards normalization. +#' @noRd +qc_show_standards <- function(norm, bio, dda_dia) { + isTRUE(norm == "globalStandards") && + (!isTRUE(bio == "PTM") && !isTRUE(dda_dia == "TMT")) +} + +#' Show the top-N feature-count slider: label-free branch with the topN subset selected. +#' @noRd +qc_show_features_topn <- function(dda_dia, bio, features_used) { + qc_show_lf(dda_dia, bio) && isTRUE(features_used == "topN") +} + +#' Show the model-based imputation checkbox: label-free branch with a censoring assumption set. +#' @noRd +qc_show_mbi <- function(dda_dia, bio, cens_int) { + qc_show_lf(dda_dia, bio) && (isTRUE(cens_int == "NA") || isTRUE(cens_int == "0")) +} + +#' Show the log-transformation panel: label-free branch, but hidden for the +#' protein-turnover template. +#' @noRd +qc_show_log_section <- function(dda_dia, bio, template) { + qc_show_lf(dda_dia, bio) && !isTRUE(template == TEMPLATES$protein_turnover) +} + +#' Show the profile-plot options (summary toggle, feature legend). +#' @noRd +qc_show_profileplot_options <- function(type1) { + isTRUE(type1 == "ProfilePlot") +} + +#' Show the quality-metric selectors. +#' @noRd +qc_show_qualitymetrics_options <- function(type1) { + isTRUE(type1 == "QualityMetricsPlot") +} + +#' Show the non-PTM CSV download buttons. +#' @noRd +qc_show_nonptm_downloads <- function(bio) { + !isTRUE(bio == "PTM") +} + +#' Show the PTM CSV download buttons. +#' @noRd +qc_show_ptm_downloads <- function(bio) { + isTRUE(bio == "PTM") +} + +# ---------------------------------------------------------------------------- +# Visibility + enablement observers. +# ---------------------------------------------------------------------------- + +#' Register the QC sidebar visibility observers. +#' +#' Each panel is a permanently-mounted, initially-hidden div toggled here with +#' shinyjs. show/hide (not renderUI) is required because preprocessData / +#' preprocessDataCode read these input ids by literal string at run time: a +#' renderUI would destroy a hidden input, feeding the consumer NULL and resetting +#' the user's value, whereas a hidden-but-mounted input keeps reporting its value. +#' +#' @noRd +register_qc_visibility_observers <- function(input, session, loadpage_input, app_template) { + + # TMT-branch panels. + observe({ + shinyjs::toggle( + NAMESPACE_QC$global_norm_panel, + condition = qc_show_tmt(loadpage_input()$DDA_DIA, loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$summarization_panel, + condition = qc_show_tmt(loadpage_input()$DDA_DIA, loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$reference_norm_panel, + condition = qc_show_tmt(loadpage_input()$DDA_DIA, loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$maxqc_msstats_panel, + condition = qc_show_maxqc_msstats( + loadpage_input()$DDA_DIA, loadpage_input()$BIO, + input[[NAMESPACE_QC$summarization]] + ) + ) + }) + + # Label-free-branch panels. + observe({ + shinyjs::toggle( + NAMESPACE_QC$norm_panel, + condition = qc_show_lf(loadpage_input()$DDA_DIA, loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$lf_options_panel, + condition = qc_show_lf(loadpage_input()$DDA_DIA, loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$features_topn_panel, + condition = qc_show_features_topn( + loadpage_input()$DDA_DIA, loadpage_input()$BIO, + input[[NAMESPACE_QC$features_used]] + ) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$mbi_panel, + condition = qc_show_mbi( + loadpage_input()$DDA_DIA, loadpage_input()$BIO, + input[[NAMESPACE_QC$cens_int]] + ) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$standards_panel, + condition = qc_show_standards( + input[[NAMESPACE_QC$norm]], loadpage_input()$BIO, loadpage_input()$DDA_DIA + ) + ) + }) + + # Log-transformation panel. One observer gates this single container on both + # the label-free branch and the (non-)turnover template; a second toggle on the + # same div would race with this one. + observe({ + shinyjs::toggle( + NAMESPACE_QC$log_section, + condition = qc_show_log_section( + loadpage_input()$DDA_DIA, loadpage_input()$BIO, app_template() + ) + ) + }) + + # Plot-tab option panels. + observe({ + shinyjs::toggle( + NAMESPACE_QC$profileplot_options_panel, + condition = qc_show_profileplot_options(input[[NAMESPACE_QC$type1]]) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$qualitymetrics_options_panel, + condition = qc_show_qualitymetrics_options(input[[NAMESPACE_QC$type1]]) + ) + }) + + # Download-tab panels. + observe({ + shinyjs::toggle( + NAMESPACE_QC$nonptm_downloads_panel, + condition = qc_show_nonptm_downloads(loadpage_input()$BIO) + ) + }) + observe({ + shinyjs::toggle( + NAMESPACE_QC$ptm_downloads_panel, + condition = qc_show_ptm_downloads(loadpage_input()$BIO) + ) + }) + + # Protein-turnover template: switch the Turnover Ratios tab, hide the + # template-specific sections, and restrict normalization / feature-subset choices. + observeEvent(app_template(), { + req(!is.null(app_template)) + if (app_template() == TEMPLATES$protein_turnover) { + showTab(inputId = "qc_tabs", target = "Turnover Ratios", session = session) + shinyjs::hide(NAMESPACE_QC$censoring_section) + shinyjs::hide(NAMESPACE_QC$standards_type_section) + updateSelectInput(session, NAMESPACE_QC$norm, + choices = c("none" = "FALSE", "global standards" = "globalStandards"), + selected = "FALSE") + updateRadioButtons(session, NAMESPACE_QC$features_used, + choices = c("Use all features" = "all"), + selected = "all") + } else { + hideTab(inputId = "qc_tabs", target = "Turnover Ratios", session = session) + shinyjs::show(NAMESPACE_QC$censoring_section) + shinyjs::show(NAMESPACE_QC$standards_type_section) + updateSelectInput(session, NAMESPACE_QC$norm, + choices = c("none" = "FALSE", "equalize medians" = "equalizeMedians", + "quantile" = "quantile", "global standards" = "globalStandards"), + selected = "equalizeMedians") + updateRadioButtons(session, NAMESPACE_QC$features_used, + choices = c("Use all features" = "all", "Use top N features" = "topN", + "Remove uninformative features & outliers" = "highQuality"), + selected = "all") + } + }, ignoreNULL = TRUE) + + # Enable the censoring assumptions and grey out the option the active converter + # cannot report. + observe({ + if(!is.null(loadpage_input()$filetype)) { + runjs("$('[type=radio][name=censInt]:disabled').parent().parent().parent().find('div.radio').css('opacity', 1)") + enable("censInt") + if (loadpage_input()$filetype == "sky" || loadpage_input()$filetype == "prog" || loadpage_input()$filetype == "spec") { + disable(selector = "[type=radio][value=NA]") + runjs("$.each($('[type=radio][name=censInt]:disabled'), function(_, e){ $(e).parent().parent().css('opacity', 0.4) })") + } + else if (loadpage_input()$filetype == "maxq" || loadpage_input()$filetype == "PD" || loadpage_input()$filetype == "open") { + disable(selector = "[type=radio][value=0]") + runjs("$.each($('[type=radio][name=censInt]:disabled'), function(_, e){ $(e).parent().parent().css('opacity', 0.4) })") + } + } + }) + + # Enable the maximum-censored-quantile numeric only when its "do not apply + # cutoff" checkbox is unchecked. + observe ({ + shinyjs::toggleState("maxQC", input$null == FALSE) + }) + + observe ({ + toggleState("n_feat", input$all_feat == FALSE) + }) +} + +# ---------------------------------------------------------------------------- +# Dynamic sidebar option inputs. +# ---------------------------------------------------------------------------- + +#' Register the QC sidebar option renderUIs: standard-name picker, top-N feature +#' slider, and run-level summarization method. +#' @noRd +register_qc_sidebar_options <- function(input, output, session, loadpage_input, get_data, app_template) { + + output$Names = renderUI({ + ns <- session$ns + + if (!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) { + return(selectizeInput(ns("names"), "Standard name", + choices = "unlabeled", selected = "unlabeled", + multiple = TRUE)) + } + + if (input$standards == "Proteins") { + selectizeInput(ns("names"), "choose standard", unique(get_data()$ProteinName), multiple = TRUE) + } + else if (input$standards == "Peptides") { + selectizeInput(ns("names"), "choose standard", unique(get_data()$PeptideSequence), multiple = TRUE) + } + + }) + + output$features = renderUI({ + ns <- session$ns + req(get_data()) + max_feat = reactive({ + ## Old code for only 20 features. Meena thought this should be all uniques + ## TODO: Need to fix this bc hard to be specific with slider. + # if (nrow(unique(get_data()[1])) < 20) { + # m_feat = nrow(unique(get_data()[1])) + # } + # else + # { + # m_feat = 20 + # } + + if (loadpage_input()$BIO =="PTM"){ + m_feat = nrow(unique(get_data()$PTM[1])) + } else { + m_feat = nrow(unique(get_data()[1])) + } + + return(m_feat) + }) + sliderInput(ns("n_feat"), "Number of top features to use", 1, + as.numeric(max_feat()), 1) + }) + + output$summaryMethodUI <- renderUI({ + ns <- session$ns + + # Default choices + choices <- c("TMP" = "TMP") + tooltip_text <- "Run-level summarization method. TMP is Tukey's Median Polish. " + selected <- "TMP" + + # Conditionally add MSstats+ if anomaly score calculation is checked + # (Spectronaut, regular DIANN, or big-file DIANN). + if (.anomaly_scores_enabled(loadpage_input())) { + choices <- c(choices, "MSstats+" = "linear") + tooltip_text <- paste0(tooltip_text, "MSstats+ uses a weighted linear model.") + selected = "linear" + } + + radioButtons( + ns("summaryMethod"), + label = h4( + "6. Summarization", + class = "icon-wrapper", + icon("question-circle", lib = "font-awesome"), + div(tooltip_text, class = "icon-tooltip") + ), + choices = choices, + selected = selected + ) + }) +} diff --git a/R/qc-server-summary.R b/R/qc-server-summary.R new file mode 100644 index 0000000..0efbb51 --- /dev/null +++ b/R/qc-server-summary.R @@ -0,0 +1,80 @@ +# QC Summarized Results tab: protein-abundance quantification, the abundance +# table, and its CSV download. + +#' Register the QC Summarized Results tab outputs. +#' @noRd +register_qc_summary <- function(input, output, session, loadpage_input, + preprocess_data, app_template) { + + abundant = reactiveValues() + + observeEvent(loadpage_input()$proceed1, { + abundant$results = NULL + }) + + abundance = eventReactive(input$update_results, { + validate(need(preprocess_data(), + message = "PLEASE COMPLETE DATA PROCESSING")) + + if (loadpage_input()$BIO == "PTM" && loadpage_input()$DDA_DIA == "TMT"){ + temp = copy(preprocess_data()) + setnames(temp$PTM$ProteinLevelData, + c("Abundance", "Condition", "BioReplicate"), + c("LogIntensities", "GROUP", "SUBJECT")) + abundant$results = quantification(temp$PTM, + type = input$typequant, + format = input$format, + use_log_file = FALSE) + } else if (loadpage_input()$BIO == "PTM" && loadpage_input()$DDA_DIA != "TMT"){ + temp = copy(preprocess_data()) + abundant$results =quantification(temp$PTM, + type = input$typequant, + format = input$format, + use_log_file = FALSE) + } else if (loadpage_input()$DDA_DIA == "TMT"){ + temp = copy(preprocess_data()) + temp$ProteinLevelData = copy(temp$ProteinLevelData) + setnames(temp$ProteinLevelData, + c("Abundance", "Condition", "BioReplicate"), + c("LogIntensities", "GROUP", "SUBJECT")) + abundant$results = quantification(temp, + type = input$typequant, + format = input$format, + use_log_file = FALSE) + } else if (!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) { + # TODO: Refactor quantification function to handle LABEL column + abundant$results <- preprocess_data()$ProteinLevelData + } else{ + temp = copy(preprocess_data()) + abundant$results =quantification(temp, + type = input$typequant, + format = input$format, + use_log_file = FALSE) + } + + return(abundant$results) + }) + + output$abundance = renderUI({ + ns <- session$ns + req(abundance()) + if (is.null(abundant$results)) { + tagList( + tags$br()) + } else { + tagList( + dataTableOutput(ns("abundanceTable")) ) + } + }) + output$abundanceTable = renderDataTable(abundance()) + + output$download_summary = downloadHandler( + filename = function() { + paste("Abundance-", Sys.Date(), ".csv", sep="") + }, + content = function(file) { + write.csv(abundance(), file) + } + ) +} diff --git a/R/qc-server-turnover.R b/R/qc-server-turnover.R new file mode 100644 index 0000000..2a89bfb --- /dev/null +++ b/R/qc-server-turnover.R @@ -0,0 +1,129 @@ +# QC Turnover Ratios tab (protein-turnover template): tracer-constant inputs, +# the ratio calculation, the results table, and the ratio CSV download. + +#' Register the QC Turnover Ratios tab outputs and return the ratios reactive. +#' @noRd +register_qc_turnover <- function(input, output, session, app_template, get_data, + get_condition_metadata, preprocess_data) { + + output$turnover_ratios_sidebar <- renderUI({ + req(!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) + req(get_data()) + + req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) + ns <- session$ns + conditions <- as.character(get_condition_metadata()$Condition) + + tracer_inputs <- lapply(conditions, function(cond) { + input_id <- ns(paste0("tracer_", make.names(cond))) + fluidRow( + column(6, p(strong(cond))), + column(6, numericInput(input_id, NULL, value = 1.0, min = 0, max = 1, step = 0.001)) + ) + }) + + tagList( + tags$hr(), + h4("Turnover Ratio Calculation"), + p("Enter tracer constants (0 to 1) for each condition:"), + tagList(tracer_inputs) + ) + }) + + turnover_ratios <- eventReactive(input$run, { + req(!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) + req(preprocess_data()) + + req(!is.null(get_condition_metadata) && !is.null(get_condition_metadata())) + conditions <- as.character(get_condition_metadata()$Condition) + tracer_consts <- sapply(conditions, function(cond) { + val <- input[[paste0("tracer_", make.names(cond))]] + if (is.null(val)) 1.0 else as.numeric(val) + }) + names(tracer_consts) <- conditions + + # Use ProteinLevelData when any condition has more than one sample (run); + # fall back to FeatureLevelData for purely single-replicate designs. + pld <- preprocess_data()$ProteinLevelData + samples_per_condition <- tapply(pld$RUN, pld$GROUP, function(x) length(unique(x))) + use_protein_level <- any(samples_per_condition > 1) + + if (use_protein_level) { + calculateTurnoverRatios( + pld, + channel_col = "LABEL", + heavy_label = "H", + light_label = "L", + time_col = "GROUP", + peptide_col = "Protein", + protein_col = "Protein", + intensity_col = "LogIntensities", + run_col = "RUN", + peptide_selector = NULL, + agg_function = max, + normalize_tracer = TRUE, + tracer_constants = tracer_consts + ) + } else { + calculateTurnoverRatios( + preprocess_data()$FeatureLevelData, + channel_col = "LABEL", + heavy_label = "H", + light_label = "L", + time_col = "GROUP", + peptide_col = "PEPTIDE", + protein_col = "PROTEIN", + intensity_col = "INTENSITY", + run_col = "RUN", + peptide_selector = NULL, + agg_function = max, + normalize_tracer = TRUE, + tracer_constants = tracer_consts + ) + } + }) + + observeEvent(input$run, { + req(!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) + turnover_ratios() + }, ignoreInit = TRUE) + + output$turnover_ratios_panel <- renderUI({ + req(!is.null(app_template) && !is.null(app_template()) && + app_template() == TEMPLATES$protein_turnover) + + ns <- session$ns + tagList( + tags$br(), + p("Run protein summarization after filling in tracer constants in the side panel."), + uiOutput(ns("turnover_ratios_table_ui")), + tags$br(), + disabled(downloadButton(ns("download_turnover_ratios"), "Download Ratios")) + ) + }) + + output$turnover_ratios_table_ui <- renderUI({ + req(turnover_ratios()) + ns <- session$ns + enable("download_turnover_ratios") + dataTableOutput(ns("turnover_ratios_table")) + }) + + output$turnover_ratios_table <- renderDataTable({ + turnover_ratios() + }) + + output$download_turnover_ratios <- downloadHandler( + filename = function() { + paste0("Turnover_Ratios-", Sys.Date(), ".csv") + }, + content = function(file) { + write.csv(turnover_ratios(), file, row.names = FALSE) + } + ) + + turnover_ratios +} diff --git a/tests/testthat/test-module-qc-ui.R b/tests/testthat/test-module-qc-ui.R new file mode 100644 index 0000000..f8b3ac7 --- /dev/null +++ b/tests/testthat/test-module-qc-ui.R @@ -0,0 +1,56 @@ +# Tests for the QC UI module: namespaced input ids, the server-toggled +# visibility containers, and the single (collapsed) normalization select. + +render_qc_ui_html <- function(id = "test") { + ui <- MSstatsShiny::qcUI(id) + htmltools::renderTags(ui)$html +} + +count_occurrences <- function(haystack, needle) { + matches <- gregexpr(needle, haystack, fixed = TRUE)[[1]] + if (length(matches) == 1 && matches[1] == -1) 0L else length(matches) +} + +test_that("qcUI returns a tagList", { + ui <- MSstatsShiny::qcUI("test") + expect_s3_class(ui, "shiny.tag.list") +}) + +test_that("qcUI renders the namespaced processing-option input ids", { + html <- render_qc_ui_html("test") + input_ids <- c("global_norm", "log", "summarization", "null", "maxQC", "norm", + "standards", "reference_norm", "remove_norm_channel", "features_used", + "censInt", "null1", "maxQC1", "MBi", "remove50", + "typequant", "format", "summ", "fname", "run", "update_results") + for (id in input_ids) { + expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), + info = paste("Missing input id:", id)) + } +}) + +test_that("qcUI renders every server-toggled visibility container", { + html <- render_qc_ui_html("test") + container_ids <- c("global_norm_panel", "log_section", "summarization_panel", + "maxqc_msstats_panel", "norm_panel", "standards_panel", + "standards_type_section", "reference_norm_panel", "lf_options_panel", + "features_topn_panel", "censoring_section", "mbi_panel", + "profileplot_options_panel", "qualitymetrics_options_panel", + "nonptm_downloads_panel", "ptm_downloads_panel") + for (id in container_ids) { + expect_true(grepl(paste0('id="test-', id, '"'), html, fixed = TRUE), + info = paste("Missing container id:", id)) + } +}) + +test_that("qcUI declares the normalization select exactly once (duplicate-id collapse)", { + html <- render_qc_ui_html("test") + expect_equal(count_occurrences(html, 'id="test-norm"'), 1) +}) + +test_that("the collapsed normalization select keeps all label-free choices", { + html <- render_qc_ui_html("test") + for (choice in c("equalizeMedians", "quantile", "globalStandards")) { + expect_true(grepl(choice, html, fixed = TRUE), + info = paste("Missing normalization choice:", choice)) + } +}) diff --git a/tests/testthat/test-qc-server-rendering.R b/tests/testthat/test-qc-server-rendering.R new file mode 100644 index 0000000..6199735 --- /dev/null +++ b/tests/testthat/test-qc-server-rendering.R @@ -0,0 +1,131 @@ +# Truth-table tests for the QC sidebar visibility predicates and a guard that the +# NAMESPACE_QC input ids keep their original literal string values. + +test_that("qc_show_tmt is TRUE only for the TMT label type", { + expect_true(MSstatsShiny:::qc_show_tmt("TMT", "Protein")) + expect_true(MSstatsShiny:::qc_show_tmt("TMT", "PTM")) + expect_true(MSstatsShiny:::qc_show_tmt("TMT", "Peptide")) + expect_true(MSstatsShiny:::qc_show_tmt("TMT", NULL)) + + expect_false(MSstatsShiny:::qc_show_tmt("LType", "Protein")) + expect_false(MSstatsShiny:::qc_show_tmt("LType", "PTM")) + expect_false(MSstatsShiny:::qc_show_tmt(NULL, "Protein")) + expect_false(MSstatsShiny:::qc_show_tmt(NULL, NULL)) +}) + +test_that("qc_show_lf is TRUE for the label-free branch", { + expect_true(MSstatsShiny:::qc_show_lf("LType", "Protein")) + expect_true(MSstatsShiny:::qc_show_lf("LType", "PTM")) + expect_true(MSstatsShiny:::qc_show_lf("LType", NULL)) + # Mirrors the original `DDA_DIA != 'TMT'`: an unset label type with PTM still shows. + expect_true(MSstatsShiny:::qc_show_lf(NULL, "PTM")) + + expect_false(MSstatsShiny:::qc_show_lf("TMT", "Protein")) + expect_false(MSstatsShiny:::qc_show_lf("TMT", "PTM")) + expect_false(MSstatsShiny:::qc_show_lf(NULL, "Protein")) +}) + +test_that("qc_show_maxqc_msstats needs the TMT branch AND msstats summarization", { + expect_true(MSstatsShiny:::qc_show_maxqc_msstats("TMT", "Protein", "msstats")) + + # Ancestor-chain regression: summarization is right but the branch is wrong. + expect_false(MSstatsShiny:::qc_show_maxqc_msstats("LType", "Protein", "msstats")) + # Branch is right but summarization is wrong. + expect_false(MSstatsShiny:::qc_show_maxqc_msstats("TMT", "Protein", "MedianPolish")) + expect_false(MSstatsShiny:::qc_show_maxqc_msstats("TMT", "Protein", NULL)) + expect_false(MSstatsShiny:::qc_show_maxqc_msstats(NULL, "Protein", "msstats")) +}) + +test_that("qc_show_standards needs globalStandards, non-PTM, label-free", { + expect_true(MSstatsShiny:::qc_show_standards("globalStandards", "Protein", "LType")) + + expect_false(MSstatsShiny:::qc_show_standards("equalizeMedians", "Protein", "LType")) + expect_false(MSstatsShiny:::qc_show_standards("globalStandards", "PTM", "LType")) + expect_false(MSstatsShiny:::qc_show_standards("globalStandards", "Protein", "TMT")) + expect_false(MSstatsShiny:::qc_show_standards(NULL, "Protein", "LType")) +}) + +test_that("qc_show_features_topn needs the label-free branch AND the topN subset", { + expect_true(MSstatsShiny:::qc_show_features_topn("LType", "Protein", "topN")) + + # Ancestor-chain regression: subset is right but the branch is wrong. + expect_false(MSstatsShiny:::qc_show_features_topn("TMT", "Protein", "topN")) + expect_false(MSstatsShiny:::qc_show_features_topn("LType", "Protein", "all")) + expect_false(MSstatsShiny:::qc_show_features_topn("LType", "Protein", NULL)) +}) + +test_that("qc_show_mbi needs the label-free branch AND a censoring assumption", { + expect_true(MSstatsShiny:::qc_show_mbi("LType", "Protein", "NA")) + expect_true(MSstatsShiny:::qc_show_mbi("LType", "Protein", "0")) + + # Ancestor-chain regression: censoring is set but the branch is wrong. + expect_false(MSstatsShiny:::qc_show_mbi("TMT", "Protein", "NA")) + expect_false(MSstatsShiny:::qc_show_mbi("LType", "Protein", NULL)) + expect_false(MSstatsShiny:::qc_show_mbi("LType", "Protein", "other")) +}) + +test_that("qc_show_log_section needs the label-free branch AND a non-turnover template", { + expect_true(MSstatsShiny:::qc_show_log_section("LType", "Protein", TEMPLATES$default)) + expect_true(MSstatsShiny:::qc_show_log_section("LType", "Protein", TEMPLATES$chemoproteomics)) + + # Template regression: label-free but protein turnover hides the panel. + expect_false(MSstatsShiny:::qc_show_log_section("LType", "Protein", TEMPLATES$protein_turnover)) + # Branch regression: non-turnover but TMT hides the panel. + expect_false(MSstatsShiny:::qc_show_log_section("TMT", "Protein", TEMPLATES$default)) +}) + +test_that("qc_show_profileplot_options and qc_show_qualitymetrics_options key off type1", { + expect_true(MSstatsShiny:::qc_show_profileplot_options("ProfilePlot")) + expect_false(MSstatsShiny:::qc_show_profileplot_options("QCPlot")) + expect_false(MSstatsShiny:::qc_show_profileplot_options("QualityMetricsPlot")) + expect_false(MSstatsShiny:::qc_show_profileplot_options(NULL)) + + expect_true(MSstatsShiny:::qc_show_qualitymetrics_options("QualityMetricsPlot")) + expect_false(MSstatsShiny:::qc_show_qualitymetrics_options("ProfilePlot")) + expect_false(MSstatsShiny:::qc_show_qualitymetrics_options("QCPlot")) + expect_false(MSstatsShiny:::qc_show_qualitymetrics_options(NULL)) +}) + +test_that("download panels are complementary on the PTM biological question", { + expect_true(MSstatsShiny:::qc_show_nonptm_downloads("Protein")) + expect_true(MSstatsShiny:::qc_show_nonptm_downloads("Peptide")) + expect_true(MSstatsShiny:::qc_show_nonptm_downloads(NULL)) + expect_false(MSstatsShiny:::qc_show_nonptm_downloads("PTM")) + + expect_true(MSstatsShiny:::qc_show_ptm_downloads("PTM")) + expect_false(MSstatsShiny:::qc_show_ptm_downloads("Protein")) + expect_false(MSstatsShiny:::qc_show_ptm_downloads("Peptide")) + expect_false(MSstatsShiny:::qc_show_ptm_downloads(NULL)) +}) + +test_that("NAMESPACE_QC retains literal string values (no renames)", { + expect_equal(NAMESPACE_QC$global_norm, "global_norm") + expect_equal(NAMESPACE_QC$log, "log") + expect_equal(NAMESPACE_QC$summarization, "summarization") + expect_equal(NAMESPACE_QC$null, "null") + expect_equal(NAMESPACE_QC$max_qc, "maxQC") + expect_equal(NAMESPACE_QC$norm, "norm") + expect_equal(NAMESPACE_QC$standards, "standards") + expect_equal(NAMESPACE_QC$names, "names") + expect_equal(NAMESPACE_QC$reference_norm, "reference_norm") + expect_equal(NAMESPACE_QC$remove_norm_channel, "remove_norm_channel") + expect_equal(NAMESPACE_QC$features_used, "features_used") + expect_equal(NAMESPACE_QC$n_feat, "n_feat") + expect_equal(NAMESPACE_QC$cens_int, "censInt") + expect_equal(NAMESPACE_QC$null1, "null1") + expect_equal(NAMESPACE_QC$max_qc_censored, "maxQC1") + expect_equal(NAMESPACE_QC$mbi, "MBi") + expect_equal(NAMESPACE_QC$remove50, "remove50") + expect_equal(NAMESPACE_QC$summary_method, "summaryMethod") + expect_equal(NAMESPACE_QC$typequant, "typequant") + expect_equal(NAMESPACE_QC$format, "format") + expect_equal(NAMESPACE_QC$summ, "summ") + expect_equal(NAMESPACE_QC$fname, "fname") + expect_equal(NAMESPACE_QC$type1, "type1") + expect_equal(NAMESPACE_QC$which, "which") + expect_equal(NAMESPACE_QC$quality_metric, "quality_metric") + expect_equal(NAMESPACE_QC$qm_protein, "qm_protein") + expect_equal(NAMESPACE_QC$run, "run") + expect_equal(NAMESPACE_QC$update_results, "update_results") + expect_equal(NAMESPACE_QC$proceed6, "proceed6") +}) From c24df8cb71c0e939cf6c3fdd58be2ff71917c163 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Thu, 2 Jul 2026 14:09:14 -0400 Subject: [PATCH 2/2] Restore the result plot in namespace expedes --- R/constants.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/constants.R b/R/constants.R index de0be09..28e0b05 100644 --- a/R/constants.R +++ b/R/constants.R @@ -170,5 +170,6 @@ NAMESPACE_EXPDES = list( protein_select = "protein_select", rep_range = "rep_range", run_simulation = "run_simulation", + result_plot = "result_plot", download_future = "download_future" ) \ No newline at end of file