diff --git a/app/server.r b/app/server.r index 302f202..c311000 100644 --- a/app/server.r +++ b/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) ) diff --git a/app/ui.r b/app/ui.r index 65adad8..d0b24be 100644 --- a/app/ui.r +++ b/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") diff --git a/functions/check_project.r b/functions/check_project.r index d581362..f535bb8 100644 --- a/functions/check_project.r +++ b/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)){ diff --git a/functions/dnase1_score_matrix.r b/functions/dnase1_score_matrix.r new file mode 100644 index 0000000..2c58cbc --- /dev/null +++ b/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) +} \ No newline at end of file diff --git a/functions/inserted_ui.r b/functions/inserted_ui.r index 99c5103..ba15a5c 100644 --- a/functions/inserted_ui.r +++ b/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) ) ) ) diff --git a/functions/list_experiments.r b/functions/list_experiments.r index 07a2bc9..8b0e1c8 100644 --- a/functions/list_experiments.r +++ b/functions/list_experiments.r @@ -1,19 +1,12 @@ # 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 @@ -21,12 +14,24 @@ list_experiments <- function(genome, epigenetic_mark, project, user_key){ 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 diff --git a/functions/plotly_pca.r b/functions/plotly_pca.r index 65d2d21..bb6ccaa 100644 --- a/functions/plotly_pca.r +++ b/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]) %>% diff --git a/functions/score_matrix_annotations.r b/functions/score_matrix_annotations.r index 94faeba..e80a20e 100644 --- a/functions/score_matrix_annotations.r +++ b/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, diff --git a/functions/score_matrix_tiling_regions.r b/functions/score_matrix_tiling_regions.r index 9d4458d..785e2e2 100644 --- a/functions/score_matrix_tiling_regions.r +++ b/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)) { diff --git a/server/calculate_score_matrix.r b/server/calculate_score_matrix.r index bf83b87..c1466ae 100644 --- a/server/calculate_score_matrix.r +++ b/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, diff --git a/server/listing_experiments.r b/server/listing_experiments.r index 18ec7cb..ed26b3c 100644 --- a/server/listing_experiments.r +++ b/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) })