fixed to work with SumExp #404 (#425)

ICB-DCM · Dec 19, 2024 · a070f46 · a070f46
1 parent 7ad0b54
commit a070f46
Showing 1 changed file with 60 additions and 5 deletions.
diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R
@@ -1096,13 +1096,68 @@ server <- function(input,output,session){
 
 
     } else if(uploaded_from() == "precompiled"){
+      # Expand to work with any SummarizedExperiment object
+      # (also works with an 'old' pre-compiled object generated by the app)
       uploadedFile <- readRDS(file = input$data_preDone$datapath)
-      if(any(names(uploadedFile) %in% input[[paste0("omic_type_", uploaded_from())]])){
-        # This is a file precompiled before 14.March.2023
-        data_input <- uploadedFile[[input[[paste0("omic_type_", uploaded_from())]]]]
-      } else {
-        data_input[[paste0(input[[paste0("omic_type_", uploaded_from())]],"_SumExp")]] <- uploadedFile
+      # Check if the object is a SummarizedExperiment
+      if (is(uploadedFile, "SummarizedExperiment")) {
+       # a SE object - only esnure that naming of the obeject list fits or re-do
+        data_input[[paste0(omic_type(),"_SumExp")]] <- uploadedFile
+        count_matrix <- assay(data_input[[paste0(omic_type(),"_SumExp")]])
+        if (any(is.na(count_matrix))){
+          output$debug <- renderText({
+            "<font color=\"#FF0000\"><b>The assay data contains missing values, those will be removed.</b></font>"
+          })
+        }else{
+          if (any(count_matrix < 0)) {
+            output$debug <- renderText({
+              "<font color=\"#FF0000\"><b>The assay data contains negative values, which are invalid for some pre-processing procedures.</b></font>"
+            })
+          }
+          if (!all(count_matrix == round(count_matrix))) {
+            output$debug <- renderText({
+              "<font color=\"#FF0000\"><b>The assay data contains non-integer values, which is invalid for DESeq2 pre-processing procedure.</b></font>"
+            })
+          }
+        }
+        } else if(is.list(uploadedFile) & any(sapply(uploadedFile, function(x) is(x, "SummarizedExperiment")))){
+        # get the sum exp from the list
+          getIdxOfSumExp <- sapply(uploadedFile, function(x) is(x, "SummarizedExperiment"))
+          if(length(which(getIdxOfSumExp)) > 1){
+          output$debug <- renderText({
+            "<font color=\"#FF0000\"><b>Upload failed. The provided input contains more than one Summarized Experiment object. Please only provide one</b></font>"
+            return(NULL)
+            })
+          }else{
+            data_input[[paste0(omic_type(),"_SumExp")]] <- uploadedFile[[which(getIdxOfSumExp)]]
+            count_matrix <- assay(data_input[[paste0(omic_type(),"_SumExp")]])
+            if (any(is.na(count_matrix))){
+              output$debug <- renderText({
+                "<font color=\"#FF0000\"><b>The assay data contains missing values, those will be removed.</b></font>"
+              })
+            }else{
+              if (any(count_matrix < 0)) {
+                output$debug <- renderText({
+                  "<font color=\"#FF0000\"><b>The assay data contains negative values, which are invalid for some pre-processing procedures.</b></font>"
+                })
+              }
+              if (!all(count_matrix == round(count_matrix))) {
+                output$debug <- renderText({
+                  "<font color=\"#FF0000\"><b>The assay data contains non-integer values, which is invalid for DESeq2 pre-processing procedure.</b></font>"
+                })
+              }
+            }
+
+            }
+        }else{
+        # not a SE object
+        output$debug <- renderText({
+          "<font color=\"#FF0000\"><b>Upload failed. Is the provided input Summarized Experiment object?</b></font>"
+        })
+        return(NULL)
       }
+
+
     } else if(uploaded_from() == "testdata"){
       data_input <- readRDS(
         file = "www/Transcriptomics_only_precompiled-LS.RDS"