@sjcrh/proteinpaint-server 2.112.0 → 2.113.0

package/src/serverconfig.js

@@ -9,7 +9,7 @@ import { fileURLToPath } from 'url'
 
 // import.meta.dirname is undefined when using docker dev environment
 // use __dirname and __filename global variable convention from commonjs
-const __dirname = import.meta.dirname || (new URL('.', import.meta.url)).pathname
+const __dirname = import.meta.dirname || new URL('.', import.meta.url).pathname
 const __filename = import.meta.filename || fileURLToPath(import.meta.url)
 
 // do not assume that serverconfig.json is in the same dir as server.js
@@ -112,8 +112,7 @@ if (!serverconfig.binpath) {
 			} else {
 				if (fs.existsSync('./server')) serverconfig.binpath = fs.realpathSync('./server')
 				else if (fs.existsSync('./src')) serverconfig.binpath = fs.realpathSync('./src/..')
-				else if (__dirname.includes('/server/'))
-					serverconfig.binpath = __dirname.split('/server/')[0] + '/server'
+				else if (__dirname.includes('/server/')) serverconfig.binpath = __dirname.split('/server/')[0] + '/server'
 				else if (__dirname.includes('/proteinpaint')) serverconfig.binpath = __dirname
 				else throw 'unable to determine the serverconfig.binpath'
 			}
