@sjcrh/proteinpaint-server 2.122.0 → 2.123.0

package/src/run_R.js

@@ -1,66 +0,0 @@
-/*
-Module for running R
-
-Arguments:
-	- <path>: [string] path to R script.
-	- <data>: [string] input data for R script.
-	- <args>: [array] arguments for R script.
-
-Input data is streamed into the standard input of the R script.
-Standard output of the R script is returned.
-*/
-
-import fs from 'fs'
-import serverconfig from './serverconfig.js'
-import { spawn } from 'child_process'
-import { Readable } from 'stream'
-
-export default async function run_R(path, data, args) {
-	try {
-		await fs.promises.stat(path)
-	} catch (e) {
-		throw `${path} does not exist`
-	}
-	return new Promise((resolve, reject) => {
-		const _stdout = []
-		const _stderr = []
-		// spawn R child process
-		const sp = spawn(serverconfig.Rscript, args ? [path, ...args] : [path])
-		if (data) {
-			// stream input data into R
-			try {
-				const input = data.endsWith('\n') ? data : data + '\n' // R expects a final end-of-line marker
-				Readable.from(input).pipe(sp.stdin)
-			} catch (e) {
-				sp.kill()
-				let errmsg = e
-				const stderr = _stderr.join('').trim()
-				if (stderr) errmsg += `\nR stderr: ${stderr}`
-				reject(errmsg)
-			}
-		}
-		// store stdout and stderr from R
-		sp.stdout.on('data', data => _stdout.push(data))
-		sp.stderr.on('data', data => _stderr.push(data))
-		sp.on('error', err => reject(err))
-		// return stdout and stderr when R process closes
-		sp.on('close', code => {
-			const stdout = _stdout.join('').trim()
-			const stderr = _stderr.join('').trim()
-			if (code !== 0) {
-				// handle non-zero exit status
-				let errmsg = `R process exited with non-zero status code=${code}`
-				if (stdout) errmsg += `\nR stdout: ${stdout}`
-				if (stderr) errmsg += `\nR stderr: ${stderr}`
-				reject(errmsg)
-			}
-			if (stderr) {
-				// handle R stderr
-				const errmsg = `R process emitted standard error\nR stderr: ${stderr}`
-				reject(errmsg)
-			}
-			// return standard out from R
-			resolve(stdout)
-		})
-	})
-}

package/utils/binom.R

@@ -1,17 +0,0 @@
-argv <- commandArgs(TRUE)
-
-infile <- argv[1]
-outfile <- argv[2]
-
-out <- NULL
-dat <- read.table(infile,sep="\t",header=F,quote="")
-
-for (i in 1:nrow(dat)) {
-	x <- binom.test(dat[i,10],dat[i,10]+dat[i,9],0.5)
-	y <- abs(dat[i,10]/(dat[i,10]+dat[i,9]) - 0.5)
-	out <- rbind(out,c(x$p.value,y))
-}
-#colnames(out) <- c("pvalue","delta.abs")
-out <- cbind(dat,out)
-
-write.table(out,file=outfile,sep="\t",quote=F,row.names=F,col.names=F)

package/utils/burden-ci95.R

