diff --git a/program/shinyApp/R/data_selection/ui.R b/program/shinyApp/R/data_selection/ui.R index 7f4466cc..b57750f4 100644 --- a/program/shinyApp/R/data_selection/ui.R +++ b/program/shinyApp/R/data_selection/ui.R @@ -1,122 +1,185 @@ data_selection_sidebar_panel <- sidebarPanel( id = "sidebar_data_selection", - div(class = "omic_type", - selectInput( - inputId = "omic_type", - label = "Omic Type that is uploaded", - choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), - selected = "" - ) - ), - div( - class = "AddGeneSymbols_ui", - uiOutput(outputId = "AddGeneSymbols_organism_ui"), - uiOutput(outputId = "AddGeneSymbols_ui") - ), - actionButton( - inputId = "refresh1", - label = "Upload new data", - ), - div( - class = "LineToDistinguish", - hr(style = "border-top: 1px solid #000000;") - ), - div( - class = "DataSelection", - h4("Row selection - biochemical entities") %>% helper(type = "markdown", content = "DataSelection_RowSelection"), - uiOutput(outputId = "providedRowAnnotationTypes_ui"), - uiOutput(outputId = "row_selection_ui"), - uiOutput(outputId = "propensityChoiceUser_ui") - ), - div( - class = "SampleSelection", - h4("Sample selection"), - uiOutput(outputId = "providedSampleAnnotationTypes_ui"), - uiOutput(outputId = "sample_selection_ui")), - uiOutput(outputId = "NextPanel_ui") -) - - -data_selection_main_panel <- mainPanel( - id = "mainPanel_DataSelection", - tabsetPanel( - type = "pills", - tabPanel( - title = "Upload section", + tabsetPanel( + tabPanel("File Input", br(), - hr(style = "border-top: 2px solid #90DBF4;"), - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("91%", "9%"), + div(class = "omic_type", + selectInput( + inputId = "omic_type_file_input", + label = "Omic Type that is uploaded", + choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), + selected = "", + width = "80%" + ) + ), + shiny::fileInput( + inputId = "data_matrix1", + label = HTML('Upload data matrix
(rows entities, cols samples)
Download example data (Transcriptomics, human)'), + accept = c(".csv", ".xlsx"), + width = "80%" + ) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"), + shiny::fileInput( + inputId = "data_sample_anno1", + label = HTML('Upload sample annotation
(rows must be samples)
Download example data'), + accept = c(".csv", ".xlsx"), + width = "80%" + ), + shiny::fileInput( + inputId = "data_row_anno1", + label = HTML('Upload entities annotation matrix
(rows must be entities)
Download example data'), + accept = c(".csv", ".xlsx"), + width = "80%" + ), actionButton( - inputId = "EasyTestForUser", - label = "Start straight away with a test-dataset!", + inputId = "inspect_data", + label = "Inspect data", + icon = icon('eye'), + width = "80%", + ) %>% helper(type = "markdown", content = "DataSelection_UploadInspection"), + br(), br(), br(), + actionButton( + inputId = "refresh_file_input", + label = "Upload new data", + width = "80%", icon = icon('paper-plane'), style = "color: #fffff; background-color: #90DBF4; border-color: #000000" ), + hr(style = "border-top: 1px solid #858585;") + ), + tabPanel("Precompiled", + br(), + div(class = "omic_type", + selectInput( + inputId = "omic_type_precompiled", + label = "Omic Type that is uploaded", + choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), + selected = "" + ) + ), + shiny::fileInput( + inputId = "data_preDone", + label = HTML('Load precompiled data
(saved in this procedure or type SummarizedExperiment)
Download example data'), + accept = ".RDS", + width = "80%" + ), + br(), br(), actionButton( - inputId = "Reset", - label = "Reset" - ) - ) %>% helper(type = "markdown", content = "DataSelection_Reset"), - hr(style = "border-top: 2px solid #90DBF4;"), - a( - id = "toggleAdvanced", - "Data Upload via file input", - style = "background-color: #90DBF4; color: black; padding: 7px 10px; " - ) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"), - shinyjs::hidden(div( - id = "advanced", - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("50%", "50%"), - cellArgs = list(style = "padding: 5px"), - uiOutput(outputId = "data_matrix1_ui"), - uiOutput(outputId = "data_sample_anno1_ui"), + inputId = "refresh_precompiled", + label = "Upload new data", + width = "80%", + icon = icon('paper-plane'), + style = "color: #fffff; background-color: #90DBF4; border-color: #000000", ), - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("50%", "50%"), - cellArgs = list(style = "padding: 5px"), - uiOutput(outputId = "data_row_anno1_ui") %>% helper(type = "markdown", content = "DataSelection_RowAnno"), - uiOutput( - outputId = "data_preDone_ui" - ) %>% helper(type = "markdown", content = "DataSelection_SummarizedExp") - ) - )), - hr(style = "border-top: 2px solid #90DBF4;"), - uiOutput(outputId = "metadataInput_ui") %>% helper(type = "markdown", content = "DataSelection_MetaData"), - hr(style = "border-top: 2px solid #90DBF4;"), - downloadButton( - outputId = "SaveInputAsList", - label = "Save file input to upload later" - ) %>% helper(type = "markdown", content = "DataSelection_compilation_help"), - htmlOutput(outputId = "debug", container = pre), - HTML(text = "
"), - HTML(text = "
") - ), - tabPanel( - title = "Upload visual inspection", - helpText("If you have uploaded your data, you might want to visually check the tables to confirm the correct data format. If you notice irregualarities you will need to correct the input data - this cannot be done in ShinyOmics, See the help on how your data is expected."), - actionButton( - inputId = "DoVisualDataInspection", - label = "Upload data for visual inspection" - ) %>% helper(type = "markdown", content = "DataSelection_UploadInspection"), - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), - DT::dataTableOutput("DataMatrix_VI"), - htmlOutput(outputId = "DataMatrix_VI_Info", container = pre) - ), - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), - DT::dataTableOutput("SampleMatrix_VI"), - htmlOutput(outputId = "SampleMatrix_VI_Info", container = pre) + hr(style = "border-top: 1px solid #858585;") ), - splitLayout( - style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), - DT::dataTableOutput("EntitieMatrix_VI"), - htmlOutput(outputId = "EntitieMatrix_VI_Info", container = pre) + tabPanel("Metadata", + br(), + div(class = "omic_type", + selectInput( + inputId = "omic_type_metadata", + label = "Omic Type that is uploaded", + choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), + selected = "" + ) + ), + shiny::fileInput( + inputId = "data_matrix_metadata", + label = HTML('Upload data matrix
(rows entities, cols samples)
Download example data (Transcriptomics, human)'), + accept = c(".csv", ".xlsx"), + width = "80%" + ), + shiny::fileInput( + inputId = "metadataInput", + label = HTML("Upload your Meta Data Sheet (currently replaces sample annotation)"), + accept = c(".xlsx"), + buttonLabel = list(icon("folder"),"Simply upload your Metadata Sheet!"), + width = "80%" + ) %>% helper(type = "markdown", content = "DataSelection_MetaData"), + shiny::fileInput( + inputId = "data_row_anno_metadata", + label = HTML('Upload entities annotation matrix
(rows must be entities)
Download example data'), + accept = c(".csv", ".xlsx"), + width = "80%" + ), + br(), br(), + actionButton( + inputId = "refresh_metadata", + label = "Upload new data", + width = "80%", + icon = icon('paper-plane'), + style = "color: #fffff; background-color: #90DBF4; border-color: #000000", + ), + hr(style = "border-top: 1px solid #858585;") ), - htmlOutput(outputId = "OverallChecks", container = pre) + tabPanel("Testdata", + br(), + div(class = "omic_type", + selectInput( + inputId = "omic_type_testdata", + label = "Omic Type that is uploaded", + choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), + selected = "" + ) + ), + br(), + actionButton( + inputId = "EasyTestForUser", + label = "Start straight away with a test-dataset!", + icon = icon('paper-plane'), + style = "color: #fffff; background-color: #90DBF4; border-color: #000000" + ), + hr(style = "border-top: 1px solid #858585;") + ) ) ) + + +data_selection_main_panel <- mainPanel( + id = "mainPanel_DataSelection", + div( + class = "AddGeneSymbols_ui", + uiOutput("AddGeneSymbols_organism_ui"), + uiOutput("AddGeneSymbols_ui") + ), + hr(style = "border-top: 1px solid #858585;"), + fluidRow( + column(5, + div(class = "DataSelection", + h4("Row selection - biochemical entities"), + uiOutput("providedRowAnnotationTypes_ui"), + uiOutput("row_selection_ui"), + uiOutput("propensityChoiceUser_ui") + )), + column(6, + div(class = "SampleSelection", + h4("Sample selection") %>% helper(type = "markdown", content = "DataSelection_RowSelection"), + uiOutput("providedSampleAnnotationTypes_ui"), + uiOutput("sample_selection_ui") + )) + ), + hr(style = "border-top: 1px solid #858585;"), + div( + id = "SaveInputAsRDS", + downloadButton( + outputId = "SaveInputAsList", + label = "Save file input to upload later" + ) %>% helper(type = "markdown", content = "DataSelection_compilation_help") + ), + htmlOutput(outputId = "debug", container = pre), + br(), br(), br(), + hr(style = "border-top: 1px solid #858585;"), + actionButton( + inputId = "NextPanel", + label = "Start the Journey", + width = "100%", + icon = icon('rocket'), + style = "color: #fffff; background-color: #EC001447; border-color: #000000" + ), + # hidden button + hidden(actionButton( + inputId = "refresh1", + label = "YOu should not be seeing this" + )) ) @@ -130,4 +193,4 @@ data_selection_panel <- tabPanel( ################################################################################ data_selection_sidebar_panel, data_selection_main_panel -) \ No newline at end of file +) diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index ab7acbf4..efed60b9 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -55,6 +55,7 @@ server <- function(input,output,session){ hideTab(inputId = "tabsetPanel1", target = "Heatmap") hideTab(inputId = "tabsetPanel1", target = "Single Gene Visualisations") hideTab(inputId = "tabsetPanel1", target = "Enrichment Analysis") + shinyjs::hide("mainPanel_DataSelection") # Init res_tmp and par_tmp objects if they do not yet exist ---- if(!exists("res_tmp")){ @@ -111,69 +112,9 @@ server <- function(input,output,session){ print("Data Upload") ## Set reactiveVals ---- - FLAG_TEST_DATA_SELECTED <- reactiveVal(FALSE) + uploaded_from <- reactiveVal(NULL) + omic_type <- reactiveVal(NULL) -## Ui Section ---- - observeEvent(input$Reset,{ - FLAG_TEST_DATA_SELECTED(FALSE) - output$debug <- renderText("Reset successful") - shinyjs::reset(id="data_matrix1") - shinyjs::reset(id="data_sample_anno1") - shinyjs::reset(id="data_row_anno1") - shinyjs::reset(id="data_preDone") - shinyjs::reset(id="metadataInput") - # set input values to actual zero - session$sendCustomMessage(type = "resetValue", message = "data_matrix1") - session$sendCustomMessage(type = "resetValue", message = "data_sample_anno1") - session$sendCustomMessage(type = "resetValue", message = "data_row_anno1") - session$sendCustomMessage(type = "resetValue", message = "data_preDone") - session$sendCustomMessage(type = "resetValue", message = "metadataInput") - }) - - observeEvent(input$EasyTestForUser,{ - # reset all data inputs except FLAG_TEST_DATA_SELECTED - # MAYBE TODO: would be nice if we could just click reset here. Somehow not working. - shinyjs::reset(id="data_matrix1") - shinyjs::reset(id="data_sample_anno1") - shinyjs::reset(id="data_row_anno1") - shinyjs::reset(id="data_preDone") - shinyjs::reset(id="metadataInput") - # set input values to actual zero - session$sendCustomMessage(type = "resetValue", message = "data_matrix1") - session$sendCustomMessage(type = "resetValue", message = "data_sample_anno1") - session$sendCustomMessage(type = "resetValue", message = "data_row_anno1") - session$sendCustomMessage(type = "resetValue", message = "data_preDone") - session$sendCustomMessage(type = "resetValue", message = "metadataInput") - FLAG_TEST_DATA_SELECTED(TRUE) - shinyjs::click("refresh1") - }) - - shinyjs::onclick("toggleAdvanced", shinyjs::toggle(id = "advanced", anim = TRUE)) - - output$data_matrix1_ui <- renderUI({shiny::fileInput( - inputId = "data_matrix1", - label = HTML('Upload data matrix
(rows entities, cols samples)
Download example data (Transcriptomics, human)'), - accept = c(".csv", ".xlsx"), - width = "80%" - ) }) - output$data_sample_anno1_ui <- renderUI({shiny::fileInput( - inputId = "data_sample_anno1", - label = HTML('Upload sample annotation
(rows must be samples)
Download example data'), - accept = c(".csv", ".xlsx"), - width = "80%" - )}) - output$data_row_anno1_ui <- renderUI({shiny::fileInput( - inputId = "data_row_anno1", - label = HTML('Upload entities annotation matrix
(rows must be entities)
Download example data'), - accept = c(".csv", ".xlsx"), - width = "80%" - )}) - output$data_preDone_ui <- renderUI({shiny::fileInput( - inputId = "data_preDone", - label = HTML('Load precompiled data
(saved in this procedure or type SummarizedExperiment)
Download example data'), - accept = ".RDS", - width = "80%" - )}) output$SaveInputAsList <- downloadHandler( filename = function() { paste0(input$omic_type, "_only_precompiled", " ", Sys.time(), ".RDS") }, @@ -185,18 +126,11 @@ server <- function(input,output,session){ ) } ) - output$metadataInput_ui <- renderUI({shiny::fileInput( - inputId = "metadataInput", - label = HTML("Upload your Meta Data Sheet (currently replaces sample annotation)"), - accept = c(".xlsx"), - buttonLabel = list(icon("folder"),"Simply upload your Metadata Sheet!"), - width = "100%" - )}) - observeEvent(input$omic_type,{ + observeEvent(omic_type(),{ output$AddGeneSymbols_ui <- NULL output$AddGeneSymbols_organism_ui <- NULL - if(input$omic_type == "Transcriptomics"){ + if(omic_type() == "Transcriptomics"){ output$AddGeneSymbols_ui <- renderUI({ actionButton( inputId = "AddGeneSymbols", @@ -213,7 +147,6 @@ server <- function(input,output,session){ }) observeEvent(input$AddGeneSymbols, { - shinyjs::click("refresh1") req(data_input_shiny()) req(res_tmp[[session$token]]$data_original) annotation_result <- detect_annotation(res_tmp[[session$token]]$data_original) @@ -256,7 +189,7 @@ server <- function(input,output,session){ observeEvent(input$do_annotation, { # Added gene annotation if asked for - if(input$AddGeneSymbols & input$omic_type == "Transcriptomics") { + if(input$AddGeneSymbols & input[[paste0("omic_type_", uploaded_from())]] == "Transcriptomics") { fun_LogIt( message = "**DataInput** - Gene Annotation (SYMBOL and gene type) was added" ) @@ -300,11 +233,65 @@ server <- function(input,output,session){ rowData(res_tmp[[session$token]]$data_original)$entrezgene_id[matched_rows] <<- matched_out$entrezgene_id[matched_rows] } } - + par_tmp[[session$token]]['organism'] <<- input$AddGeneSymbols_organism removeModal() }) + + # Observer to toggle visibility of the download button and helper + observe({ + if (is.null(uploaded_from())) { + shinyjs::hide("SaveInputAsRDS") + } + req(uploaded_from()) + if (uploaded_from() == "metadata" || uploaded_from() == "file_input") { + shinyjs::show("SaveInputAsRDS") + } else { + shinyjs::hide("SaveInputAsRDS") + } + }) + + # Observer to toggle visibility of the complete main panel + observe({ + if (input$refresh1 > 0) { + req(data_input_shiny() == "DataUploadSuccesful") + shinyjs::show("mainPanel_DataSelection") + } else { + shinyjs::hide("mainPanel_DataSelection") + } + }) ## Upload visual inspection ---- + observeEvent(input$inspect_data, { + showModal(modalDialog( + title = "Upload Visual Inspection", + helpText("If you have uploaded your data, you might want to visually check the tables to confirm the correct data format. If you notice irregualarities you will need to correct the input data - this cannot be done in ShinyOmics, See the help on how your data is expected."), + br(), + actionButton( + inputId = "DoVisualDataInspection", + label = "Upload data for visual inspection" + ) %>% helper(type = "markdown", content = "DataSelection_UploadInspection"), + splitLayout( + style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), + DT::dataTableOutput("DataMatrix_VI"), + htmlOutput(outputId = "DataMatrix_VI_Info", container = pre) + ), + splitLayout( + style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), + DT::dataTableOutput("SampleMatrix_VI"), + htmlOutput(outputId = "SampleMatrix_VI_Info", container = pre) + ), + splitLayout( + style = "border: 1px solid silver:", cellWidths = c("70%", "30%"), + DT::dataTableOutput("EntitieMatrix_VI"), + htmlOutput(outputId = "EntitieMatrix_VI_Info", container = pre) + ), + htmlOutput(outputId = "OverallChecks", container = pre), + easyClose = TRUE, + footer = modalButton("Close"), + size = "l", # large modal + class = "custom-modal" # custom class for this modal + )) + }) observeEvent(input$DoVisualDataInspection,{ if(isTruthy(input$data_preDone)){ @@ -408,29 +395,62 @@ server <- function(input,output,session){ }) } }) + + observeEvent(input$refresh_file_input, { + uploaded_from("file_input") + shinyjs::click("refresh1") + }) + + observeEvent(input$refresh_precompiled, { + uploaded_from("precompiled") + shinyjs::click("refresh1") + }) + + observeEvent(input$refresh_metadata, { + uploaded_from("metadata") + shinyjs::click("refresh1") + }) + + observeEvent(input$EasyTestForUser,{ + uploaded_from("testdata") + shinyjs::click("refresh1") + }) ## Do Upload ---- observeEvent(input$refresh1,{ - par_tmp[[session$token]]['omic_type'] <<- input$omic_type - par_tmp[[session$token]]['organism'] <<- input$AddGeneSymbols_organism + req(data_input_shiny()) + par_tmp[[session$token]]['omic_type'] <<- input[[paste0("omic_type_", uploaded_from())]] + omic_type(input[[paste0("omic_type_", uploaded_from())]]) fun_LogIt(message = "## DataInput {.tabset .tabset-fade}") fun_LogIt(message = "### Info") fun_LogIt( message = paste0("**DataInput** - Uploaded Omic Type: ", par_tmp[[session$token]]['omic_type']) ) - if(!(isTruthy(input$data_preDone) | - FLAG_TEST_DATA_SELECTED() | - (isTruthy(input$data_matrix1) & - isTruthy(input$data_sample_anno1) & - isTruthy(input$data_row_anno1)) + if(!( + # Is Precompiled data used? + (isTruthy(input$data_preDone) & uploaded_from() == "precompiled") | + # Is File Input used? + (isTruthy(input$data_matrix1) & + isTruthy(input$data_sample_anno1) & + isTruthy(input$data_row_anno1) & + uploaded_from() == "file_input" + ) | + # Is Metadata used? + (isTruthy(input$data_matrix_metadata) & + isTruthy(input$metadataInput) & + isTruthy(input$data_row_anno_metadata) & + uploaded_from() == "file_input" + ) | + # Is Test Data used? + uploaded_from() == "testdata" )){ output$debug <- renderText("The Upload has failed, or you haven't uploaded anything yet") - } else if (FLAG_TEST_DATA_SELECTED() & !(isTruthy(input$data_preDone))){ + } else if (uploaded_from() == "testdata"){ output$debug <- renderText({"The Test Data Set was used"}) } else { show_toast( - title = paste0(par_tmp[[session$token]]['omic_type'],"Data Upload"), - text = paste0(par_tmp[[session$token]]['omic_type'],"-data upload was successful"), + title = paste(par_tmp[[session$token]]['omic_type'],"Data Upload"), + text = paste(par_tmp[[session$token]]['omic_type'],"-data upload was successful"), position = "top", timer = 1500, timerProgressBar = T @@ -458,22 +478,43 @@ server <- function(input,output,session){ ## create data object ---- data_input_shiny <- eventReactive(input$refresh1,{ + req( + (isTruthy(input$data_preDone) & uploaded_from() == "precompiled") | + # Is File Input used? + (isTruthy(input$data_matrix1) & + isTruthy(input$data_sample_anno1) & + isTruthy(input$data_row_anno1) & + uploaded_from() == "file_input" + ) | + # Is Metadata used? + (isTruthy(input$data_matrix_metadata) & + isTruthy(input$metadataInput) & + isTruthy(input$data_row_anno_metadata) & + uploaded_from() == "file_input" + ) | + # Is Test Data used? + uploaded_from() == "testdata" + ) # initialize empty data_input object data_input <- list() - if(isTruthy(input$data_preDone)){ # precompiled data upload - uploadedFile <- readRDS(file = input$data_preDone$datapath) - if(any(names(uploadedFile) %in% input$omic_type)){ - # This is a file precompiled before 14.March.2023 - data_input <- uploadedFile[[input$omic_type]] - } else { - data_input[[paste0(input$omic_type,"_SumExp")]] <- uploadedFile + # upload depending on where the button was clicked + if(uploaded_from()=="file_input"){ + data_input <- list( + Matrix = read_file(input$data_matrix1$datapath, check.names=T), + sample_table = read_file(input$data_sample_anno1$datapath, check.names=T), + annotation_rows = read_file(input$data_row_anno1$datapath, check.names=T) + ) + # check if only 1 col in anno row, + # add dummy col to ensure R does not turn it into a vector + if(ncol(data_input$annotation_rows) < 2){ + data_input$annotation_rows$origRownames <- rownames(data_input$annotation_rows) } - } else if(isTruthy(input$metadataInput)){ # Metadata upload + } else if(uploaded_from()=="metadata"){ tmp_sampleTable <- fun_readInSampleTable(input$metadataInput$datapath) test_data_upload <- function(){ tryCatch({ data_input <- list( - type = as.character(input$omic_type), + type = as.character(input[[paste0("omic_type_", uploaded_from())]]), Matrix = read_file( input$data_matrix1$datapath, check.names=T )[,rownames(tmp_sampleTable)], @@ -492,27 +533,22 @@ server <- function(input,output,session){ }) } data_input <- test_data_upload() - } else if(isTruthy(input$data_sample_anno1)){ # Try upload via file input - data_input <- list( - type = as.character(input$omic_type), - Matrix = read_file(input$data_matrix1$datapath, check.names=T), - sample_table = read_file(input$data_sample_anno1$datapath, check.names=T), - annotation_rows = read_file(input$data_row_anno1$datapath, check.names=T) - ) - # check if only 1 col in anno row, - # add dummy col to ensure R does not turn it into a vector - if(ncol(data_input$annotation_rows) < 2){ - data_input$annotation_rows$origRownames <- rownames(data_input$annotation_rows) + } else if(uploaded_from()=="precompiled"){ + 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 } - } else if(FLAG_TEST_DATA_SELECTED()){ # Upload test data - #TODO change test data to also not rely on 'Transcriptomics' + } else if(uploaded_from()=="testdata"){ data_input <- readRDS( file = "www/Transcriptomics_only_precompiled-LS.RDS" - )[[input$omic_type]] + )[[input[[paste0("omic_type_", uploaded_from())]]]] fun_LogIt( message = paste0("**DataInput** - Test Data set used") ) - } else { # TODO: Meaningfull error message as info + } else { output$debug <- renderText({ "Upload failed, please check your input." }) @@ -520,16 +556,33 @@ server <- function(input,output,session){ } if(!any(class(data_input) == "SummarizedExperiment") & !any(grepl('SumExp',names(data_input))) ){ - ## Lets Make a SummarizedExperiment Object for reproducibility and further usage - data_input[[paste0(input$omic_type,"_SumExp")]] <- SummarizedExperiment( - assays = list(raw = data_input$Matrix), - rowData = data_input$annotation_rows[rownames(data_input$Matrix),,drop=F], - colData = data_input$sample_table + summarized_experiment <- tryCatch( + expr = { + ## Lets Make a SummarizedExperiment Object for reproducibility and further usage + sum_exp <- SummarizedExperiment( + assays = list(raw = data_input$Matrix), + rowData = data_input$annotation_rows[rownames(data_input$Matrix),,drop=F], + colData = data_input$sample_table + ) + sum_exp + }, + error = function(e){ + print("Error! Uploading via file input failed") + output$debug <- renderText({ + "Uploading failed: The uplaoded files could not be put into a SummarizedExperiment. Try the 'Inspect data' button for potential errors." + }) + NULL + } ) + if(is.null(summarized_experiment)){ + return(NULL) + } else { + data_input[[paste0(input[[paste0("omic_type_", uploaded_from())]],"_SumExp")]] <- summarized_experiment + } #TODO make the copy and tab show process dependent if we get here a results object or 'simple' rds } # TODO SumExp only needed hence more restructuring needed - res_tmp[[session$token]][['data_original']] <<- data_input[[paste0(input$omic_type,"_SumExp")]] + res_tmp[[session$token]][['data_original']] <<- data_input[[paste0(input[[paste0("omic_type_", uploaded_from())]],"_SumExp")]] # Make a copy, to leave original data untouched res_tmp[[session$token]][['data']] <<- res_tmp[[session$token]]$data_original # Count up updating @@ -645,12 +698,6 @@ server <- function(input,output,session){ multiple = T ) }) - output$NextPanel_ui <- renderUI({actionButton( - inputId = "NextPanel", - label = "Start the Journey", - width = "100%", - icon = icon("fas fa-angle-double-right") - )}) }) ## Log Selection ---- diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index 617937d2..2f2d537a 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -82,6 +82,10 @@ ui <- shiny::fluidPage( .tabbable > .nav > li[class=active] > a { background-color: #7a7e80; color:black } + .custom-modal .modal-dialog { + width: 90%; + max-width: 90%; + } #sidebar_data_selection { background-color: #EC001447; }