diff --git a/program/shinyApp/R/C.R b/program/shinyApp/R/C.R index f2444849..03d9419a 100644 --- a/program/shinyApp/R/C.R +++ b/program/shinyApp/R/C.R @@ -2,6 +2,10 @@ NOTES_PlACEHOLDER <<- "Notes you want to take alongside the Plot (will be saved in the report) \nYou may want to use markdown syntay for structering the notes " NOTES_HELP <<- "Notes: For structure reasons you should start with Heading Level 4 (hence #### My personal Title)" +# Jokes +JOKES <<- read.csv("joke-db.csv") +JOKES <<- JOKES[nchar(JOKES$Joke)>0 & nchar(JOKES$Joke)<180,] + # Test correction list PADJUST_METHOD <<- list( "None" = "none", diff --git a/program/shinyApp/R/SourceAll.R b/program/shinyApp/R/SourceAll.R index 61ac9f53..d1d179ea 100644 --- a/program/shinyApp/R/SourceAll.R +++ b/program/shinyApp/R/SourceAll.R @@ -19,4 +19,5 @@ source("R/sample_correlation/server.R", local = T) source("R/sample_correlation/util.R", local = T) source("R/significance_analysis/server.R", local = T) source("R/significance_analysis/util.R", local = T) -source("R/fun_getCurrentVersionFromChangeLog.R",local = T) +source("R/pre_processing/util.R", local = T) +source("R/util.R", local = T) diff --git a/program/shinyApp/R/data_selection/ui.R b/program/shinyApp/R/data_selection/ui.R index 6e3e1439..e081657f 100644 --- a/program/shinyApp/R/data_selection/ui.R +++ b/program/shinyApp/R/data_selection/ui.R @@ -1,8 +1,8 @@ data_selection_sidebar_panel <- sidebarPanel( id = "sidebar_data_selection", - div(class = "omicType", + div(class = "omic_type", selectInput( - inputId = "omicType", # RNAorLIPID + inputId = "omic_type", label = "Omic Type that is uploaded", choices = c("Transcriptomics", "Lipidomics", "Metabolomics"), selected = "" @@ -13,7 +13,6 @@ data_selection_sidebar_panel <- sidebarPanel( uiOutput(outputId = "AddGeneSymbols_ui"), uiOutput(outputId = "AddGeneSymbols_organism_ui") ), - #uiOutput("AddGeneSymbols_organism_ui"), actionButton( inputId = "refresh1", label = "Do" @@ -29,7 +28,6 @@ data_selection_sidebar_panel <- sidebarPanel( uiOutput(outputId = "row_selection_ui"), uiOutput(outputId = "propensityChoiceUser_ui") ), - # Outlier Selection -> for fixed removal pre-processing needs to be redone! div( class = "SampleSelection", h4("Sample selection"), @@ -62,17 +60,17 @@ data_selection_main_panel <- mainPanel( NULL ), hr(style = "border-top: 2px solid #90DBF4;"), - a(id = "toggleAdvanced", + 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( + ) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"), + shinyjs::hidden(div( id = "advanced", splitLayout( style = "border: 1px solid silver:", cellWidths = c("50%", "50%"), - uiOutput(outputId = "data_matrix1_ui"), # %>% helper(type = "markdown", content = "DataSelection_Matrix"), - uiOutput(outputId = "data_sample_anno1_ui"), # %>% helper(type = "markdown", content = "DataSelection_SampleAnno") + uiOutput(outputId = "data_matrix1_ui"), + uiOutput(outputId = "data_sample_anno1_ui"), ), splitLayout( style = "border: 1px solid silver:", cellWidths = c("50%", "50%"), @@ -81,8 +79,7 @@ data_selection_main_panel <- mainPanel( 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;"), diff --git a/program/shinyApp/R/fun_LogIt.R b/program/shinyApp/R/fun_LogIt.R index db60060e..341496fa 100644 --- a/program/shinyApp/R/fun_LogIt.R +++ b/program/shinyApp/R/fun_LogIt.R @@ -5,7 +5,7 @@ fun_LogIt <- function( addPlot = F, tableSaved = F, Filename = NULL, - jokes = jokesDF + jokes = JOKES ){ # sophisticated "Where to place log file" LogfileName <- "www/Report.md" # DO NOT CHANGE THE NAME! diff --git a/program/shinyApp/R/fun_getCurrentVersionFromChangeLog.R b/program/shinyApp/R/fun_getCurrentVersionFromChangeLog.R deleted file mode 100644 index b0662be7..00000000 --- a/program/shinyApp/R/fun_getCurrentVersionFromChangeLog.R +++ /dev/null @@ -1,14 +0,0 @@ -# Write function to insert current release absed on CHANGE log to DESCRIPTIOn -# Return current version -getCurrentVersion <- function(updateDESCRIPTION = T){ - ChangeLog <- readLines("../../CHANGELOG.md") - # take the first hit as it is the most recent - recentSeries <- which(grepl("series$",ChangeLog))[1] - recentVersion <- ChangeLog[recentSeries+4] - DESCRIPTION <- readLines("DESCRIPTION") - DESCRIPTION_new <- gsub("Version:.*$",paste0("Version: ",recentVersion),DESCRIPTION) - writeLines(DESCRIPTION_new,con ="DESCRIPTION" ) - - # take the + next line to get version - return(recentVersion) -} diff --git a/program/shinyApp/R/pre_processing/ui.R b/program/shinyApp/R/pre_processing/ui.R index b86808c7..e87c3f24 100644 --- a/program/shinyApp/R/pre_processing/ui.R +++ b/program/shinyApp/R/pre_processing/ui.R @@ -15,13 +15,7 @@ pre_processing_sidebar_panel <- sidebarPanel( ) %>% helper(type = "markdown", content = "PreProcessing_Procedures"), uiOutput(outputId = "DESeq_formula_main_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqMain"), uiOutput(outputId = "DESeq_formula_sub_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqSub"), - switchInput( - inputId = "DESeq_show_advanced", - label = "Advanced formula options for DESeq2", - inline = T, - size = "mini", - value = F - ), + uiOutput(outputId = "DESeq_show_advanced_ui"), uiOutput(outputId = "DESeq_formula_advanced_ui"), actionButton( inputId = "Do_preprocessing", @@ -36,16 +30,9 @@ pre_processing_main_panel <- mainPanel( id = "mainpanel_pre_processing", # Statistics to the data helpText("general statistics to the input data, stuff like dimensions"), - # hidden(div(id = 'Spinner_Statisitcs_Data', plotOutput("Statisitcs_Data")%>% withSpinner(type=8))), htmlOutput(outputId = "Statisitcs_Data") %>% withSpinner(type = 8), HTML(text = "
"), - HTML(text = "
"), - splitLayout( - cellWidths = c("25%", "25%", "25%"), - # uiOutput(outputId = "NextPanel2_ui"), - # uiOutput(outputId = "NextPanel3_ui"), - # uiOutput(outputId = "NextPanel4_ui") - ) + HTML(text = "
") ) @@ -53,7 +40,7 @@ pre_processing_panel <- tabPanel( title = "Pre-processing", id = "pre_processing_panel", fluid = T, - h4("Data Pre-processing"), # %>% helper(type = "markdown", content = "PreProcessing_help"), + h4("Data Pre-processing"), pre_processing_sidebar_panel, pre_processing_main_panel ) \ No newline at end of file diff --git a/program/shinyApp/R/pre_processing/util.R b/program/shinyApp/R/pre_processing/util.R new file mode 100644 index 00000000..af7be89e --- /dev/null +++ b/program/shinyApp/R/pre_processing/util.R @@ -0,0 +1,129 @@ +# preprocessing procedures + +prefiltering <- function(data, omic_type){ + # Filter out low abundant entities for Metabol- and Transcriptomics. + if(omic_type == "Transcriptomics"){ + print("Remove anything of rowCount <=10") + return(data[which(rowSums(assay(data)) > 10),]) + } + if(omic_type == "Metabolomics"){ + print("Remove anything which has a row median of 0") + return(data[which(apply(assay(data),1,median)!=0),]) + } +} + + +simple_center_scaling <- function(data, omic_type){ + # Center and scale the data + print("Do chosen Preprocessing: simpleCenterScaling") + # prefilter the data + data <- prefiltering(data, omic_type) + # center and scale the data + processedData <- as.data.frame(t(scale( + x = as.data.frame(t(as.data.frame(assay(data)))), + scale = T, + center = T + ))) + assay(data) <- processedData + return(data) +} + + +scaling_normalisation <- function(data, omic_type, scaling_procedure){ + # Center and scale the data + print(paste0("Do chosen Preprocessing: ", scaling_procedure)) + # prefilter the data + data <- prefiltering(data, omic_type) + # scaling functions + fun_scale <- function(x){ + return((x-min(x))/(max(x)-min(x))) + } + fun_pareto <- function(x){ + return((x-mean(x))/sqrt(var(x))) + } + scaling_function <- ifelse(scaling_procedure == "Scaling_0_1", fun_scale, fun_pareto) + processedData <- as.data.frame(t(apply( + X = assay(data), + MARGIN = 1, + FUN = scaling_function + ))) + assay(data) <- processedData + return(data) +} + + +ln_normalisation <- function(data, omic_type, logarithm_procedure){ + # Center and scale the data + print(paste0("Do chosen Preprocessing: ", logarithm_procedure)) + logarithm <- ifelse(logarithm_procedure == "log10", log10, log) + # prefilter the data + data <- prefiltering(data, omic_type) + # log the data and always add 1 to avoid -Inf + processedData <- as.data.frame(logarithm(as.data.frame(assay(data)) + 1)) + assay(data) <- processedData + return(data) +} + + +deseq_processing <- function( + data, omic_type, formula_main, formula_sub, session_token, advanced_formula = NULL +){ + # Center and scale the data + print("Do chosen Preprocessing: vst_DESeq") + # prefilter the data + data <- prefiltering(data, omic_type) + # DESeq2 + par_tmp[[session_token]]["DESeq_advanced"] <<- FALSE + if(omic_type == "Transcriptomics"){ + design_formula <- paste("~", formula_main) + # only do this locally + colData(data)[,formula_main] <- as.factor( + colData(data)[,formula_main] + ) + if(length(formula_sub) > 0){ + design_formula <- paste( + design_formula, " + ", + 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_main,formula_sub + ) + } + else{ + par_tmp[[session_token]][["DESeq_factors"]] <<- c(formula_main) + } + # if advanced formula is used, overwrite the other formula + if(!(advanced_formula == "") & startsWith(advanced_formula, "~")){ + print("Advanced formula used") + design_formula <- advanced_formula + par_tmp[[session_token]]["DESeq_advanced"] <<- TRUE + } + print(design_formula) + par_tmp[[session_token]]["DESeq_formula"] <<- design_formula + # on purpose local + print(colData(data)[,formula_main]) + + dds <- DESeq2::DESeqDataSetFromMatrix( + countData = assay(data), + colData = colData(data), + design = as.formula(design_formula) + ) + + de_seq_result <- DESeq2::DESeq(dds) + res_tmp[[session_token]]$DESeq_obj <<- de_seq_result + dds_vst <- vst( + object = de_seq_result, + blind = TRUE + ) + assay(data) <- as.data.frame(assay(dds_vst)) + return(data) + } + addWarning <- "DESeq makes only sense for transcriptomics data - data treated as if 'filterOnly' was selected!" + return(data) +} diff --git a/program/shinyApp/R/util.R b/program/shinyApp/R/util.R index 8bd69c37..7058ee2f 100644 --- a/program/shinyApp/R/util.R +++ b/program/shinyApp/R/util.R @@ -1,6 +1,5 @@ ### general utility functions will be defined here - update_data <- function(session_id){ # for stability reasons, data is ALWAYS pulled here print("Updating data...") @@ -8,6 +7,7 @@ update_data <- function(session_id){ return(data) } + select_data <- function(data, selected_samples, sample_type){ # select data for e.g. pca's or alike samples_selected <- c() @@ -25,6 +25,7 @@ select_data <- function(data, selected_samples, sample_type){ return(data) } + update_params <- function(session_id){ # update parameter if updates is larger than current_updates # could force to always update @@ -33,6 +34,7 @@ update_params <- function(session_id){ return(params) } + read_file <- function(filename, check.names=T){ # reads in the file of either a .csv or a .xlsx filetype if (base::endsWith(filename, ".csv")){ @@ -72,6 +74,7 @@ getUserReactiveValues <- function(data = input){ return(tmp[to_include]) } + save_pheatmap <- function(x, filename,type = "pdf") { # Saves a heatmap to a file in different formats stopifnot(!missing(x)) @@ -98,3 +101,19 @@ save_pheatmap <- function(x, filename,type = "pdf") { dev.off() } } + + +getCurrentVersion <- function(updateDESCRIPTION = T){ + # Write function to insert current release absed on CHANGE log to DESCRIPTIOn + # Return current version + ChangeLog <- readLines("../../CHANGELOG.md") + # take the first hit as it is the most recent + recentSeries <- which(grepl("series$",ChangeLog))[1] + recentVersion <- ChangeLog[recentSeries+4] + DESCRIPTION <- readLines("DESCRIPTION") + DESCRIPTION_new <- gsub("Version:.*$",paste0("Version: ",recentVersion),DESCRIPTION) + writeLines(DESCRIPTION_new,con ="DESCRIPTION" ) + + # take the + next line to get version + return(recentVersion) +} diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R index 8aa2fb38..5bf0cfb1 100644 --- a/program/shinyApp/server.R +++ b/program/shinyApp/server.R @@ -1,6 +1,5 @@ server <- function(input,output,session){ source("R/SourceAll.R",local=T) - source("R/util.R") # fill session_if textOutput with current session$token output$session_id <- renderText({ @@ -14,21 +13,15 @@ server <- function(input,output,session){ options(shiny.maxRequestSize=20*(1024^2)) # request 20MB observeEvent(input$guide_cicerone_next,{ - # triggers but guide is deteached + # triggers but guide is detached if(input$guide_cicerone_next$highlighted == "mainPanel_DataSelection"){ print("Here will be now automatically data uploaded ") }else{ print("Mööp") } }) - -# Load external Data ---- - jokesDF <- read.csv("joke-db.csv") - jokesDF <- jokesDF[nchar(jokesDF$Joke)>0 & nchar(jokesDF$Joke)<180,] - print("Hello Shiny") - - #### Clean Up + #### Clean Up # create www folder if not present if(dir.exists("www")){ setwd("www") @@ -42,10 +35,9 @@ server <- function(input,output,session){ print("Removed old Report files for fresh start") setwd("..") } - observe_helpers() + # Guide ---- - observeEvent(input$guide, { print("Jip") guide$init()$start() @@ -54,12 +46,6 @@ server <- function(input,output,session){ # Download Report pdf ---- DownloadReport_server("DownloadTestModule") - # To allow Reconnection wiht lost Session, potential - # security issue + more than one user issues potentially ?! - # Thats why further security - # session$allowReconnect(TRUE) - # what if complete new start (should have button for this ?!) - # session$allowReconnect("force") # To test locally # Layout upon Start ---- hideTab(inputId = "tabsetPanel1", target = "Pre-processing") @@ -98,15 +84,15 @@ server <- function(input,output,session){ "Download report", download=NA, target="_blank" - ), + ), actionButton( inputId = "Done", label = "Done" - ), + ), modalButton('Cancel') ) - ) ) + ) }) observeEvent(input$Done,{ @@ -123,10 +109,11 @@ server <- function(input,output,session){ # Data Upload + checks ---- print("Data Upload") + ## Set reactiveVals ---- FLAG_TEST_DATA_SELECTED <- reactiveVal(FALSE) -## Ui Section ---- +## Ui Section ---- observeEvent(input$Reset,{ FLAG_TEST_DATA_SELECTED(FALSE) output$debug <- renderText("Reset successful") @@ -160,81 +147,67 @@ server <- function(input,output,session){ FLAG_TEST_DATA_SELECTED(TRUE) shinyjs::click("refresh1") }) + + shinyjs::onclick("toggleAdvanced", shinyjs::toggle(id = "advanced", anim = TRUE)) - 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$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() { - paste(input$omicType,"_only_precompiled", " ",Sys.time(),".RDS",sep = "")}, + paste0(input$omic_type, "_only_precompiled", " ", Sys.time(), ".RDS") }, content = function(file){ # TODO Q: What to save here? only original enough? saveRDS( object = res_tmp[[session$token]]$data_original, file = file - ) + ) } ) - 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%" - ) - }) + 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$omicType,{ + observeEvent(input$omic_type,{ + output$AddGeneSymbols_ui <- NULL + output$AddGeneSymbols_organism_ui <- NULL if(input$omicType == "Transcriptomics"){ - output$AddGeneSymbols_ui=renderUI({ - checkboxInput( - inputId = "AddGeneSymbols", - label = "Adding gene Annotation?", - value = F - ) - - }) - output$AddGeneSymbols_organism_ui <- renderUI({ - selectInput( - inputId = "AddGeneSymbols_organism", - label = "Which Organisms?", - choices = listDatasets(useEnsembl(biomart = "genes"))[,"description"], - selected = "Mouse genes (GRCm39)" - ) - }) - }else{ - output$AddGeneSymbols_ui = NULL - output$AddGeneSymbols_organism_ui = NULL + output$AddGeneSymbols_ui <- renderUI({checkboxInput( + inputId = "AddGeneSymbols", + label = "Adding gene Annotation?", + value = F + )}) + output$AddGeneSymbols_organism_ui <- renderUI({selectInput( + inputId = "AddGeneSymbols_organism", + label = "Which Organisms?", + choices = listDatasets(useEnsembl(biomart = "genes"))[,"description"], + selected = "Mouse genes (GRCm39)" + )}) } }) @@ -242,116 +215,104 @@ server <- function(input,output,session){ observeEvent(input$DoVisualDataInspection,{ if(isTruthy(input$data_preDone)){ - output$DataMatrix_VI_Info=renderText({ + output$DataMatrix_VI_Info <- renderText({ "Visual Inspection only for primary data, not for precompiled set possible!" - }) + }) req(F) } if(!(isTruthy(input$data_matrix1) & (isTruthy(input$data_sample_anno1)|isTruthy(input$metadataInput)) & isTruthy(input$data_row_anno1))){ - output$DataMatrix_VI_Info=renderText( + output$DataMatrix_VI_Info <- renderText( "The Upload has failed completely, or you haven't uploaded anything yet. Need to uploade all three matrices!" ) - }else{ + } else { 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!") - } + 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(){ + print("Not a real csv file!") + Matrix <- read.table(input$data_matrix1$datapath,check.names = T) + Matrix2 <- read.table(input$data_matrix1$datapath, check.names = F) + } ) - 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:"}) + 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$DataMatrix_VI <- DT::renderDataTable({ - DT::datatable(data = Matrix) - }) - output$DataMatrix_VI_INFO <- renderText({"Matrix:"}) - 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) - }) - output$SampleMatrix_VI_INFO <- renderText({"Sample table:"}) - - annotation_rows <- read_file(input$data_row_anno1$datapath, check.names=T) - output$EntitieMatrix_VI <- DT::renderDataTable({ - DT::datatable(data = annotation_rows) - }) - output$EntitieMatrix_VI_INFO <- renderText({"Entitie table:"}) - - ## Do some checking - snippetYes <- "Yes" - snippetNo <- "No" - output$OverallChecks <- renderText({ - "Some overall Checks are running run...\n - Rownames of Matrix are the same as rownames of entitie table ...\n - Colnames of Matrix are same as rownames of sample table ... \n - Matrix has no na ...\n - Sample table no na ...\n - Entitie table no na ...\n - " - }) + output$SampleMatrix_VI <- DT::renderDataTable({DT::datatable(data = sample_table)}) + output$SampleMatrix_VI_INFO <- renderText({"Sample table:"}) + + annotation_rows <- read_file(input$data_row_anno1$datapath, check.names=T) + output$EntitieMatrix_VI <- DT::renderDataTable({ + DT::datatable(data = annotation_rows) + }) + output$EntitieMatrix_VI_INFO <- renderText({"Entitie table:"}) - 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) - check4 <- ifelse(any(is.na(sample_table) == T),snippetNo,snippetYes) - check5 <- ifelse(any(is.na(annotation_rows) == T),snippetNo,snippetYes) - check6 <- ifelse(all(colnames(Matrix2) == colnames(Matrix)),snippetYes,snippetNo) - - if(check5 == snippetNo){ - # Indicate columns with NA - colsWithNa <- numeric() - for(i in 1:ncol(annotation_rows)){ - if(any(is.na(annotation_rows[,i]) == T)){ - colsWithNa <- c(colsWithNa,i) - } - } - check5 <- paste0(snippetNo," Following columns are potentially problematic: ",paste0(colsWithNa, collapse = ", ")) - } - - if(check6 == snippetNo){ - # add help text - check6 <- paste0( - snippetNo, - "\n\t A syntactically valid name consists of letters, numbers and the dot or underline characters \n - and starts with a letter or the dot not followed by a number.\n - Therefore '12345' is invalid, 'ID_12345' is valid \n - Remember to change the Sample ID everywhere (Matrix & Sample Table") - } - 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 - Sample table no na ",check4,"\n - Entitie table no na ",check5,"\n - Sample IDs have valid names ", check6, "\n - ") - }) + ## Do some checking + snippetYes <- "Yes" + snippetNo <- "No" + + 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) + check4 <- ifelse(any(is.na(sample_table) == T),snippetNo,snippetYes) + check5 <- ifelse(any(is.na(annotation_rows) == T),snippetNo,snippetYes) + check6 <- ifelse(all(colnames(Matrix2) == colnames(Matrix)),snippetYes,snippetNo) + + if(check0 == snippetNo){ + # add help text + check0 <- paste0( + snippetNo, + "\n\tMost likely: You had a xlsx and exported to csv but your excel is in ", + "german\n\tand/or you use ',' as separators for decimal positions.\n\t", + "Fix: change your decimal separator in Excel and re-export!" + ) + } + if(check5 == snippetNo){ + # Indicate columns with NA + colsWithNa <- numeric() + for(i in 1:ncol(annotation_rows)){ + if(any(is.na(annotation_rows[,i]) == T)){ + colsWithNa <- c(colsWithNa,i) + } + } + check5 <- paste0(snippetNo,"\n\tFollowing columns are potentially problematic: ",paste0(colsWithNa, collapse = ", ")) + } + if(check6 == snippetNo){ + # add help text + check6 <- paste0( + snippetNo, + "\n\tA syntactically valid name consists of letters, numbers,\n\t", + "the dot or underline characters and starts with a letter.\n\t", + "Therefore '12345' is invalid, 'ID_12345' is valid.\n\t", + "Remember to change the Sample ID everywhere (Matrix & Sample Table" + ) + } + output$OverallChecks <- renderText({ + paste0( + "Some overall Checks have been run:\n", + "Data Matrix is a real csv (has ',' as separators:): ",check0,"\n", + "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", + "Sample table no na ",check4,"\n", + "Entitie table no na ",check5,"\n", + "Sample IDs have valid names ", check6, "\n" + ) + }) } }) diff --git a/program/shinyApp/ui.R b/program/shinyApp/ui.R index 40dc68d6..617937d2 100644 --- a/program/shinyApp/ui.R +++ b/program/shinyApp/ui.R @@ -43,9 +43,7 @@ library(gridExtra) # library(svglite) source("R/C.R") - source("R/module_DownloadReport.R",local=T) - # source the uis for each panel here source("R/data_selection/ui.R",local=T) source("R/pre_processing/ui.R",local=T) @@ -56,22 +54,8 @@ source("R/enrichment_analysis/ui.R",local=T) source("R/sample_correlation/ui.R",local = T) source("R/significance_analysis/ui.R",local=T) - options(repos = BiocManager::repositories()) options(spinner.color = "#1c8a3b", spinner.color.background = "#ffffff", spinner.size = 2) -######## -# Set Up security -######## -credentials <- data.frame( - user = c("Clivia", "Lea"), # mandatory - password = c("Cii@31", "Lea"), # mandatory - # start = c("2019-04-15"), # optinal (all others) - # expire = c(NA, "2019-12-31"), - admin = c(FALSE, TRUE), - comment = "Log In to Run secret Shiny", - stringsAsFactors = FALSE -) - ui <- shiny::fluidPage( # JS to reset input values @@ -84,7 +68,6 @@ ui <- shiny::fluidPage( ########## # Styling Setting ########## - # Note the wrapping of the string in HTML() tags$style(HTML(" body { background-color: #f8f7fa; @@ -193,24 +176,25 @@ ui <- shiny::fluidPage( ################################################################################ data_selection_panel, pre_processing_panel, - sample_correlation_panel <- sampleCorrelation_UI("sample_correlation"), - significance_analysis_panel <- significance_analysis_UI("SignificanceAnalysis"), - pca_panel <- pca_UI("PCA"), - heatmap_panel <- heatmap_UI("Heatmap"), - single_gene_visualisation_panel <- single_gene_visualisation_UI("single_gene_visualisation"), - enrichment_analysis_tab_panel <- enrichment_analysis_UI("EnrichmentAnalysis") + sampleCorrelation_UI("sample_correlation"), + significance_analysis_UI("SignificanceAnalysis"), + pca_UI("PCA"), + heatmap_UI("Heatmap"), + single_gene_visualisation_UI("single_gene_visualisation"), + enrichment_analysis_UI("EnrichmentAnalysis") ), hidden(selectInput( "element_02", - label = "LeasBirthday", - choices = c(0, 1,2), + label = "AuthorBirthdays", + choices = c(0, 1, 2), selected = if(format(as.POSIXct(Sys.time()), "%d-%m") == "22-11"){ - 1 - }else if(format(as.POSIXct(Sys.time()), "%d-%m") == "19-12"){ - 2 - }else{ - 0 - })), + 1 # Lea's Birthday + } else if (format(as.POSIXct(Sys.time()), "%d-%m") == "19-12"){ + 2 # Paul's Birthday + } else { + 0 # No Birthday + } + )), conditionalPanel( condition = "input.element_02 == 0", absolutePanel("Brought to you by Lea Seep & Paul Jonas Jost", @@ -242,8 +226,4 @@ ui <- shiny::fluidPage( textOutput("session_id"), bottom = 0, right = 10, fixed = TRUE ) - ) - -# Wrap your UI with secure_app -# ui <- secure_app(ui)