Data upload metadatasheet (#143)

* expand on data upload for visual inspection; fix on data upload with metadata sheet

* fixed upload with metadatasheet

program/shinyApp/R/fun_readInSampleTable.R

@@ -2,9 +2,10 @@
 # Search for sample_section save row number
 # read in again and skip first row number lines
 fun_readInSampleTable <- function(dataFileName){
-  my_data_tmp <- as.data.frame(read_excel(dataFileName,sheet="Input"))
-  RowsToSkip <- which(my_data_tmp[,1]%in%"Sample-section")+1
-  my_data_tmp <- as.data.frame(read_excel(dataFileName,sheet="Input",skip = RowsToSkip))
+  my_data_tmp <- as.data.frame(readxl::read_excel(dataFileName,sheet="Input"))
+  RowsToSkip <- which(my_data_tmp[,1]%in%"Sample-Section")+1
+
+  my_data_tmp <- as.data.frame(readxl::read_excel(dataFileName,sheet="Input",skip = RowsToSkip))
 
   # Advance: check if subsample etc are present 
   # for now remove any non complete rows
@@ -16,6 +17,8 @@ fun_readInSampleTable <- function(dataFileName){
   colnames(my_data_tmp) <- my_data_tmp[1,]
   my_data_tmp <- as.data.frame(my_data_tmp[-1,])
 
+  my_data_tmp <- my_data_tmp[!is.na(my_data_tmp$global_ID),]
+
   return(my_data_tmp) 
 }
 

program/shinyApp/server.R

@@ -215,19 +215,44 @@ server <- function(input,output,session){
       req(F)
     }
     if(!(isTruthy(input$data_matrix1) & 
-         isTruthy(input$data_sample_anno1) & 
+         (isTruthy(input$data_sample_anno1)|isTruthy(input$metadataInput)) & 
          isTruthy(input$data_row_anno1))){
       output$DataMatrix_VI_Info=renderText(
         "The Upload has failed completely, or you haven't uploaded anything yet. Need to uploade all three matrices!"
         )
     }else{
-     Matrix <- read_file(input$data_matrix1$datapath, check.names=T)
-     Matrix2 <- read_file(input$data_matrix1$datapath, check.names=F)
+      flag_csv <- F
+      tryCatch(
+        expr = {
+        Matrix <- read_file(input$data_matrix1$datapath, check.names=T)
+        Matrix2 <- read_file(input$data_matrix1$datapath, check.names=F)
+        flag_csv <- T
+      },
+      error = function(cond){
+        print("Not a real csv file!")
+      }
+      )
+      if(!flag_csv){
+        Matrix <- read.table(input$data_matrix1$datapath,check.names = T)
+        Matrix2 <- read.table(input$data_matrix1$datapath, check.names = F)
+      }else{
+        Matrix <- read_file(input$data_matrix1$datapath, check.names=T)
+        Matrix2 <- read_file(input$data_matrix1$datapath, check.names=F)
+      }
+
+
      output$DataMatrix_VI <- DT::renderDataTable({
        DT::datatable(data = Matrix)
        })
      output$DataMatrix_VI_INFO <- renderText({"Matrix:"})
-     sample_table <- read_file(input$data_sample_anno1$datapath, check.names=T)
+     if(isTruthy(input$data_sample_anno1)){
+       sample_table <- read_file(input$data_sample_anno1$datapath, check.names=T)
+     }else if(isTruthy(input$metadataInput)){
+       sample_table <- fun_readInSampleTable(input$metadataInput$datapath)
+     }else{
+       sample_table <- data.frame()
+     }
+
      output$SampleMatrix_VI <- DT::renderDataTable({
        DT::datatable(data = sample_table)
        })
@@ -252,6 +277,7 @@ server <- function(input,output,session){
        "
        })
 
+     check0 <- ifelse(flag_csv,snippetYes,snippetNo)
      check1 <- ifelse(all(rownames(Matrix) == rownames(annotation_rows)),snippetYes,snippetNo)
      check2 <- ifelse(all(colnames(Matrix) == rownames(sample_table)),snippetYes,snippetNo)
      check3 <- ifelse(any(is.na(Matrix) == T),snippetNo,snippetYes)
@@ -281,6 +307,10 @@ server <- function(input,output,session){
      }
      output$OverallChecks <- renderText({
        paste0("Some overall Checks are running run ...\n
+       Data Matrix is a real csv (has ',' as separators:): ",check0,"\n
+           Most likely: You had a xlsx and exported to csv but your excel is in german 
+           and / or you use ',' as separators for decimal positions. 
+           Fix: change your decimal separator in Excel and re-export!
        Rownames of Matrix are the same as rownames of entitie table ",check1,"\n
        Colnames of Matrix are same as rownames of sample table ",check2," \n
        Matrix has no na ",check3,"\n
@@ -339,6 +369,7 @@ server <- function(input,output,session){
 
 ## create data object ----
   data_input_shiny <- eventReactive(input$refresh1,{
+    browser()
     if(!isTruthy(input$data_preDone) & !FLAG_TEST_DATA_SELECTED()){
       # Include here, that the sample anno can be replaced by metadatasheet
       # potentially this will be extended to all of the fields
@@ -360,16 +391,15 @@ server <- function(input,output,session){
         }
 
       }else if(isTruthy(input$metadataInput)){
-
         tmp_sampleTable <- fun_readInSampleTable(input$metadataInput$datapath)
-
-        tryCatch(
+        test_data_upload <- function(){
+          tryCatch(
           {
             data_input <- list(
               type = as.character(input$omicType),
               Matrix = read_file(
                 input$data_matrix1$datapath, check.names=T
-                )[,rownames(my_data_tmp)],
+                )[,rownames(tmp_sampleTable)],
               sample_table = tmp_sampleTable,
               annotation_rows = read_file(input$data_row_anno1$datapath, check.names=T)
               )
@@ -384,9 +414,12 @@ server <- function(input,output,session){
             return(NULL)
           }
         )
+        }
+        data_input <- test_data_upload()
       }
 
       ## TODO Include here possible Data Checks
+
     }else if(FLAG_TEST_DATA_SELECTED() & !isTruthy(input$data_preDone)){
       #TODO change test data to also not rely on 'Transcriptomics'
 
@@ -397,11 +430,10 @@ server <- function(input,output,session){
       fun_LogIt(
         message = paste0("**DataInput** - Test Data set used")
       )
-    }else{
-
-      uploadedFile <- readRDS(
-
-        file = input$data_preDone$datapath
+
+      }else{
+        uploadedFile <- readRDS(
+          file = input$data_preDone$datapath
       )
 
       if(any(names(uploadedFile)%in% input$omicType)){
@@ -412,7 +444,6 @@ server <- function(input,output,session){
       }
 
     }
-
     ### Added here gene annotation if asked for 
     if(input$AddGeneSymbols & 
        input$omicType == "Transcriptomics"){
@@ -445,11 +476,12 @@ server <- function(input,output,session){
       ## Lets Make a SummarizedExperiment Object for reproducibility and further usage
       data_input[[paste0(input$omicType,"_SumExp")]]=
         SummarizedExperiment(assays  = list(raw = data_input$Matrix),
-                             rowData = data_input$annotation_rows[rownames(data_input$Matrix),],
+                             rowData = data_input$annotation_rows[rownames(data_input$Matrix),,drop=F],
                              colData = data_input$sample_table
                              )
       #TODO make the copy and tab show process dependent if we get here a results object or 'simple' rds
     }
+    browser()
     # TODO SumExp only needed hence more restructuring needed
     res_tmp[['data_original']] <<- data_input[[paste0(input$omicType,"_SumExp")]]
     # Make a copy, to leave original data untouched
@@ -498,6 +530,7 @@ server <- function(input,output,session){
     isTruthy(res_tmp$data)
     # Row
     output$providedRowAnnotationTypes_ui=renderUI({
+      browser()
       req(data_input_shiny())
       shinyWidgets::virtualSelectInput(
         inputId = "providedRowAnnotationTypes",

program/shinyApp/ui.R

@@ -36,6 +36,7 @@ library(shinyalert)
 library(msigdbr)
 library(tidyr)
 library(kableExtra)
+library(readxl)
 # library(svglite)
 
 source("R/C.R")