@@ -127,7 +126,7 @@ if (serverconfig.debugmode && !serverconfig.binpath.includes('sjcrh/')) {
 	const routeSetters = []
 	const defaultDir = path.join(serverconfig.binpath, 'src/test/routes')
 	// will add testing routes as needed and if found, such as in dev environment
-	const testRouteSetters = ['gdc.js', 'specs.js', 'readme.js']
+	const testRouteSetters = ['gdc.js', 'specs.js', 'readme.js', 'closeCoverage.js']
 	if (serverconfig.features.sse === undefined) serverconfig.features.sse = true
 	if (typeof serverconfig.features.sse !== 'boolean') {
 		throw `serverconfig.features.sse must be either undefined or boolean`
@@ -231,7 +230,10 @@ if (process.argv.find(a => a == 'validate')) {
 	serverconfig.features.stopGdcCacheAliquot = true
 }
 
-if (!serverconfig.backend_only && fs.existsSync(path.join(process.cwd(), './public'))) {
+const publicDir = path.join(process.cwd(), './public')
+if (!serverconfig.backend_only && fs.existsSync(publicDir)) serverconfig.publicDir = publicDir
+
+if (serverconfig.publicDir) {
 	const defaultTarget = path.join(serverconfig.binpath, 'cards')
 	if (!serverconfig.cards) {
 		serverconfig.cards = {

package/utils/edge.R

@@ -27,7 +27,7 @@ read_json_time <- system.time({
     controls <- unlist(strsplit(input$control, ","))
     combined <- c("geneID", "geneSymbol", cases, controls)
 })
-#cat("Time to read JSON: ", read_json_time[3], " seconds\n")
+#cat("Time to read JSON: ", as.difftime(read_json_time, units = "secs")[3], " seconds\n")
 
 # Read counts data
 read_counts_time <- system.time({
@@ -67,7 +67,7 @@ read_counts_time <- system.time({
         stop("Unknown storage type")
     }
 })
-#cat("Time to read counts data: ", read_counts_time[3], " seconds\n")
+#cat("Time to read counts data: ", as.difftime(read_counts_time, units = "secs")[3], " seconds\n")
 
 # Create conditions vector
 conditions <- c(rep("Diseased", length(cases)), rep("Control", length(controls)))
@@ -77,19 +77,19 @@ gene_id_symbols <- paste0(geneIDs, "\t", geneSymbols)
 dge_list_time <- system.time({
     y <- DGEList(counts = read_counts, group = conditions, genes = gene_id_symbols)
 })
-#cat("Time to generate DGEList: ", dge_list_time[3], " seconds\n")
+#cat("Time to generate DGEList: ", as.difftime(dge_list_time, units = "secs")[3], " seconds\n")
 
 # Filter and normalize counts
 filter_time <- system.time({
     keep <- filterByExpr(y, min.count = input$min_count, min.total.count = input$min_total_count)
 })
-#cat("Time to filter by expression: ", filter_time[3], " seconds\n")
+#cat("Time to filter by expression: ", as.difftime(filter_time, unit = "secs")[3], " seconds\n")
 
 normalization_time <- system.time({
     y <- y[keep, keep.lib.sizes = FALSE]
     y <- normLibSizes(y) # Using TMM method for normalization
 })
-#cat("Normalization time: ", normalization_time[3], " seconds\n")
+#cat("Normalization time: ", as.difftime(normalization_time, units = "secs")[3], " seconds\n")
 
 # Cutoffs for cpm, will add them as UI options later
 if (length(samples_indices) > 100) {
@@ -105,40 +105,28 @@ if (length(samples_indices) > 100) {
 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")
+#cat("Filter using cpm time: ", as.difftime(filter_using_cpm_time, units = "secs")[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
 
+if (dim(read_counts)[1] * dim(read_counts)[2] < as.numeric(input$mds_cutoff)) { # If the dimensions of the read counts matrix is below this threshold, only then the mds image will be generated as its very compute intensive
+   mds_plot_time <- system.time({
+       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
+   })
+   #cat("mds plot time: ", as.difftime(mds_plot_time, units = "secs")[3], " seconds\n")
+}
 
 # Differential expression analysis
 if (length(input$conf1) == 0) { # No adjustment of confounding factors
     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({
-                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("QL fit time: ", fit_time[3], " seconds\n")
-
-    test_time <- system.time({
-        suppressWarnings({
-            suppressMessages({
-                et <- glmQLFTest(fit)
-            })
-        })
-    })
-    #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
@@ -152,7 +140,7 @@ if (length(input$conf1) == 0) { # No adjustment of confounding factors
           model_gen_time <- system.time({
                  design <- model.matrix(~ conditions + conf1, data = y$samples)
           })
-          #cat("Time for making design matrix: ", model_gen_time[3], " seconds\n")
+          #cat("Time for making design matrix: ", as.difftime(model_gen_time, units = "secs")[3], " seconds\n")
     } else {
           # Check the type of confounding variable 2
           if (input$conf2_mode == "continuous") { # If this is float, the input conf2 vector should be converted into a numeric vector
@@ -164,46 +152,121 @@ if (length(input$conf1) == 0) { # No adjustment of confounding factors
           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")
+          #cat("Time for making design matrix: ", as.difftime(model_gen_time, units = "secs")[3], " seconds\n")
+
     }
+}
 
-    fit_time <- system.time({
-        suppressWarnings({
-            suppressMessages({
-                fit <- glmQLFit(y,design)
-            })
-        })
-    })
-    #cat("QL fit time: ", fit_time[3], " seconds\n")
-    test_time <- system.time({
-        suppressWarnings({
-            suppressMessages({
-                et <- glmQLFTest(fit, coef = "conditionsDiseased")
-            })
-        })
-    })
-    #cat("QL test time: ", test_time[3], " seconds\n")
+DE_method <- input$DE_method
+if (DE_method == "edgeR") {
+      fit_time <- system.time({
+          suppressWarnings({
+              suppressMessages({
+                  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("QL fit time: ", as.difftime(fit_time, units = "secs")[3], " seconds\n")
+      test_time <- system.time({
+          suppressWarnings({
+              suppressMessages({
+                  et <- glmQLFTest(fit, coef = "conditionsDiseased")
+              })
+          })
+      })
+      #cat("QL test time: ", as.difftime(test_time, units = "secs")[3], " seconds\n")    
+    
+       # Saving QL fit image
+       ql_plot_time <- system.time({
+           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
+           fit_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,"/",fit_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
+       })
+       #cat("ql plot time: ", as.difftime(ql_plot_time, units = "secs")[3], " seconds\n")
+       logfc <- et$table$logFC
+       logcpm <- et$table$logCPM
+       pvalues <- et$table$PValue
+       genes_matrix <- str_split_fixed(unlist(et$genes), "\t", 2)
+       geneids <- unlist(genes_matrix[, 1])
+       genesymbols <- unlist(genes_matrix[, 2])
+       adjust_p_values <- p.adjust(pvalues, method = "fdr")
+} else if (DE_method == "limma") {
+       # Do voom transformation
+       voom_transformation_time <- system.time({
+           suppressWarnings({
+               suppressMessages({
+                    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
+                    fit_image_name <- paste0("limma_voom_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,"/",fit_image_name), width = 1000, height = 1000, res = 200) # Opening a png device
+                    par(oma = c(0, 0, 0, 0)) # Creating a margin
+                    suppressWarnings({
+                       suppressMessages({
+                           y <- voom(y, design, plot = TRUE)
+                       })
+                    })
+                    dev.off() # Gives a null device message which breaks JSON. Commenting it out for now, will investigate it later
+               })
+           })
+       })
+       #cat("voom transformation time: ", as.difftime(voom_transformation_time, units = "secs")[3], " seconds\n")
+
+       # Fit linear model
+       fit_time <- system.time({
+           suppressWarnings({
+               suppressMessages({
+                   fit <- lmFit(y, design, plot = FALSE)
+               })
+           })
+       })
+       #cat("limma fit time: ", as.difftime(fit_time, units = "secs")[3], " seconds\n")
+
+       # Saving mean-difference plot (aka MA plot)
+       #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
+       #md_image_name <- paste0("limma_md_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,"/",md_image_name), width = 1000, height = 1000, res = 200) # Opening a png device
+       #par(oma = c(0, 0, 0, 0)) # Creating a margin
+       #plotMD(fit) # Plot the limma fit
+       ## dev.off() # Gives a null device message which breaks JSON. Commenting it out for now, will investigate it later
+
+       # Empirical Bayes smoothing
+       empirical_smoothing_time <- system.time({
+           suppressWarnings({
+               suppressMessages({
+                   tmp <- eBayes(fit)
+               })
+           })
+       })
+       #cat("Empirical smoothing time: ", as.difftime(empirical_smoothing_time, units = "secs")[3], " seconds\n")
+
+       # Time for selecting top genes
+       top_genes_selection_time <- system.time({
+           suppressWarnings({
+             suppressMessages({
+                  top_table <- topTable(tmp, coef = "conditionsDiseased", number = Inf, adjust.method = "fdr") # The coeff needs to be specified in topTable() because it needs to know for which contrast the logFC needs to be calculated https://www.biostars.org/p/160465/
+                  logfc <- top_table$logFC
+                  pvalues <- top_table$P.Value
+                  genes_matrix <- str_split_fixed(unlist(top_table$genes), "\t", 2)
+                  geneids <- unlist(genes_matrix[, 1])
+                  genesymbols <- unlist(genes_matrix[, 2])
+                  adjust_p_values <- top_table$adj.P.Val
+             })
+           })
+       })
+       #cat("Time for selecting top genes: ", as.difftime(top_genes_selection_time, units = "secs")[3], " seconds\n")
+} else { # Should not happen
+       stop(paste0("Unknown method:", DE_method))
 }
 
-# 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
-    logcpm <- et$table$logCPM
-    pvalues <- et$table$PValue
-    genes_matrix <- str_split_fixed(unlist(et$genes), "\t", 2)
-    geneids <- unlist(genes_matrix[, 1])
-    genesymbols <- unlist(genes_matrix[, 2])
-    adjust_p_values <- p.adjust(pvalues, method = "fdr")
+final_data_generation_time <- system.time({
     output <- data.frame(geneids, genesymbols, logfc, -log10(pvalues), -log10(adjust_p_values))
     names(output)[1] <- "gene_name"
     names(output)[2] <- "gene_symbol"
@@ -213,17 +276,11 @@ multiple_testing_correction_time <- system.time({
 })
 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")
+final_output$edgeR_ql_image_name <- fit_image_name
+if (dim(read_counts)[1] * dim(read_counts)[2] < as.numeric(input$mds_cutoff)) { # If the dimensions of the read counts matrix is below this threshold, only then the mds image will be generated as its very compute intensive
+    final_output$edgeR_mds_image_name <- mds_image_name
+}
+#cat("Time for generating final dataframe: ", as.difftime(final_data_generation_time, unit = "secs")[3], " seconds\n")
 
 # Output results
 toJSON(final_output)
-
-#-----------------------------------#
-# Will implement this later
-filter_genes_by_group_variance <- function(read_counts, gene_id_symbols, num_variable_genes, cases, controls) {
-    # Divide the read counts into two groups
-    case_read_counts <- read_counts[, cases]
-    control_read_counts <- read_counts[, controls]
-}