@sjcrh/proteinpaint-server 2.109.1 → 2.111.0

package/utils/density.R

@@ -0,0 +1,29 @@
+library(jsonlite)
+# This script reads in a json string from stdin, calculates the densities of each plot and returns the densities as a json string
+# The input json string is a dictionary where each field maps to an array of numbers
+# The output json string is a dictionary  with the density for each plot. The density is represented like {x: [x density values], y: [y density values]}
+# In order to test it you can run this from the command line replacing the arrays with your own: 
+# echo '{"plotA": [1.2, 2, 3], "plotB": [4.5, 5, 6]}' | Rscript ./density.R
+
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+data <- fromJSON(json)
+densities <- list()
+for(plot in names(data)){
+    values = data[[plot]]
+    # If the plot has less than 5 values or all the values are the same, we will return a flat line
+    if(length(values) <= 5 | length(unique(values)) == 1){
+        y = rep(0, length(values))
+        densities[[plot]] <- list(x=values, y=y)
+        next
+    }
+    den = density(x = values, from=min(values), to=max(values))
+    x = den$x
+    y = den$y
+    result = list(x=x, y=y) #This is an object  with two keys x and y that are number arrays
+    densities[[plot]] <- result
+}
+toJSON(densities, digits = NA, na = "string") # will  return a json like { plotA: {x:[...], y: [...]}}
+
+

package/utils/edge.R

@@ -10,24 +10,11 @@ suppressWarnings({
     suppressPackageStartupMessages(library(dplyr))
 })
 
