updates

app/server.r

@@ -20,20 +20,20 @@
 #17 Need to have the back button only in the calculate matrix page and the next is added once the calculation is done (Done!!)
 #18 Fix the corrplot download
 #19 Score matrices and tables other than the first, lines don't need to be selected (Done!)
+#20 Filter coverage files from the beginning with a check box (Done!)
 
 
 # TODOs -------------------------------------------------------------------
 #9 Change all the plots to be in Plotly instead of ggplot
-
 #7 Check for shiny as a R package 
 #12 RUV for batch effect (from Markus' scripts to understand how it works)
 #13 select expression, for gene expression data
 #15 genomic ranges R package
-
 #18 Fix the corrplot download
     #It's working, but for some reason the PDFs are taking long time to show
     #The plot maybe a bit too big, even thought the pdf file has a small size
-
+#21 Make batch effect analysis matrices as a list
+#22 Notification to choose a chromosome
 
 #New UI with shiny dashboard
 library(foreach)
@@ -100,7 +100,7 @@ function(input, output, session) {
 
   output$summary <- DT::renderDataTable({
     DT::datatable(summary_df(), filter = list(position = 'top', clear = FALSE),
-                  selection = 'none',selection = 'none', options = list(
+                  selection = 'none', options = list(
                     search = list(regex = TRUE, caseInsensitive = TRUE),
                     pageLength = 10)
                   )

app/ui.r

@@ -25,6 +25,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
     sidebarMenu(id = "tabs",
       menuItem("List Experiments", tabName = "list_experiments_tab"),
       menuItem("Score Matrix", tabName = "score_matrix_tab"),
+      menuItem("Score Matrix DNase1", tabName = "score_matrix_dnase1_tab"),
       menuItem("Plot Matrix", tabName = "plot_matrix_tab"),
       menuItem("Correlation Plot", tabName = "corr_plot_tab"),
       menuItem("Batch Effect", tabName = "batch_effect_tab"),
@@ -42,7 +43,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
         })
         ')),
     tags$head(
-      # Include our custom CSS
+      # Include custom CSS
       includeCSS("../www/styles.css")
     ),
 
@@ -119,7 +120,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
                                                  selected = "5000")),
                                   selectInput('chr', 'Select a Chromosome, or leave empty for the whole genome', c("")),
                                   # tags$div(id = 'addChromosomes'),
-                                  actionButton("calculate_matrix", "Calculate Score matrix")
+                                  actionButton("show_input_check", "Calculate Score matrix")
 
                                   ),
 
@@ -133,6 +134,10 @@ dashboardPage(title = "Batch Effect Analysis and Visualization",
                                   downloadButton("downloadMatrix", "Download Data")
 
                                   ),
+              bsModal(id ="input_check", title = "Input Check", trigger = "show_input_check",
+                      textOutput(outputId = "warning_message"),
+                      actionButton("calculate_matrix", "Continue!")
+                      ),
 
               br(),
               DT::dataTableOutput("matrix_summary")

functions/check_project.r