@@ -1,134 +0,0 @@
-rm(list=ls())
-
-suppressPackageStartupMessages({
-  library(dplyr)  ### Qi changed to load plyr first, due to R message: If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
-  library(survival)
-  library(jsonlite)
-  library(parallel)
-  library(doParallel)
-})
-
-options(warn=-1)
-
-# stream in json input data
-con <- file("stdin", "r")
-json <- readLines(con)
-close(con)
-input <- fromJSON(json)
-# handle input arguments
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 0) stop("Usage: echo <in_json> | Rscript burden.R > <out_json>")
-
-# register the parallel backend (used by foreach() for parallelization)
-availCores <- detectCores()
-if (is.na(availCores)) stop("cannot detect number of available cores")
-registerDoParallel(cores = availCores - 1) # use all available cores except one
-
-chc_nums <- c(1:32)[-c(2,5,14,20,23,26)] # CHCs. 6 out of 32 CHCs not used.
-
-#####################
-# Functions for our method
-# Ref: https://stats.stackexchange.com/questions/46532/cox-baseline-hazard
-#####################
-# setwd("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata")
-
-
-#################################
-# Bootstrapping burden estimate #
-#################################
-
-# import get_burden() function
-source(file.path(input$binpath, "utils/getBurden.R"))
-
-# compute burden estimate for each bootstrap
-# parallelize across bootstraps (not across chcs)
-bootnums <- 20 # number of bootstraps
-f <- input$datafiles
-sampleData <- file.path(f$dir, f$files$sample) # dataframe with all the X's needed, and X's are updated by input values
-outall <- foreach(i = 1:bootnums, .combine = rbind) %dopar% {
-  fitsData <- file.path(f$dir, f$boosubdir, paste0("boot",i), f$files$fit)
-  survData <- file.path(f$dir, f$boosubdir, paste0("boot",i), f$files$surv)
-  person_burden <- get_burden(fitsData, survData, sampleData, FALSE)
-  person_burden$boot <- i
-  person_burden
-}
-
-
-###########################
-# 95% confidence interval #
-###########################
-
-# pr=5
-# outall=NULL
-# for(bootnum in 1:20){
-# #bootnum=1 ##### loop this from 1 to 20.
-# print(bootnum)
-# setwd(paste("/Users/gmatt/data/tp/files/hg38/sjlife/burden/boot/boot",bootnum,sep=""))
-# out1=read.csv(file=paste("./bootprimary",pr,".csv",sep=""))
-# out1$boot=bootnum
-# outall=rbind(outall,out1)
-# }
-
-
-### For each cell (each chc and age combination), there are 20 values. get the SD from the 20 bootstrapped burdens.
-SDall=NULL
-for(chc_num in chc_nums){ 
-  #	chc_num=1
-  data=outall[outall$chc==chc_num,]  ## data for this chc_num from the 20 bootstraps on each age point
-  data=data[,!colnames(data) %in% c("chc","boot")]
-  # for each column (each age point), get the SD
-  sd1=apply(data,2,sd) 
-  sd1$chc=chc_num
-  SDall=rbind(SDall,sd1)
-}
-
-# #### burden for total of the 26 CHCs is the sum of the 26 burdens. So for each boot, take all the 26 and then sum up, to result in a column with 20 rows.
-
-btotal=NULL
-for(bootnum in 1:bootnums){
-  #	bootnum=1
-  data=outall[outall$boot==bootnum,]
-  data=data[,!colnames(data) %in% c("chc","boot")]
-  total=apply(data,2,sum) 
-  btotal=rbind(btotal,total)
-}
-### get SD for the total burdern from the 20 rows
-sdtotal=apply(btotal,2,sd)
-sdtotal=data.frame(t(sdtotal), check.names=F)
-sdtotal$chc=0 ### indicating the total CHCs
-
-sd=rbind(SDall,sdtotal)
-sd=apply(sd,c(1,2),as.numeric)
-
-##### read the burden from the original data. Use that and SD to get lower and upper bound.
-# oburden=read.csv(paste("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata/primary",pr,".csv",sep=""))
-oburden=input$burden
-# oburden$boot=0
-### total burden for the original data
-total=apply(oburden[,!colnames(oburden) %in% c("chc","boot")],2,sum) 
-burdentotal=data.frame(t(total), check.names=F)
-burdentotal$chc=0 ### indicating the total CHCs
-oburden=rbind(oburden,burdentotal)  #### burden for each chc with age in the columns. The last row is for the total burden.
-oburden=data.frame(oburden, check.names=F)
-
-
-#### lower bound, the lowest is 0 burden.
-low=oburden[,!colnames(oburden) %in% "chc"]-1.96*sd[,!colnames(oburden) %in% "chc"]
-low[low<0]=0
-low$chc=oburden$chc
-#### The upper bound
-up=oburden[,!colnames(oburden) %in% "chc"]+1.96*sd[,!colnames(oburden) %in% "chc"]
-up$chc=oburden$chc
-
-### Take primary=5 CNS as an example (with hight TXs in step 3). At age 50, the burden is 9.04 with 95% CI (7.92 to 10.16)
-# oburden$X.50.51[oburden$chc==0]
-# low$X.50.51[low$chc==0]
-# up$X.50.51[up$chc==0]
-
-# plot(c(20,95),c(0,15),type="n",xlab="Age",ylab="Burden",font=2)
-# lines(seq(20,94,1),oburden[oburden$chc==0,!colnames(oburden) %in% "chc"],lty=1)
-# lines(seq(20,94,1),low[low$chc==0,!colnames(low) %in% "chc"],lty=2)
-# lines(seq(20,94,1),up[up$chc==0,!colnames(up) %in% "chc"],lty=2)
-
-ci <- list(low = low, up = up, overall=burdentotal)
-toJSON(ci, digits = NA, na = "string")

