Moved all relevant functionality outside of base server. Will be used…

… for code creation Later!

Addtionally closes #447, Closes #435
And fixes a Small bug in the report where the batch formula and regular formula of deseq processing would be swapped

program/shinyApp/R/C.R

@@ -3,9 +3,6 @@ library(waiter)
 library(ggplot2)
 library(cicerone)
 ### Global Constants will be saved here
-NOTES_PlACEHOLDER <<- "Notes you want to take alongside the plot (will be saved in the report) \nYou can use markdown syntax for your notes "
-NOTES_HELP <<- HTML("<a href='https://www.markdownguide.org/cheat-sheet/' target='_blank'>Here you can find a Markdown Cheat Sheet</a> \n
-                    Please do not use heading mardkown syntax - this will interfere with the reports hierachy")
 
 # Test correction list
 PADJUST_METHOD <<- list(

program/shinyApp/R/C_strings.R

@@ -0,0 +1,27 @@
+# Global String Constants
+
+# --- Notes ---
+NOTES_PlACEHOLDER <<- "Notes you want to take alongside the plot (will be saved in the report) \nYou can use markdown syntax for your notes "
+NOTES_HELP <<- HTML(
+  "<a href='https://www.markdownguide.org/cheat-sheet/' target='_blank'>
+  Here you can find a Markdown Cheat Sheet</a> <br> Please do not use heading mardkown
+  syntax - this will interfere with the reports hierachy"
+)
+
+# --- Error messages ---
+# Error messages in modal due to failed batch correction
+ERROR_BATCH_CORR <<- "Batch correction failed. Make sure the batch effect column is correct or NULL!"
+ERROR_BATCH_DESEQ <<- paste0(
+  "Batch correction using DESeq failed. Most likely due to linear dependencies ",
+  "in the design matrix (one or more factors informing about another one).",
+  "Make sure the batch effect column is correct and ",
+  "that the design matrix is not singular!"
+)  # Error shown in Modal caused by DESeq2 batch correction
+ERROR_PREPROC <<- HTML(paste0(
+  "<span style='color: red;'>There has been an error</span><br>",
+  "The current data might not be what you expect.<br>",
+  "Ensure you change something within the data or the Pre-Processing,<br>",
+  "and click 'Get Pre-Processing' again.<br>",
+  "<span style='color: red;'>You should not see this message before moving to analysis!</span><br>",
+))  # Error shown in the info box upon failed preprocessing
+

program/shinyApp/R/pre_processing/util.R

@@ -1,22 +1,35 @@
 # preprocessing procedures
 
-preprocessing <- function(data, omic_type, procedure){
+preprocessing <- function(data, omic_type, procedure, deseq_factors = NULL){
   print("Remove all entities which are constant over all samples")
   data <- data[rownames(data[which(apply(assay(data),1,sd) != 0),]),]
+  if(procedure == "vst_DESeq"){
+      return(deseq_processing(data, omic_type, deseq_factors))
+  }
   if(procedure == "filterOnly"){
-    return(prefiltering(data, omic_type))
+    return(list(
+      data = prefiltering(data, omic_type)
+    ))
   }
   if(procedure == "simpleCenterScaling"){
-    return(simple_center_scaling(data, omic_type))
+    return(list(
+      data = simple_center_scaling(data, omic_type)
+    ))
   }
   if(procedure %in% c("Scaling_0_1", "pareto_scaling")){
-    return(scaling_normalisation(data, omic_type, procedure))
+    return(list(
+      data = scaling_normalisation(data, omic_type, procedure)
+    ))
   }
   if(procedure %in% c("log10", "ln", "log2")){
-    return(ln_normalisation(data, omic_type, procedure))
+    return(list(
+      data = ln_normalisation(data, omic_type, procedure)
+    ))
   }
   if(procedure == "none"){
-    return(data)
+    return(list(
+      data = data
+    ))
   }
   # if nothing is chosen, raise an error
   stop("No valid Preprocessing procedure chosen")
@@ -97,48 +110,75 @@ ln_normalisation <- function(data, omic_type, logarithm_procedure){
 
 
 deseq_processing <- function(
-  data, omic_type, formula_sub, session_token, batch_correct
+  data, omic_type, deseq_factors
 ){
-  print("Remove all entities which are constant over all samples")
-  data <- data[rownames(data[which(apply(assay(data),1,sd) != 0),]),]
-  # prefilter the data
+  # --- Sanity checks ---
+  if(nrow(data) < 100){
+    stop(
+      "The number of samples is too low for a DESeq2 analysis. Please select at least 100 samples.",
+    )
+  }
+  if (omic_type != "Transcriptomics"){
+    stop(
+      "DESeq2 is only available for Transcriptomics data.",
+    )
+  }
+  if(length(deseq_factors) <= 0){
+    stop(
+      "Please select at least one factor for the DESeq2 analysis.",
+      class = "InvalidInputError"
+    )
+  }
+  # --- DESeq2 preprocessing ---
   data <- prefiltering(data, omic_type)
-  # DESeq2
-  if(omic_type == "Transcriptomics"){
-    if(length(formula_sub) <= 0){
-      stop(
-        "Please select at least one factor for the DESeq2 analysis.",
-        class = "InvalidInputError"
-      )
-    }
-    design_formula <- paste("~", paste(formula_sub, collapse = " + "))
-    # turn each factor into a factor
-    for(i in formula_sub){
-      colData(data)[,i] <- as.factor(colData(data)[,i])
-    }
-    par_tmp[[session_token]][["DESeq_factors"]] <<- c(formula_sub)
-    print(design_formula)
+  design_formula <- paste("~", paste(deseq_factors, collapse = " + "))
+  # turn each factor into a factor
+  for(i in deseq_factors){
+    colData(data)[,i] <- as.factor(colData(data)[,i])
+  }
+  print(design_formula)
 
-    dds <- DESeq2::DESeqDataSetFromMatrix(
-      countData = assay(data),
-      colData = colData(data),
-      design = as.formula(design_formula)
-      )
-
-    de_seq_result <- DESeq2::DESeq(dds)
-    if (batch_correct){
-      res_tmp[[session_token]]$DESeq_obj_batch_corrected <<- de_seq_result
-      par_tmp[[session_token]]["DESeq_formula"] <<- design_formula
-    } else {
-      res_tmp[[session_token]]$DESeq_obj <<- de_seq_result
-      par_tmp[[session_token]]["DESeq_formula_batch"] <<- design_formula
-    }
-    dds_vst <- vst(
-      object = de_seq_result,
-      blind = TRUE
+  dds <- DESeq2::DESeqDataSetFromMatrix(
+    countData = assay(data),
+    colData = colData(data),
+    design = as.formula(design_formula)
     )
-    assay(data) <- as.data.frame(assay(dds_vst))
-    return(data)
+
+  de_seq_result <- DESeq2::DESeq(dds)
+  dds_vst <- vst(
+    object = de_seq_result,
+    blind = TRUE
+  )
+  assay(data) <- as.data.frame(assay(dds_vst))
+  return(list(
+    data = data,
+    DESeq_obj = de_seq_result
+  ))
+}
+
+batch_correction <- function(
+  data, preprocessing_procedure, batch_column, deseq_factors = NULL, omic_type = NULL
+){
+  if (batch_column == "NULL"){
+    return(list(
+      data = NULL
+    ))
   }
-  return(data)
+  batch_res <- list()
+  if(preprocessing_procedure == "vst_DESeq"){
+    batch_res <- deseq_processing(
+      data = data,
+      omic_type = omic_type,
+      deseq_factors = c(deseq_factors, batch_column)
+    )
+    data <- batch_res$data
+  }
+  assay(data) <- sva::ComBat(
+    dat = assay(data),
+    batch = as.factor(colData(data)[,batch_column])
+  )
+  # only use complete cases
+  data <- data[complete.cases(assay(data)),]
+  batch_res$data <- data
+  return(batch_res)
 }

program/shinyApp/R/util.R

@@ -314,3 +314,43 @@ check_and_install_package <- function(package_name) {
   return(snippet)
 }
 
+hide_tabs <- function(){
+  hideTab(inputId = "tabsetPanel1", target = "Sample Correlation")
+  hideTab(inputId = "tabsetPanel1", target = "Differential Analysis")
+  hideTab(inputId = "tabsetPanel1", target = "PCA")
+  hideTab(inputId = "tabsetPanel1", target = "Heatmap")
+  hideTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations")
+  hideTab(inputId = "tabsetPanel1", target = "Enrichment Analysis")
+}
+
+show_tabs <- function(){
+  showTab(inputId = "tabsetPanel1", target = "Sample Correlation")
+  showTab(inputId = "tabsetPanel1", target = "Differential Analysis")
+  showTab(inputId = "tabsetPanel1", target = "PCA")
+  showTab(inputId = "tabsetPanel1", target = "Heatmap")
+  showTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations")
+  showTab(inputId = "tabsetPanel1", target = "Enrichment Analysis")
+}
+
+create_warning_preproc <- function(data, preprocessing_procedure){
+  if(preprocessing_procedure == "filterOnly"){
+    addWarning <- "<font color=\"#000000\"><b>Only Filtering of low abundant is done only if Transcriptomics or Metabolomics was chosen</b></font><br>"
+  } else if(preprocessing_procedure == "none"){
+    addWarning <- "<font color=\"#000000\"><b>No Pre-Processing done. Use on your own accord.</b></font><br>"
+  } else{
+    addWarning <- "<font color=\"#000000\"><b>Pre Filtering to remove low abundant entities done if Transcriptomics or Metabolomics was chosen</b></font><br>"
+  }
+
+  if(any(is.na(assay(data)))){
+    print("This might be problem due to mismatched Annotation Data?!")
+    nrow_before <- nrow(assay(data))
+    nrow_after <- nrow(
+      data[complete.cases(assay(data)),]
+    )
+    addWarning <- paste0(addWarning, "<font color=\"#FF0000\"><b>There were NA's after pre-processing, any row containg such was completly removed! (before/after): ",nrow_before,"/",nrow_after,"</b></font><br>")
+    if(!(nrow_after > 0)){
+      addWarning <- paste0(addWarning, "<br> <font color=\"#FF0000\"><b>There is nothing left, choose different pre-processing other-wise App will crash!</b></font><br>")
+    }
+  }
+  return(addWarning)
+}