@@ -8,7 +8,7 @@ check_project <- function(genome, user_key){
              "hg19:ChIP-Atlas","hg19:DEEP (IHEC)","hg19:ENCODE",
              "hg19:Roadmap Epigenomics","hs37d5:DEEP","GRCh38:BLUEPRINT Epigenome",
              "GRCh38:BLUEPRINT HSC differentiation","GRCh38:CREST","GRCh38:DEEP",
-             "GRCh38:ENCODE","GRCm38:DEEP")
+             "GRCh38:ENCODE","GRCm38:DEEP","GRCh38:TEPIC reprocessed IHEC data")
 
   projects <- c()
   for(i in grep(genome, rules)){

functions/dnase1_score_matrix.r

@@ -0,0 +1,55 @@
+dnase1_score_matrix <- function(dnase1_experiments,
+                                experiments_info_meta,
+                                chr,
+                                user_key){
+
+  if(chr == ""){chr <- NULL}
+
+  # # get experiments for DNAse data ----
+  # DNAse_exps <- deepblue_list_experiments(project = "TEPIC reprocessed IHEC data", user_key = user_key)
+  # DNAse_exps <- DNAse_exps[grep(pattern = "*.reg.rpm.bed", deepblue_extract_names(DNAse_exps)),]
+  # 
+  # # prepare fetching data ----
+  # 
+  # # values are stored as RPM
+  score_matrix_cols <- deepblue_select_column(dnase1_experiments, column = "RPM")
+
+  # we already have regions of the regulatory build, so instead of using an
+  # annotation we use the regions as they are as boundaries
+  DNase_reg_regions <- deepblue_select_regions(deepblue_extract_names(dnase1_experiments)[1],
+                                               genome = "GRCh38",
+                                               epigenetic_mark = "DNA Accessibility",
+                                               chromosomes = chr,
+                                               project = "TEPIC reprocessed IHEC data")
+
+  # request data ----
+
+  # we use the above regions to download the results as a score matrix
+  # an aggregation function is absolutely needed but we use max since there will
+  # be only one value listed for each region
+  score_matrix_query <- deepblue_score_matrix(experiments_columns = score_matrix_cols,
+                                              aggregation_function = "max",
+                                              aggregation_regions_id = DNase_reg_regions)
+
+  #Checking for the job to finish
+  while (deepblue_info(id = score_matrix_query, user_key = user_key)$state == "running"){
+    showNotification("Calculating score matrix, still running",type = "message", duration = 9)
+    Sys.sleep("10")
+  }
+
+  # we check if this worked
+  # deepblue_info(score_matrix_query)$state
+
+  # fetch results ----
+  # we download the results as a matrix
+  score_matrix <- deepblue_get_request_data(score_matrix_query)
+
+  #For now I'm converting the character I'm getting into a table
+  #Need to be fixed from the DeepBlue server
+  score_matrix <- data.table::fread(score_matrix)
+  score_matrix <- (score_matrix[,-c(1:3)])
+  score_matrix <- as.matrix(score_matrix)
+
+  attr(score_matrix, "meta") <- experiments_info_meta
+  return(score_matrix)
+}

functions/inserted_ui.r

@@ -32,12 +32,13 @@ inserted_ui <- function(user_key,user_name,echo, id, genomes) {
                                           c(genomes$name)),
 
                               selectInput('project', 'Select Project',choices = ""),
-                              selectInput('epigenetic_mark', 'Select an Epigenetic Mark',
-                                          c("",deepblue_list_epigenetic_marks(user_key = user_key)$name),
+                              selectInput('epigenetic_mark', 'Select a Data Type',
+                                          c("Gene Expression",deepblue_list_epigenetic_marks(user_key = user_key)$name),
                                           multiple = TRUE),
 
-                              actionButton('list_exper_btn', "List Experiments")
+                              actionButton('list_exper_btn', "List Experiments"),
 
+                              checkboxInput("filter_coverage", "Filter coverage files", TRUE)
                             )
                           )
                  )

functions/list_experiments.r

@@ -1,32 +1,37 @@
 # This function calls for experiments chosen by the user and filter only the files with the "VALUE"
 # Column after getting all the info.
 