package/utils/burden-main.R

@@ -1,46 +0,0 @@
-rm(list=ls())
-
-suppressPackageStartupMessages({
-  library(dplyr)  ### Qi changed to load plyr first, due to R message: If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
-  library(survival)
-  library(jsonlite)
-  library(parallel)
-  library(doParallel)
-})
-
-options(warn=-1)
-
-# stream in json input data
-con <- file("stdin", "r")
-json <- readLines(con)
-close(con)
-input <- fromJSON(json)
-# handle input arguments
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 0) stop("Usage: echo <in_json> | Rscript burden.R > <out_json>")
-
-# register the parallel backend (used by foreach() for parallelization)
-availCores <- detectCores()
-if (is.na(availCores)) stop("cannot detect number of available cores")
-registerDoParallel(cores = availCores - 1) # use all available cores except one
-
-chc_nums <- c(1:32)[-c(2,5,14,20,23,26)] # CHCs. 6 out of 32 CHCs not used.
-
-#####################
-# Functions for our method
-# Ref: https://stats.stackexchange.com/questions/46532/cox-baseline-hazard
-#####################
-# setwd("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata")
-
-# import get_burden() function
-source(file.path(input$binpath, "utils/getBurden.R"))
-
-# compute main burden estimate
-# parallelize across CHCs
-f <- input$datafiles
-fitsData <- file.path(f$dir, f$files$fit)
-survData <- file.path(f$dir, f$files$surv)
-sampleData <- file.path(f$dir, f$files$sample) # dataframe with all the X's needed, and X's are updated by input values
-person_burden <- get_burden(fitsData, survData, sampleData, TRUE)
-
-toJSON(person_burden, digits = NA, na = "string")

package/utils/corr.R

@@ -1,38 +0,0 @@
-# Test syntax: cat ~/sjpp/test.txt | time Rscript corr.R
-
-# Load required packages
-suppressWarnings({
-  library(jsonlite)
-})
-
-# Read JSON input from stdin
-con <- file("stdin", "r")
-json <- readLines(con, warn=FALSE)
-close(con)
-input <- fromJSON(json)
-
-ids <- input$terms$id
-v1 <- input$terms$v1
-v2 <- input$terms$v2
-
-coeffs <- c()
-pvalues <- c()
-sample_sizes <- c()
-for (i in 1:length(v1)) {
-  suppressWarnings({
-    cor <- cor.test(as.numeric(unlist(v1[i])), as.numeric(unlist(v2[i])), method = input$method)
-  })    
-  coeffs <- c(coeffs, cor$estimate)
-  pvalues <- c(pvalues, cor$p.value)
-  sample_sizes <- c(sample_sizes, length(as.numeric(unlist(v1[i]))))
-}
-
-# Adjusting for multiple testing correction
-adjust_p_values <- p.adjust(pvalues, method = "fdr")
-output <- data.frame(ids, coeffs, pvalues, adjust_p_values, sample_sizes)
-names(output)[1] <- "id"
-names(output)[2] <- "correlation"
-names(output)[3] <- "original_p_value"
-names(output)[4] <- "adjusted_p_value"
-names(output)[5] <- "sample_size"
-toJSON(output, digits = NA, na = "string") # Setting digits = NA makes toJSON() use the max precision. na='string' causes any "not a number" to be reported as string. This from ?toJSON() documentation

