diff --git a/app/server.r b/app/server.r index 1de3759..e867b71 100644 --- a/app/server.r +++ b/app/server.r @@ -27,13 +27,13 @@ # TODOs ------------------------------------------------------------------- #7 Check for shiny as a R package -#12 RUV for batch effect (from Markus' scripts to understand how it works) +#12 RUV for batch effect (from Markus' scripts to understand how it works) (Done I think) #13 select expression, for gene expression data (almost done!) -#24 Gene expression function (Same function for one gene then all genes) +#24 Gene expression function (Same function for one gene then all genes) (Didn't work) #25 Gene expression ihec, map sample IDs and experiments name to get the final matrix -#27 Supervised SVA (use the method with the std of ranks) -#28 Add a place to choose outliers that can be used then in the RUV test and other tests - +#27 Supervised SVA (use the method with the std of ranks) (Done I think) +#28 Add a place to choose outliers that can be used then in the RUV test and other tests (Done I think) +#29 Hide next buttong for Batch Effect tab until there's a batch effect matrix #Problems @@ -43,7 +43,9 @@ library(foreach) library(matrixStats) library(DeepBlueR) +library(RUVnormalize) library(stringr) +library(tidyr) library(corrplot) library(impute) library(dplyr) @@ -61,8 +63,8 @@ library(sva) library(shinydashboard) #importing functions -for(f in list.files("../functions/")){ - source(file.path('../functions/',f), local = TRUE) +for(f in list.files(file.path("..","functions"))){ + source(file.path("..","functions",f), local = TRUE) } # Server function --------------------------------------------------------- @@ -85,22 +87,38 @@ function(input, output, session) { observe(hideTab(inputId = "corr_plot_box", target = "Downlad Plot")) observe(hideTab(inputId = "batch_plot_box", target = "Download Plot")) + observeEvent(input$info,{ + #Depends which current input$tabs the user at, I'll render that help page for that tab when the help! is pressed :) + markdown_pages <- list.files(file.path("..","help")) + help_md <- markdown_pages[grep(input$tabs, markdown_pages)] + + output$help_output <- renderUI({ + includeMarkdown(file.path("..","help",help_md)) + }) + }) # logging in -------------------------------------------------------------- - source("../server/logging_in.r", local = TRUE) + source(file.path("..","server","logging_in.r"), local = TRUE) # # listing genomes --------------------------------------------------------- - source("../server/listing_genomes.r", local = TRUE) + source(file.path("..","server","listing_genomes.r"), local = TRUE) # Listing Experiments ----------------------------------------------------- - source("../server/listing_experiments.r", local = TRUE) + source(file.path("..","server","listing_experiments.r"), local = TRUE) # Experiments metadat (summary) ------------------------------------------- #This is to print a summary of the metadata of a sample summary_df <- eventReactive(input$exp_id,{ - sample_summary(sample_id = input$exp_id, user_key = user_key) + if(input$epigenetic_mark == "Gene Expression"){ + summary_df <- t(as.data.frame(deepblue_info(id = input$exp_id, + user_key = user_key))) + return(summary_df) + }else{ + summary_df <- sample_summary(sample_id = input$exp_id, user_key = user_key) + return(summary_df) + } }) output$summary <- DT::renderDataTable({ @@ -111,38 +129,6 @@ function(input, output, session) { ) }) -# Test data --------------------------------------------------------------- - - #This part is added so I don't need to log-in, choose genome and sait for the data to be listed - #and calculate the mtrix if i need to test something, I'm just using this part to test functions - #after the matrix has been calculated - #in case anyone wants to use thi part, you have to comment the parts that output - #filtered_score_matrix and experiments_info_meta so nothing crazy would happen - - - # filtered_score_matrix <- eventReactive(input$load_test,{ - # metadata <- read.table("/home/fawaz/Desktop/Max_Planck_Job/shiny_app/matrix/matrix_metadata.tsv", - # sep = "\t") - # - # matrix <- as.matrix(read.table("/home/fawaz/Desktop/Max_Planck_Job/shiny_app/matrix/data_matrix.tsv", - # sep = "\t", skip = 1)) - # - # colnames(matrix) <- levels(unlist( - # read.table("/home/fawaz/Desktop/Max_Planck_Job/shiny_app/matrix/data_matrix.tsv", - # sep = "\t", nrows = 1) - # )) - # attr(matrix, "meta") <- metadata - # filtered_score_matrix <- matrix - # }) - # - # experiments_info_meta <- eventReactive(input$load_test,{ - # experiments_info_meta <- attr(filtered_score_matrix(), "meta") - # }) - # - # output$testing_output <- renderText({ - # summary(filtered_score_matrix()) - # }) - # Metadata and Matrix ----------------------------------------------------- ##Original Matrix Calculation Method #### @@ -150,15 +136,21 @@ function(input, output, session) { # #make a table of metadata experiments_info_meta <- eventReactive(input$calculate_matrix, { #extract metadata - experiments_info_meta <- suppressWarnings(extract_metadata(all_experiments()[[2]][input$table_rows_all])) + if((input$project == "TEPIC reprocessed IHEC data") & + (input$epigenetic_mark == "Gene Expression")){ + experiments_info_meta <- attr(all_experiments()[[2]], "meta") + }else{ + experiments_info_meta <- suppressWarnings(extract_metadata(all_experiments()[[2]][input$table_rows_all])) + + } }) - source("../server/calculate_score_matrix.r", local = TRUE) + source(file.path("..", "server", "calculate_score_matrix.r"), local = TRUE) # Correlation plot -------------------------------------------------------- - source("../server/correlation_plot.r", local = TRUE) + source(file.path("..","server","correlation_plot.r"), local = TRUE) # Update batch effects selection ------------------------------------------ @@ -179,9 +171,6 @@ function(input, output, session) { updateSelectInput(session, inputId = "interest_var_sva", choices = c("",colnames(attr(filtered_score_matrix(), "meta")))) - # updateSelectInput(session, inputId = "batch_supervised_sva", - # choices = colnames(attr(filtered_score_matrix(), "meta"))) - updateSelectInput(session, inputId = "adj_var_supervised_sva", choices = c("",colnames(attr(filtered_score_matrix(), "meta")))) @@ -235,19 +224,23 @@ function(input, output, session) { temp_matrices <- batch_adjusted_matrices() temp_matrices[[paste(input$batch_effect_choice, input$batch_sva, - input$adj_var_supervised_sva, input$interest_var_supervised_sva, sep = "-")]]<- + input$adj_var_supervised_sva, + input$interest_var_supervised_sva, sep = "-")]]<- supervised_sva_batch_effect(filtered_score_matrix = filtered_score_matrix(), adjustment_var = input$adj_var_supervised_sva, interest_var = input$interest_var_supervised_sva, project = input$project, - outliers = input$outliers, - project = input$project) + outliers = input$outliers) + batch_adjusted_matrices(temp_matrices) + }else{ temp_matrices <- batch_adjusted_matrices() - temp_matrices[["some_name_here"]] <- + temp_matrices[[paste(input$batch_effect_choice, + input$quantile_prob, + input$k_rank, sep = "-")]] <- ruv_batch_effect(filtered_score_matrix = filtered_score_matrix(), outliers = input$outliers, @@ -256,6 +249,9 @@ function(input, output, session) { quantile_prob = input$quantile_prob, k_rank = input$k_rank, estimate_hkg = input$house_keeping_genes) + + batch_adjusted_matrices(temp_matrices) + } updateSelectInput(session, "corrected_matrices", choices = names(temp_matrices)) return(batch_adjusted_matrices()) @@ -353,10 +349,20 @@ function(input, output, session) { output$plot <- renderPlotly(first_pca_plot()) observeEvent(input$plot_matrix_previous_tab,{ - updateTabItems(session, "tabs", "score_matrix_tab") - header <- paste("Calculate Score Matrix") - shinyjs::html("pageHeader", header) + # if((input$project == "TEPIC reprocessed IHEC data") & + # (input$genome == "GRCh38") & + # (input$epigenetic_mark == "Gene Expression")){ + # updateTabItems(session, "tabs", "list_experiments_tab") + # + # header <- paste("List Experiments") + # shinyjs::html("pageHeader", header) + # }else{ + updateTabItems(session, "tabs", "score_matrix_tab") + + header <- paste("Calculate Score Matrix") + shinyjs::html("pageHeader", header) + # } }) observeEvent(input$plot_matrix_next_tab,{ diff --git a/app/ui.r b/app/ui.r index 8eadc2d..b21b4a0 100644 --- a/app/ui.r +++ b/app/ui.r @@ -12,6 +12,9 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", dashboardHeader( title = "Batch Effect Analysis", titleWidth = 300, + tags$li(class = "dropdown", + tags$li(class = "dropdown", actionLink("info", "Help!")) + ), tags$li(class = "dropdown", # tags$li(class = "dropdown", textOutput("logged_user"), style = "padding-top: 15px; padding-bottom: 15px; color: #fff;"), tags$li(class = "dropdown", actionLink("login", textOutput("logintext"))) @@ -25,6 +28,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("RNA seq matrix", tabName = "rna_seq_matrix"), menuItem("Score Matrix DNase1", tabName = "score_matrix_dnase1_tab"), menuItem("Plot Matrix", tabName = "plot_matrix_tab"), menuItem("Correlation Plot", tabName = "corr_plot_tab"), @@ -44,7 +48,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", ')), tags$head( # Include custom CSS - includeCSS("../www/styles.css") + includeCSS(file.path("..","www","styles.css")) ), bsModal(id ="login_popup", title = "Log-in", trigger = "login", @@ -60,12 +64,20 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", bsButton("user_key_info",label = "", icon = icon("question"), style = "default", size = "extra-small"), bsPopover("user_key_info", title = "info", content = "You can login with your user key, or stay anonymous", placement = "right", trigger = "focus") + ) ), - size = "large"), - - #Start and restart buttons + size = "large", + #Log in Button actionButton('log_in_btn', "Log-in") ), + + bsModal(id="help_page", title = "Help!", trigger = "info", + #In Server I will check which tab is it and output the html + #of the help part of that tab + uiOutput("help_output"), + size = "large" + + ), # list experiments tab ---------------------------------------------------- tabItems( @@ -150,6 +162,18 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", DT::dataTableOutput("matrix_summary") ), +# rna seq matrix --------------------------------------------------------- + + # tabItem(tabName = "rna_seq_matrix", + # + # fluidRow(column(width = 12, offset = 10, + # bsButton("rna_seq_matrix_previous_tab",label = "Previous", icon = icon("arrow-left"), + # style = "default"), + # bsButton("rna_seq_matrix_next_tab",label = "Next", icon = icon("arrow-right"), + # style = "default") + # )), + # br() + # ), # Plot matrix tab --------------------------------------------------------- tabItem(tabName = "plot_matrix_tab", @@ -239,7 +263,7 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", plotlyOutput("batch_pie_plot", width = "auto", height = "auto"))), br(),br(), selectInput("corrected_matrices", "Batch Corrected Matrices", choices = NULL), - actionButton("calculate_batch_matrix", "Adjust matrix using ComBat") + actionButton("calculate_batch_matrix", "Adjust matrix") ), shinydashboard::box(width = 6, conditionalPanel( @@ -275,9 +299,9 @@ dashboardPage(title = "Batch Effect Analysis and Visualization", conditionalPanel( condition = "input.house_keeping_genes == 'estimate_hkg'", - numericInput("regularization_par", - "Regularization parameter for the unwanted variation", - value = 0.00001), + # numericInput("regularization_par", + # "Regularization parameter for the unwanted variation", + # value = 0.00001), numericInput("quantile_prob", "Quantile probability used in the rank analysis estimation [0,1]", diff --git a/functions/combat_batch_effect.r b/functions/combat_batch_effect.r index 56d37b6..9413a93 100644 --- a/functions/combat_batch_effect.r +++ b/functions/combat_batch_effect.r @@ -82,10 +82,18 @@ combat_batch_effect <- function(filtered_score_matrix, } } - - batch_adjusted_matrix <- ComBat(dat=filtered_score_matrix, - batch=as.double(as.factor(metadata[,batch])), - mod=modcombat, par.prior=TRUE, prior.plots=FALSE) + tryCatch({ + batch_adjusted_matrix <- ComBat(dat=filtered_score_matrix, + batch=as.double(as.factor(metadata[,batch])), + mod=modcombat, par.prior=TRUE, prior.plots=FALSE) + },error = function(e){ + error_message <- paste("Sorry! Something went wrong!", + "Original error message:",e) + validate( + need(FALSE, message = error_message) + ) + }) + attr(batch_adjusted_matrix, "meta") <- metadata diff --git a/functions/convert_to_link.r b/functions/convert_to_link.r index e4bff5a..78947f5 100644 --- a/functions/convert_to_link.r +++ b/functions/convert_to_link.r @@ -1,4 +1,5 @@ #function to hperlink the experiments ID in table +#And show the modal with metadata on_click_js <- "Shiny.onInputChange('exp_id', '%s'); $('#mtExperID').modal('show')" diff --git a/functions/inserted_ui.r b/functions/inserted_ui.r index 1caf0c1..f71b860 100644 --- a/functions/inserted_ui.r +++ b/functions/inserted_ui.r @@ -33,7 +33,7 @@ inserted_ui <- function(user_key,user_name,echo, id, genomes) { selectInput('project', 'Select Project',choices = ""), selectInput('epigenetic_mark', 'Select a Data Type', - c("Gene Expression",deepblue_list_epigenetic_marks(user_key = user_key)$name), + c("","Gene Expression",deepblue_list_epigenetic_marks(user_key = user_key)$name), multiple = F), actionButton('list_exper_btn', "List Experiments"), diff --git a/functions/list_experiments.r b/functions/list_experiments.r index 8b0e1c8..9f8f239 100644 --- a/functions/list_experiments.r +++ b/functions/list_experiments.r @@ -16,7 +16,7 @@ list_experiments <- function(genome, user_key = user_key) #In case no experiments returned, the function will just return an empty line if (experiments[1] == "\n"){ - return("\n") + return(NULL) } #filter tepic experiments @@ -67,6 +67,6 @@ list_experiments <- function(genome, #the second is all the information in a list all_experiments <- list(experiments, experiments_info) incProgress(amount = 0, message = "Done!!") - + return(all_experiments) } diff --git a/functions/list_rna_seq_data.r b/functions/list_rna_seq_data.r new file mode 100644 index 0000000..6605f0b --- /dev/null +++ b/functions/list_rna_seq_data.r @@ -0,0 +1,57 @@ +list_rna_seq_data <- function(project, + user_key){ + + protein_coding_genes_id <- readLines(file.path("..","gene_ids","protein_coding_HAVANA_genes_ids.txt")) + + output_format <- "CHROMOSOME,START,END,@STRAND(gencode v23),@GENE_NAME(gencode v23),@SAMPLE_ID,TPM" + + gene_expr_query <- deepblue_select_expressions( + expression_type = "gene", + gene_model = "gencode v23", + identifiers = protein_coding_genes_id, + project = project, + user_key = user_key) + + gene_expr_request_id <- deepblue_get_regions( + query_id = gene_expr_query, + output_format ="CHROMOSOME,START,END,@STRAND(gencode v23),@GENE_NAME(gencode v23),@SAMPLE_ID,TPM,FPKM", + user_key = user_key) + + incProgress(amount = 1, message = "Listing all experiments") + + while(deepblue_info(gene_expr_request_id, user_key = user_key)$state == "running"){ + Sys.sleep(10) + } + + gene_expr_regions <- deepblue_download_request_data(gene_expr_request_id, + user_key = user_key) + + ##I need to check heree if FPKM or TPM that should be used then drop one + + incProgress(amount = 2, message = "Building Matrix") + + gene_expr_df <- as.data.frame(gene_expr_regions) %>% select(-FPKM) %>% + spread(key = `X.SAMPLE_ID`, value = "TPM") + + sample_cols <- grep(colnames(gene_expr_df), pattern = "s[0-9].", value = TRUE) + + #I'm getting each sample as one line and all joined alread, didn't need to process them + sample_info <- as.data.frame(deepblue_info(sample_cols, user_key = user_key)) + sample_info <- sample_info[,-grep("id",colnames(sample_info))] + sample_info[,"SAMPLE_ID"] <- sample_cols + + gene_expr_matrix <- data.matrix(gene_expr_df[,sample_cols]) + rownames(gene_expr_matrix) <- gene_expr_df$X.GENE_NAME.gencode.v23. + + if(project == "TEPIC reprocessed IHEC data"){ + experiments <- tepic_sample_id_mapping(sample_cols = sample_cols, + user_key = user_key) + } + + attr(gene_expr_matrix, "meta") <- deepblue_info(sample_cols, + user_key = user_key) + all_experiments <- list(experiments, gene_expr_matrix) + incProgress(amount = 0, message = "Done!!") + + return(all_experiments) +} \ No newline at end of file diff --git a/functions/matrix_summary_table.r b/functions/matrix_summary_table.r index 7327f52..633dd60 100644 --- a/functions/matrix_summary_table.r +++ b/functions/matrix_summary_table.r @@ -1,5 +1,4 @@ matrix_summary_table <- function(matrix_summary, col_names){ - for(i in 1:length(matrix_summary)){ matrix_summary[i] <- gsub(" ","",strsplit(matrix_summary[i], ":")[[1]][2]) } diff --git a/functions/plotly_pca.r b/functions/plotly_pca.r index 5df31a2..cceef89 100644 --- a/functions/plotly_pca.r +++ b/functions/plotly_pca.r @@ -1,6 +1,6 @@ plotly_pca <- function(experiments_info_meta, filtered_score_matrix, - name = NULL, + name, project, type_of_score, color_by = "biosource_name", @@ -9,6 +9,10 @@ plotly_pca <- function(experiments_info_meta, second_pc="2", show_legend = TRUE){ + if (epigenetic_mark == "Gene Expression"){ + experiments_info_meta$experiment <- colnames(filtered_score_matrix) + } + #calculating PCA pca <- prcomp(filtered_score_matrix, center = TRUE, scale. = TRUE) @@ -31,14 +35,18 @@ plotly_pca <- function(experiments_info_meta, # #Getting colour pallet # colourCount <- 9 # getPalette <- colorRampPalette(brewer.pal(colourCount, "Set1")) - + + # if((input$project == "TEPIC reprocessed IHEC data") & + # (input$epigenetic_mark == "Gene Expression")){ + # + # } if(project == "DEEP"){ label <- "DEEP_SAMPLE_ID" hover = ~paste("Sample ID: ", DEEP_SAMPLE_ID, '
Biosource Name: ', biosource_name) }else{ label <- "experiment" - hover = ~paste("Sample ID: ", experiment, + hover = ~paste("Experiment: ", experiment, '
Biosource Name: ', biosource_name) } @@ -62,6 +70,7 @@ plotly_pca <- function(experiments_info_meta, yaxis = list(title = y_lab, zeroline = FALSE), xaxis = list(title = x_lab, zeroline = FALSE)) + browser() return(p) } \ No newline at end of file diff --git a/functions/ruv_batch_effect.r b/functions/ruv_batch_effect.r index fd5a4d9..97aa5fa 100644 --- a/functions/ruv_batch_effect.r +++ b/functions/ruv_batch_effect.r @@ -29,9 +29,9 @@ ruv_batch_effect <- function(filtered_score_matrix, "ENSG00000181222","ENSG00000108298","ENSG00000089157", "ENSG00000073578", "ENSG00000112592","ENSG00000196230") - rowsum<-apply(filtered_score_data,1,sum) - if(!length(which(row_sum == 0)) == 0){ - filtered_score_matrix<-filtered_score_matrix[-which(row_sum==0),] + rowsum<-apply(filtered_score_matrix,1,sum) + if(!length(which(rowsum == 0)) == 0){ + filtered_score_matrix<-filtered_score_matrix[-which(rowsum==0),] } if(outliers != ""){ @@ -49,29 +49,39 @@ ruv_batch_effect <- function(filtered_score_matrix, } else if(estimate_hkg == "estimate_hkg"){ - rowsum<-apply(filtered_score_data,1,sum) - if(!length(which(row_sum == 0)) == 0){ - filtered_score_matrix<-filtered_score_matrix[-which(row_sum==0),] + rowsum<-apply(filtered_score_matrix,1,sum) + if(!length(which(rowsum == 0)) == 0){ + filtered_score_matrix<-filtered_score_matrix[-which(rowsum==0),] } if(outliers != ""){ filtered_score_matrix <- filtered_score_matrix[,-match(outliers,colnames(filtered_score_matrix))] metadata <- metadata[-match(outliers, metadata["experiment"]),] - } + } rankedData<-apply(filtered_score_matrix,2,rank) stdRanks<-apply(rankedData,1,sd) meanRanks<-apply(rankedData,1,mean) - housekeepingGenes <-names(meanRanks[which(stdRanks <= quantile(stdRanks,quantile_prob))]) + if(project != "TEPIC reprocessed IHEC data"){ + housekeepingGenes <- match(meanRanks[which(stdRanks <= quantile(stdRanks,quantile_prob))], + meanRanks) + inRUV<-t(as.matrix(log2(filtered_score_matrix+1))) + + }else{ + inRUV<-t(as.matrix(log2(filtered_score_matrix+1))) + + housekeepingGenes <-names(meanRanks[which(stdRanks <= quantile(stdRanks,quantile_prob))]) + housekeepingGenes <- match(housekeepingGenes, colnames(inRUV)) + } + + ruv_adjusted_matrix <-naiveRandRUV(inRUV,housekeepingGenes, + nu.coeff=regularization_par , k=k_rank) } - inRUV<-t(as.matrix(log2(filtered_score_matrix+1))) - ruv_adjusted_matrix <-naiveRandRUV(inRUV,match(housekeepingGenes,colnames(inRUV)), - nu.coeff=regularization_par , k=k_rank) - + ruv_adjusted_matrix <- t(ruv_adjusted_matrix) attr(ruv_adjusted_matrix, "meta") <- metadata return(ruv_adjusted_matrix) diff --git a/functions/sample_id_name_mapping.r b/functions/sample_id_name_mapping.r new file mode 100644 index 0000000..7ca25f2 --- /dev/null +++ b/functions/sample_id_name_mapping.r @@ -0,0 +1,33 @@ +#mapping sample names to experiments names reprocessed data +tepic_sample_id_mapping <- function(sample_cols, + user_key){ + + experiments <- deepblue_list_experiments(project = "TEPIC reprocessed IHEC data", + user_key = user_key) + + metadata_exp <- deepblue_info(experiments$id, user_key = user_key) + + sample_name <- list() + + for (i in 1:length(metadata_exp)){ + sample_name[["sample"]][i] <- metadata_exp[[i]]$sample_id + sample_name[["name"]][i] <- strsplit(metadata_exp[[i]]$name, + split = "[.]")[[1]][1] + } + + all_samples <- list() + + for (i in 1:length(sample_cols)){ + if(sample_cols[i] %in% sample_name$sample){ + all_samples[["id"]][i] <- sample_cols[i] + all_samples[["name"]][i] <- sample_name$name[match(sample_cols[i], + sample_name$sample)[1]] + + }else{ + all_samples[["id"]][i] <- sample_cols[i] + all_samples[["name"]][i] <- NA + } + } + + return(all_samples) +} \ No newline at end of file diff --git a/functions/supervised_sva_batch_effect.r b/functions/supervised_sva_batch_effect.r index 57e0cc8..b4deea7 100644 --- a/functions/supervised_sva_batch_effect.r +++ b/functions/supervised_sva_batch_effect.r @@ -78,13 +78,27 @@ supervised_sva_batch_effect <- function(filtered_score_matrix, rankesOfStd<-rank(stdRanks) controlProb<-1-(rankesOfStd/max(rankesOfStd)) - # n.sv <- num.sv(filtered_score_matrix, mod, method = "leek") + n.sv <- max(num.sv(filtered_score_matrix, mod, method = "leek"),10) + showNotification(paste("The number of latent factors estimated is", n.sv), duration = 3) - sva_object <- svaseq(filtered_score_matrix, mod, mod0, - # n.sv = n.sv, - controls = controlProb) + tryCatch({ + sva_object <- svaseq(filtered_score_matrix, mod, mod0, + n.sv = n.sv, + controls = controlProb) + },error = function(e){ + error_message <- paste("Sorry! Something went wrong!", + "Original error message:",e) + validate( + need(FALSE, message = error_message) + ) + }) + + - batch_adjusted_matrix <- sva_object$sv + nmod <- dim(mod)[2] + mod <- cbind(mod, sva_object$sv) + gammahat <- (log2(filtered_score_matrix+1) %*% mod %*% solve(t(mod) %*% mod))[, (nmod + 1):(nmod + n.sv)] + batch_adjusted_matrix <- log2(filtered_score_matrix + 1) - gammahat %*% t(sva_object$sv) attr(batch_adjusted_matrix, "meta") <- metadata diff --git a/functions/sva_batch_effect.r b/functions/sva_batch_effect.r index 1f5322b..8f29b5a 100644 --- a/functions/sva_batch_effect.r +++ b/functions/sva_batch_effect.r @@ -50,7 +50,8 @@ sva_batch_effect <- function(filtered_score_matrix, if(!length(which(row_sum == 0)) == 0){ filtered_score_matrix<-filtered_score_matrix[-which(row_sum==0),] } - if(outliers != ""){ + + if(length(outliers) != 0){ filtered_score_matrix <- filtered_score_matrix[,-match(outliers,colnames(filtered_score_matrix))] metadata <- metadata[-match(outliers, metadata[,"experiment"]),] } @@ -71,13 +72,26 @@ sva_batch_effect <- function(filtered_score_matrix, ) )),data = metadata) } - n.sv <- num.sv(filtered_score_matrix, mod, method = "leek") - showNotification(paste("The number of latent factors estimated is", n.sv), duration = 3) + n.sv <- min(num.sv(filtered_score_matrix, mod, method = "leek"), 10) + showNotification(paste("The number of latent factors estimated is", n.sv), duration = 3) - sva_object <- sva(filtered_score_matrix, mod, mod0, n.sv = n.sv) + tryCatch({ + sva_object <- sva(filtered_score_matrix, mod, mod0, n.sv = n.sv) + + },error = function(e){ + error_message <- paste("Sorry! Something went wrong!", + "Original error message:",e) + validate( + need(FALSE, message = error_message) + ) + }) - batch_adjusted_matrix <- sva_object$sv + nmod <- dim(mod)[2] + mod <- cbind(mod, sva_object$sv) + + gammahat <- (log2(filtered_score_matrix+1) %*% mod %*% solve(t(mod) %*% mod))[, (nmod + 1):(nmod + n.sv)] + batch_adjusted_matrix <- log2(filtered_score_matrix + 1) - gammahat %*% t(sva_object$sv) attr(batch_adjusted_matrix, "meta") <- metadata diff --git a/server/calculate_score_matrix.r b/server/calculate_score_matrix.r index 622ece1..1607bd6 100644 --- a/server/calculate_score_matrix.r +++ b/server/calculate_score_matrix.r @@ -1,5 +1,6 @@ observeEvent(input$show_input_check,{ - if(input$chr == ""){ + # if(input$chr == ""){chr <- NULL}else{chr <- input$chr} + if(is.null(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. @@ -16,15 +17,18 @@ filtered_score_matrix <- eventReactive(input$calculate_matrix, { #get scoring matrix validate( - need(all_experiments() != "\n", + need(!is.null(all_experiments()), "There were no experiments found. Please, try again") ) - 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) + # if(input$project == "TEPIC reprocessed IHEC data"){ + # 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) + # } + if((input$project == "TEPIC reprocessed IHEC data") & + (input$epigenetic_mark == "Gene Expression")){ + filtered_score_matrix <- all_experiments()[[2]] } else if(input$type_of_score == 'tiling'){ filtered_score_matrix<- score_matrix_tiling_regions(experiments = all_experiments()[[1]][input$table_rows_all], @@ -36,7 +40,7 @@ filtered_score_matrix <- eventReactive(input$calculate_matrix, { genome = input$genome, chr = input$chr, user_key = user_key) - }else{ + }else if (input$type_of_score == "annotation"){ filtered_score_matrix<- score_matrix_annotations(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 ed26b3c..8eddfae 100644 --- a/server/listing_experiments.r +++ b/server/listing_experiments.r @@ -5,11 +5,17 @@ all_experiments <- eventReactive(input$list_exper_btn, { withProgress(message = "Fetching experiments",min = 0, max = 3, value = 0, { - all_experiments <- list_experiments(genome = input$genome, - epigenetic_mark = input$epigenetic_mark, - project = input$project, - user_key = user_key, - filter_coverage = input$filter_coverage) + if(input$epigenetic_mark != "Gene Expression"){ + all_experiments <- list_experiments(genome = input$genome, + epigenetic_mark = input$epigenetic_mark, + project = input$project, + user_key = user_key, + filter_coverage = input$filter_coverage) + }else{ + all_experiments <- list_rna_seq_data(project = input$project, + user_key = user_key) + } + }) @@ -19,7 +25,7 @@ all_experiments <- eventReactive(input$list_exper_btn, { #Adding the next buttong if the experiments were successfully listed observeEvent(all_experiments(),{ - if(all_experiments() != "\n" & listed_experiments() == FALSE){ + if(!is.null(all_experiments()) & listed_experiments() == FALSE){ insertUI(selector = "#list_experiments_tab_nav", where = "beforeBegin", ui = tags$div(id = "inserted_nav", @@ -38,15 +44,21 @@ observeEvent(all_experiments(),{ output$table <- DT::renderDataTable({ #all_experiments reutrns "\n" if no experiments were listed validate( - need(all_experiments() != "\n", + need(!is.null(all_experiments()), message = "We couldn't find experiments according to the inputs you chose") ) - #converting experiments ids to interactive elements to show - #metadata in a popup window - experiments_list <- all_experiments()[[1]] - experiments_list$id <- sapply(experiments_list$id, convert_to_link) - + if(input$epigenetic_mark == "Gene Expression"){ + experiments_list <- all_experiments()[[1]] + experiments_list <- as.data.frame(experiments_list) + experiments_list$id <- sapply(experiments_list$id, convert_to_link) + }else{ + #converting experiments ids to interactive elements to show + #metadata in a popup window + experiments_list <- all_experiments()[[1]] + experiments_list$id <- sapply(experiments_list$id, convert_to_link) + } + #all_experiments()[[1]] DT::datatable(experiments_list, filter = list(position = 'top', clear = FALSE), escape = FALSE,selection = 'none', @@ -58,8 +70,20 @@ output$table <- DT::renderDataTable({ #Controlling the next button observeEvent(input$list_experiments_next_tab,{ - updateTabItems(session, "tabs", "score_matrix_tab") + # if((input$project == "TEPIC reprocessed IHEC data") & + # (input$genome == "GRCh38") & + # (input$epigenetic_mark == "Gene Expression")){ + # + # updateTabItems(session, "tabs", "plot_matrix_tab") + # + # header <- paste("Plotting PCA") + # shinyjs::html("pageHeader", header) + # + # }else{ + updateTabItems(session, "tabs", "score_matrix_tab") + + header <- paste("Calculate Score Matrix") + shinyjs::html("pageHeader", header) + # } - header <- paste("Calculate Score Matrix") - shinyjs::html("pageHeader", header) }) diff --git a/server/logging_in.r b/server/logging_in.r index 1a4f0d6..4a12577 100644 --- a/server/logging_in.r +++ b/server/logging_in.r @@ -11,7 +11,8 @@ observeEvent(input$log_in_btn, { }else{ user_key <<- input$user_key } - genomes <<- deepblue_list_genomes(user_key = user_key) + # + genomes <- deepblue_list_genomes(user_key = user_key) #removing startup message removeUI(selector = '#login_warning')