RNA-seq matrix and plotting almost done

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,54 +129,28 @@ 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 ####
 
   # #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,{

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]",

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
 

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')" 

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"),

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)
 }