-list_experiments <- function(genome, epigenetic_mark, project, user_key){
+list_experiments <- function(genome,
+                             epigenetic_mark,
+                             project,
+                             user_key,
+                             filter_coverage = TRUE){
 
-  #The DeepBlue accepts a NULL epigenetics mark, but shiny app returns NULL as a string so I added
-  #this small rule
-  # if(epigenetic_mark == "NULL"){epigenetic_mark = NULL}
-  # 
-  # #Same for Genome
-  # if(genome == "NULL"){genome = NULL}
-  # 
-  # #Same for Project
-  # if(project == "NULL"){project = NULL}
-  # 
-
   incProgress(amount = 1, message = "Listing all experiments")
 
   #Getting experiments
   experiments <- deepblue_list_experiments(genome = genome,
                                            epigenetic_mark = epigenetic_mark,
                                            project = project,
                                            user_key = user_key)
-  #In case no experiments returned, the function will just return an empty line and will be reported
-  #to the user
+  #In case no experiments returned, the function will just return an empty line
   if (experiments[1] == "\n"){
     return("\n")
   }
 
+  #filter tepic experiments
+  if(project == "TEPIC reprocessed IHEC data"){
+    experiments <- experiments[grep(pattern = "*.reg.rpm.bed", deepblue_extract_names(experiments)),]
+  }
+
+  #filtering the coverage out
+  if(filter_coverage == TRUE){
+    coverage_files <- grep("coverage", experiments$name, ignore.case = TRUE)
+    if(length(coverage_files) != 0){
+      experiments <- experiments[-coverage_files]
+    }
+    }
+
   #Getting experiments info
   incProgress(amount = 1, message = "Getting information for listed experiments")
   experiments_info <- deepblue_info(id = experiments$id, user_key = user_key)
@@ -36,15 +41,19 @@ list_experiments <- function(genome, epigenetic_mark, project, user_key){
   experiments_to_keep <- list()
 
   incProgress(amount = 1, message = "Filtering experiments")
+
   for (i in 1:length(experiments_info)){
     if (experiments_info[[i]]$format == format){
       experiments_to_keep[i] <- i
     }
   }
-  experiments_info <- experiments_info[which(!unlist(lapply(experiments_to_keep, is.null)))]
-  experiments <- experiments[which(!unlist(lapply(experiments_to_keep, is.null)))]
 
-  #Filterout experiments with missing metadata
+  if(length(experiments_to_keep) != 0){
+    experiments_info <- experiments_info[unlist(experiments_to_keep)]
+    experiments <- experiments[unlist(experiments_to_keep)]
+  }
+
+  #Filter experiments with missing metadata
   if (length(grep("Warning",
                   experiments_info, ignore.case = TRUE)) == 0){
     experiments <- experiments

functions/plotly_pca.r

@@ -33,7 +33,6 @@ plotly_pca <- function(experiments_info_meta,filtered_score_matrix, project,type
   y_lab <- paste0(paste0("PC", second_pc," ", "("),
                   round(pca$sdev[as.integer(second_pc)]^2/sum(pca$sdev^2), 2) * 100, "%)")
 
-  browser()
   p <-
     plot.data %>%
     arrange(plot.data[,color_by]) %>%

functions/score_matrix_annotations.r

@@ -1,7 +1,8 @@
-score_matrix_annotations <- function(experiments, experiments_info_meta, genome, chr = NULL,
+score_matrix_annotations <- function(experiments, experiments_info_meta, genome, chr,
                                      annotation, aggregation_function = "mean",
                                      variation = "0.05", user_key ){
 
+  if(chr == ""){chr <- NULL}
   #selecting annotations
   annotation_req <- deepblue_select_annotations(annotation = annotation,
                                                 chromosome = chr,

functions/score_matrix_tiling_regions.r

@@ -1,12 +1,14 @@
 #Function to get the scoring matrix with tiling regions of the genome
 
 score_matrix_tiling_regions <- function(experiments, experiments_info_meta,
-                                        genome, chr = NULL,
+                                        genome, chr,
                                         tiling_size = "5000",
                                         aggregation_function = "mean",
                                         variation = "0.05",
                                         user_key){
 
+  if(chr == ""){chr <- NULL}
+
   #Making a list with to call the VALUE column for each of our experiments
   experiments_columns <- list()
   for(experiment in deepblue_extract_names(experiments)) {

server/calculate_score_matrix.r

@@ -1,13 +1,32 @@
+observeEvent(input$show_input_check,{
+  if(input$chr == ""){
+    output$warning_message <- renderText("Just drawing your attention, that you did not choose chromosome(s),
+                                          which means the whole genome is selected and the calculation might
+                                          take sometime.
+                                          Are you sure?")
+  }else{
+    output$warning_message <- renderText("Just making sure you have the right input!")
+  }
+})
+
 # #Get the score matrix
 filtered_score_matrix <- eventReactive(input$calculate_matrix, {
-  #get scoring matrix
+  #closing the Input check modal
+  toggleModal(session = session, modalId = "input_check", toggle = "close")
 
+  #get scoring matrix
   validate(
     need(all_experiments() != "\n",
-         "There were no experiments found to plot. Please, try again")
+         "There were no experiments found. Please, try again")
   )
-
-  if(input$type_of_score == 'tiling'){
+  if(input$project == "TEPIC reprocessed IHEC data"){
+    print("we are here")
+    filtered_score_matrix <- dnase1_score_matrix(dnase1_experiments = all_experiments()[[1]][input$table_rows_all],
+                                                 experiments_info_meta = experiments_info_meta(),
+                                                 chr = input$chr,
+                                                 user_key = user_key)
+  }
+  else if(input$type_of_score == 'tiling'){
     filtered_score_matrix<- score_matrix_tiling_regions(experiments = all_experiments()[[1]][input$table_rows_all],
                                                         experiments_info_meta =  experiments_info_meta(),
                                                         variation = input$variance,

server/listing_experiments.r

@@ -8,7 +8,8 @@ all_experiments <- eventReactive(input$list_exper_btn, {
                  all_experiments <- list_experiments(genome = input$genome,
                                                      epigenetic_mark = input$epigenetic_mark,
                                                      project = input$project,
-                                                     user_key = user_key)
+                                                     user_key = user_key,
+                                                     filter_coverage = input$filter_coverage)
                })