package/utils/cuminc.R

@@ -1,279 +0,0 @@
-#################################
-# CUMULATIVE INCIDENCE ANALYSIS #
-#################################
-
-#########
-# USAGE
-#########
-
-# Usage: echo <in_json> | Rscript cuminc.R > <out_json>
-
-#   in_json: [string] input data in JSON format. Streamed through stdin.
-#   out_json: [string] cumulative incidence results in JSON format. Streamed to stdout.
-
-# Input JSON:
-# {
-#   data:
-#     chartId: [
-#       {
-#         time: time to event
-#         event: event code (0 = censored, 1 = event, 2 = competing risk event)
-#         series: series ID
-#       }
-#     ],
-#   startTime: custom start time of cuminc curve
-# }
-#
-# Output JSON:
-# {
-#   chartId: {
-#     estimates: {
-#       seriesId: [
-#         {
-#           time: time when estimate is computed
-#           est: estimated cumulative incidence value
-#           var: variance of cumulative incidence value
-#           low: 95% confidence interval - lower bound
-#           up: 95% confidence intervals - upper bound
-#           nrisk: # at-risk samples at timepoint
-#           ncensor: # censored samples at timepoint
-#         }
-#       ]
-#     },
-#     tests: [
-#       {
-#         series1: first series of test,
-#         series2: second series of test,
-#         pvalue: p-value of test,
-#         permutation: logical for whether permutation test was used
-#       }
-#     ]
-#   }
-# }
-
-
-########
-# CODE
-########
-
-library(parallel)
-library(jsonlite)
-suppressPackageStartupMessages(library(cmprsk))
-
-
-#############
-# FUNCTIONS #
-#############
-
-# function to run cumulative incidence analysis on data for a chart
-run_cuminc <- function(chart, startTime) {
-  chart$event <- as.factor(chart$event)
-  chart$series <- as.factor(chart$series)
-  estimates <- list()
-  if (length(levels(chart$series)) == 1) {
-    # single series
-    res <- cuminc(ftime = chart$time, fstatus = chart$event, cencode = 0)
-    # extract results of series for event of interest (i.e. event=1)
-    seriesRes <- as.data.frame(res[["1 1"]])
-    # if a custom start time is given, then this start time
-    # should serve as the first time point of the curve
-    if (!is.na(startTime)) {
-      seriesRes$time[1] <- startTime
-      if (seriesRes$time[1] == seriesRes$time[2]) {
-        # event occurred at startTime
-        # so time point 2 can serve as time point 1
-        seriesRes <- seriesRes[-1,]
-      }
-    }
-    # compute confidence intervals
-    seriesRes <- compute_ci(seriesRes)
-    # compute counts of at-risk samples, events, and
-    # censored exits at each time point
-    seriesRes <- compute_counts(seriesRes, chart)
-    estimates[[levels(chart$series)]] <- seriesRes
-    out <- list("estimates" = estimates)
-  } else {
-    # multiple series
-    # compute cumulative incidence for each pairwise combination of series
-    pairs <- combn(levels(chart$series), 2)
-    # vectors for storing results of Gray's tests
-    series1s <- character(length = ncol(pairs))
-    series2s <- character(length = ncol(pairs))
-    pvalues <- double(length = ncol(pairs))
-    usedPermutation <- logical(length = ncol(pairs))
-    # compute cumulative incidence for each pair
-    for (i in 1:ncol(pairs)) {
-      pair <- pairs[,i]
-      series1s[i] <- pair[1]
-      series2s[i] <- pair[2]
-      pairDat <- chart[chart$series %in% pair,]
-      pairDat$series <- droplevels(pairDat$series)
-      res <- cuminc(ftime = pairDat$time, fstatus = pairDat$event, group = pairDat$series, cencode = 0)
-      
-      # get curve estimates
-      for (series in pair) {
-        if (series %in% names(estimates)) next
-        # extract results of series for event of interest (i.e. event=1)
-        seriesRes <- as.data.frame(res[[paste(series,1)]])
-        # if a custom start time is given, then this start time
-        # should serve as the first time point of the curve
-        if (!is.na(startTime)) {
-          seriesRes$time[1] <- startTime
-          if (seriesRes$time[1] == seriesRes$time[2]) {
-            # event occurred at startTime
-            # so time point 2 can serve as time point 1
-            seriesRes <- seriesRes[-1,]
-          }
-        }
-        # compute confidence intervals
-        seriesRes <- compute_ci(seriesRes)
-        # compute counts of at-risk samples, events, and
-        # censored exits at each time point
-        seriesRes <- compute_counts(seriesRes, chart[chart$series == series,])
-        estimates[[series]] <- seriesRes
-      }
-      
-      # Gray's test
-      # the cuminc() function performed Gray's test between the pair of curves
-      # before using the results of the test, first check if permutation test is needed
-      # build an event-series contingency table
-      # if expected count of any cell in table is <5, then permutation test is needed
-      tbl <- table(pairDat$event, pairDat$series)
-      tbl <- tbl[c("0","1"),] # remove event2 samples
-      rmarg <- rowSums(tbl)
-      cmarg <- colSums(tbl)
-      tmarg <- sum(tbl)
-      E <- (rmarg %o% cmarg)/tmarg
-      if (any(E < 5)) {
-        # expected count of at least one cell in table is <5
-        # perform permutation test
-        usedPermutation[i] <- TRUE
-        tsO <- res$Tests["1","stat"] # test statistic computed for event of interest based on original data
-        pvalue <- permutationTest(pairDat, tsO)
-      } else {
-        # expected counts of all cells in table are >=5
-        # permutation test is not needed
-        # use computed Gray's test p-value for event
-        # of interest
-        usedPermutation[i] <- FALSE
-        pvalue <- signif(res$Tests["1","pv"], 2)
-      }
-      if (pvalue == 0) pvalue <- "<1e-16" # see https://stacks.cdc.gov/view/cdc/22757/cdc_22757_DS11.pdf
-      pvalues[i] <- pvalue
-    }
-    tests <- data.frame("series1" = series1s, "series2" = series2s, "pvalue" = pvalues, "permutation" = usedPermutation, stringsAsFactors = F)
-    out <- list("estimates" = estimates, "tests" = tests)
-  }
-  return(out)
-}
-
-# function to perform permutation test
-permutationTest <- function(dat, tsO) {
-  tsPs <- runPermutations(100, dat) # start with 100 permutations
-  pvalue <- getPermutePvalue(tsPs, tsO)
-  if (pvalue <= 0.2) {
-    # p-value is <=0.2, so additional permutations are
-    # needed to get more accurate p-value to determine
-    # if p-value is significant
-    tsPs <- c(tsPs, runPermutations(100, dat))
-    pvalue <- getPermutePvalue(tsPs, tsO)
-    if (pvalue <= 0.1) {
-      # additional permutations are needed
-      tsPs <- c(tsPs, runPermutations(300, dat))
-      pvalue <- getPermutePvalue(tsPs, tsO)
-      if (pvalue <= 0.05) {
-        # additional permutations are needed
-        tsPs <- c(tsPs, runPermutations(500, dat))
-        pvalue <- getPermutePvalue(tsPs, tsO)
-        # no need to run more than a total of 1000 permutations
-      }
-    }
-  }
-  return(pvalue)
-}
-
-# function to perform permutations
-# for each permutation:
-#   - shuffle series assignments of samples
-#   - perform cumulative incidence analysis
-#   - compute the test statistic of Gray's test
-# return all permuted test statistics
-runPermutations <- function(M, dat) {
-  tsPs <- replicate(M, cuminc(ftime = dat$time, fstatus = dat$event, group = sample(dat$series), cencode = 0)$Tests["1","stat"], simplify = T)
-  return(tsPs)
-}
-
-# function to compute p-value for permutation test
-# perform two-tailed test
-getPermutePvalue <- function(tsPs, tsO) {
-  P_left <- sum(tsPs <= -abs(tsO))/(length(tsPs)+1)
-  P_right <- sum(tsPs >= abs(tsO))/(length(tsPs)+1)
-  pvalue <- signif(P_left + P_right, 2)
-  return(pvalue)
-}
-
-# function to compute 95% confidence intervals
-compute_ci <- function(res) {
-  low <- res$est - (1.96 * sqrt(res$var))
-  low[low < 0] <- 0
-  up <- res$est + (1.96 * sqrt(res$var))
-  res["low"] <- low
-  res["up"] <- up
-  return(res)
-}
-
-# function to compute counts of at-risk samples, events, and censored exits at each time point
-# res: series-specific res
-# chart: series-specific chart
-compute_counts <- function(res, chart) {
-  # compute at-risk counts
-  # these counts are the number of samples
-  # that have not experienced an event or
-  # have not been censored prior to each time point
-  res$nrisk <- apply(res, 1, function(timepoint) length(which(chart$time >= timepoint["time"])))
-  # compute number of events and censored exits during each time point
-  times <- unique(res$time)
-  chart <- cbind(chart, "bin" = findInterval(chart$time, times))
-  res <- cbind(res, "bin" = findInterval(res$time, times))
-  m <- table(chart$bin, chart$event)
-  m <- m[, c("0","1"), drop = F] # remove competing risk events
-  colnames(m) <- c("ncensor", "nevent")
-  m <- cbind(m, "bin" = as.numeric(row.names(m)))
-  res <- merge(res, m, by = "bin", all.x = T)
-  res$nevent[is.na(res$nevent)] <- 0
-  res$ncensor[is.na(res$ncensor)] <- 0
-  res <- res[,c(2:7,9,8)]
-  return(res)
-}
-
-
-################
-# PREPARE DATA #
-################
-
-# stream in json input
-con <- file("stdin", "r")
-json <- readLines(con)
-close(con)
-input <- fromJSON(json)
-
-dat <- input$data
-startTime <- ifelse("startTime" %in% names(input), input$startTime, NA)
-
-#save.image("~/test.RData")
-#stop("stop here")
-
-
-################
-# RUN ANALYSIS #
-################
-
-# perform cumulative incidence analysis
-# parallelize the analysis across charts/variants
-availCores <- detectCores()
-if (is.na(availCores)) stop("unable to detect number of available cores")
-cores <- ifelse(length(dat) < availCores, length(dat), availCores)
-ci_results <- mclapply(X = dat, FUN = run_cuminc, startTime = startTime, mc.cores = cores)
-
-# output results in json format
-toJSON(ci_results, digits = NA, na = "string")

package/utils/density.R

@@ -1,36 +0,0 @@
-library(jsonlite)
-# This script reads in a json string from stdin with the parameters, 
-# calculates the densities of each plot and returns the densities as a json string
-# The input json string contains plot2Values, a dictionary where each field maps to an array of numbers and the 
-# global min and max values of the x axis.
-# The output json string is a dictionary  with the density for each plot. The density is represented 
-# by a an object where {x: [x density values], y: [y density values]}
-# In order to test it you can run the following command from the command line replacing plot2Values and min and max
-# with your values: 
-# echo '{plot2Values: {"plotA": [1.2, 2, 3], "plotB": [4.5, 5, 6]}, min: 1.2, max:6}' | Rscript ./density.R
-
-con <- file("stdin", "r")
-json <- readLines(con)
-close(con)
-data <- fromJSON(json)
-plot2Values <- data$plot2Values
-min <- data$min
-max <- data$max
-densities <- list()
-for(plot in names(plot2Values)){
-    values = plot2Values[[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, to=max)
-    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: [...]}}
-
-