-filter_genes_by_global_variance <- function(read_counts, gene_id_symbols, num_variable_genes) {
-   # Calculate the standard deviation of each row
-   row_sd <- apply(read_counts, 1, sd)
-   # Add the standard deviation as a new column to the dataframe
-   read_counts$Row_SD <- row_sd
-   # Add the gene_id_symbols as a new column to the dataframe
-   read_counts$gene_id_symbols <- gene_id_symbols
-   # Sort the dataframe based on the standard deviation column
-   read_counts <- read_counts[order(read_counts$Row_SD, decreasing = TRUE), ]
-   # Select top 3000 rows
-   read_counts <- head(read_counts,num_variable_genes) # Currently hardcoded 3000 genes
-   # Get gene id symbols corresponding to the reordered read count matrix
-   gene_id_symbols <- read_counts$gene_id_symbols
-   # Remove column Row_SD from read_counts dataframe
-   read_counts <- read_counts[, !names(read_counts) %in% "Row_SD"]
-   # Remove column gene_id_symbols from read_counts dataframe
-   read_counts <- read_counts[, !names(read_counts) %in% "gene_id_symbols"]
-   return(list(read_counts = read_counts, gene_id_symbols = gene_id_symbols))
+# Filter based on CPM
+filter_using_cpm <- function(y, gene_cpm_cutoff, sample_cpm_cutoff, count_cpm_cutoff) {
+   selr <- rowSums(cpm(y$counts)>gene_cpm_cutoff)>=sample_cpm_cutoff
+   selc <- colSums(cpm(y$counts))>=count_cpm_cutoff
+   y <- y[selr, selc]
 }
 
 # Read JSON input from stdin
@@ -86,21 +73,6 @@ read_counts_time <- system.time({
 conditions <- c(rep("Diseased", length(cases)), rep("Control", length(controls)))
 gene_id_symbols <- paste0(geneIDs, "\t", geneSymbols)
 
-filter_genes_time <- system.time({
-if (length(input$VarGenes) != 0) { # Filter out variable genes for DE analysis
-   filtered_read_counts <- filter_genes_by_global_variance(read_counts, gene_id_symbols, input$VarGenes)
-   read_counts <- filtered_read_counts$read_counts
-   gene_id_symbols <- filtered_read_counts$gene_id_symbols
-
-   #### Will implement filtering by per group variance later
-   #filtered_read_counts <- filter_genes_by_group_variance(read_counts, gene_id_symbols, num_variable_genes, cases, controls)
-   #read_counts <- filtered_read_counts$read_counts
-   #gene_id_symbols <- filtered_read_counts$gene_id_symbols
-}
-})
-
-#cat("Time to filter genes: ", filter_genes_time[3], " seconds\n")
-
 # Create DGEList object
 dge_list_time <- system.time({
     y <- DGEList(counts = read_counts, group = conditions, genes = gene_id_symbols)
@@ -115,27 +87,59 @@ filter_time <- system.time({
 
 normalization_time <- system.time({
     y <- y[keep, keep.lib.sizes = FALSE]
-    y <- calcNormFactors(y, method = "TMM")
+    y <- normLibSizes(y) # Using TMM method for normalization
 })
 #cat("Normalization time: ", normalization_time[3], " seconds\n")
 
+# Cutoffs for cpm, will add them as UI options later
+if (length(samples_indices) > 100) {
+    gene_cpm_cutoff <- 15
+    sample_cpm_cutoff <- 30
+    count_cpm_cutoff <- 100000
+} else {
+    gene_cpm_cutoff <- 5
+    sample_cpm_cutoff <- 15
+    count_cpm_cutoff <- 100000
+}
+
+filter_using_cpm_time <- system.time({
+    y <- filter_using_cpm(y, gene_cpm_cutoff, sample_cpm_cutoff, count_cpm_cutoff) # Filtering counts matrix based on gene_cpm_cutoff, sample_cpm_cutoff and count_cpm_cutoff
+ })
+#cat("Filter using cpm time: ", filter_using_cpm_time[3], " seconds\n")
+
+# Saving MDS plot image
+set.seed(as.integer(Sys.time())) # Set the seed according to current time
+cachedir <- input$cachedir # Importing serverconfig.cachedir
+random_number <- runif(1, min = 0, max = 1) # Generating random number
+mds_image_name <- paste0("edgeR_mds_temp_",random_number,".png") # Generating random image name so that simultaneous server side requests do NOT generate the same edgeR file name
+png(filename = paste0(cachedir,"/",mds_image_name), width = 1000, height = 1000, res = 200) # Opening a png device
+par(oma = c(0, 0, 0, 0)) # Creating a margin
+mds_conditions <- c(rep("T", length(cases)), rep("C", length(controls))) # Case samples are labelled "T" and control samples are labelled "C". Single-letter labelling added because otherwise labels get overwritten on each other.
+plotMDS(y, labels = mds_conditions) # Plot the edgeR MDS plot
+# dev.off() # Gives a null device message which breaks JSON. Commenting it out for now, will investigate it later
+
+
 # Differential expression analysis
 if (length(input$conf1) == 0) { # No adjustment of confounding factors
-    dispersion_time <- system.time({
+    design <- model.matrix(~conditions) # Based on the protocol defined in section 1.4 of edgeR manual https://bioconductor.org/packages/release/bioc/vignettes/edgeR/inst/doc/edgeRUsersGuide.pdf
+    fit_time <- system.time({
         suppressWarnings({
             suppressMessages({
-                y <- estimateDisp(y)
+                fit <- glmQLFit(y,design) # The glmQLFit() replaces glmFit() which implements the quasi-likelihood function. This is better able to account for overdispersion as it employs a more lenient approach where variance is not a fixed function of the mean.
             })
         })
     })
-    #cat("Dispersion time: ", dispersion_time[3], " seconds\n")
+    #cat("QL fit time: ", fit_time[3], " seconds\n")
 
-    exact_test_time <- system.time({
-        et <- exactTest(y)
+    test_time <- system.time({
+        suppressWarnings({
+            suppressMessages({
+                et <- glmQLFTest(fit)
+            })
+        })
     })
-    #cat("Exact test time: ", exact_test_time[3], " seconds\n")
+    #cat("QL test time: ", test_time[3], " seconds\n")
 } else { # Adjusting for confounding factors
-
     # Check the type of confounding variable
     if (input$conf1_mode == "continuous") { # If this is float, the input conf1 vector should be converted into a numeric vector
       conf1 <- as.numeric(input$conf1)
@@ -144,7 +148,7 @@ if (length(input$conf1) == 0) { # No adjustment of confounding factors
     }
 
     if (length(input$conf2) == 0) { # No adjustment of confounding factor 2
-          y$samples <- data.frame(conditions = conditions, conf1 = conf1)
+          y$samples <- data.frame(y$samples, conditions = conditions, conf1 = conf1)
           model_gen_time <- system.time({
                  design <- model.matrix(~ conditions + conf1, data = y$samples)
           })
@@ -156,29 +160,41 @@ if (length(input$conf1) == 0) { # No adjustment of confounding factors
           } else { # When input$conf2_mode == "discrete" keep the vector as string.
             conf2 <- as.factor(input$conf2)
           }
-          y$samples <- data.frame(conditions = conditions, conf1 = conf1, conf2 = conf2)
+          y$samples <- data.frame(y$samples, conditions = conditions, conf1 = conf1, conf2 = conf2)
           model_gen_time <- system.time({
                  design <- model.matrix(~ conditions + conf1 + conf2, data = y$samples)
           })
           #cat("Time for making design matrix: ", model_gen_time[3], " seconds\n")
     }
 
-    dispersion_time <- system.time({
-        y <- estimateDisp(y, design)
-    })
-    #cat("Dispersion time: ", dispersion_time[3], " seconds\n")
-
     fit_time <- system.time({
-        fit <- glmFit(y, design)
+        suppressWarnings({
+            suppressMessages({
+                fit <- glmQLFit(y,design)
+            })
+        })
     })
-    #cat("Fit time: ", fit_time[3], " seconds\n")
-
-    test_statistics_time <- system.time({
-        et <- glmLRT(fit, coef = "conditionsDiseased")
+    #cat("QL fit time: ", fit_time[3], " seconds\n")
+    test_time <- system.time({
+        suppressWarnings({
+            suppressMessages({
+                et <- glmQLFTest(fit, coef = "conditionsDiseased")
+            })
+        })
     })
-    #cat("Test statistics time: ", test_statistics_time[3], " seconds\n")
+    #cat("QL test time: ", test_time[3], " seconds\n")
 }
 
+# Saving QL fit image
+set.seed(as.integer(Sys.time())) # Set the seed according to current time
+cachedir <- input$cachedir # Importing serverconfig.cachedir
+random_number <- runif(1, min = 0, max = 1) # Generating random number
+ql_image_name <- paste0("edgeR_ql_temp_",random_number,".png") # Generating random image name so that simultaneous server side requests do NOT generate the same edgeR file name
+png(filename = paste0(cachedir,"/",ql_image_name), width = 1000, height = 1000, res = 200) # Opening a png device
+par(oma = c(0, 0, 0, 0)) # Creating a margin
+plotQLDisp(fit) # Plot the edgeR fit
+# dev.off() # Gives a null device message which breaks JSON. Commenting it out for now, will investigate it later
+
 # Multiple testing correction
 multiple_testing_correction_time <- system.time({
     logfc <- et$table$logFC
@@ -195,10 +211,14 @@ multiple_testing_correction_time <- system.time({
     names(output)[4] <- "original_p_value"
     names(output)[5] <- "adjusted_p_value"
 })
+final_output <- c()
+final_output$gene_data <- output
+final_output$edgeR_ql_image_name <- ql_image_name
+final_output$edgeR_mds_image_name <- mds_image_name
 #cat("Time for multiple testing correction: ", multiple_testing_correction_time[3], " seconds\n")
 
 # Output results
-toJSON(output)
+toJSON(final_output)
 
 #-----------------------------------#
 # Will implement this later