@sjcrh/proteinpaint-server 2.48.1 → 2.49.0

package/src/run_R.js

@@ -0,0 +1,66 @@
+/*
+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'
+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/burden.R

@@ -10,13 +10,17 @@ library(parallel)
 
 options(warn=-1)
 
-# Input from lines2R
+# 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) != 4) stop("Usage: Rscript burden.R in.json fitsData survData sampleData > results")
-infile <- args[1]
-fitsData <- args[2]
-survData <- args[3]
-sampleData <- args[4]
+if (length(args) != 3) stop("Usage: echo <in_json> | Rscript burden.R fitsData survData sampleData > <out_json>")
+fitsData <- args[1]
+survData <- args[2]
+sampleData <- args[3]
 
 chc_nums <- c(1:32)[-c(2,5,14,20,23,26)] # CHCs. 6 out of 32 CHCs not used.
 availCores <- detectCores()
@@ -82,7 +86,6 @@ newdata_chc_sampled$t.endage=seq(6,71,1)
 ### originally data fit to 60 only. using cphfits can get est up to 60 only. ==> later I further cut at 50 or so to fit lines, becuase original data had 95th percentile around age 50 or so.
 newdata_chc_sampled=newdata_chc_sampled[newdata_chc_sampled$t.endage<=60,]
 
-input <- fromJSON(infile)
 # paste(names(input), input, sep = ":", collapse = ",")
 pr=input$diaggrp
 sexval=input$sex

package/utils/cuminc.R

@@ -1,15 +1,15 @@
 #################################
-# Cumulative incidence analysis #
+# CUMULATIVE INCIDENCE ANALYSIS #
 #################################
 
 #########
-# Usage #
+# USAGE
 #########
 
-# Usage: Rscript cuminc.R in.json > results
+# Usage: echo <in_json> | Rscript cuminc.R > <out_json>
 
-# Input data is in JSON format and is read in from <in.json> file.
-# Cuminc results are written in JSON format to stdout.
+#   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:
 # {
@@ -53,13 +53,18 @@
 
 
 ########
-# Code #
+# 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)
@@ -242,11 +247,15 @@ compute_counts <- function(res, chart) {
 }
 
 
-# read in data
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 1) stop("Usage: Rscript cuminc.R in.json > results")
-infile <- args[1]
-input <- fromJSON(infile)
+################
+# 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)
@@ -254,6 +263,11 @@ 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()

package/utils/hclust.R

@@ -1,5 +1,7 @@
-# Usage:
-# time Rscript hclust.R in.json
+# Usage: echo <in_json> | Rscript hclust.R > <out_json>
+
+#   in_json: [string] input data in JSON format. Streamed through stdin.
+#   out_json: [string] clustering results in JSON format. Streamed to stdout.
 
 # Image is in Rplots.pdf
 
@@ -21,10 +23,10 @@ suppressWarnings({
 #library(ggplot2) # Uncomment this line to plot heatmap in R
 
 # Distance matrix
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 1) stop("Usage: Rscript test.R in.json > results")
-infile <- args[1]
-input <- fromJSON(infile)
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+input <- fromJSON(json)
 
 #if (length(input$valueIsTransformed) == 0 || input$valueIsTransformed == FALSE) {
 # normalized_matrix <- t(scale(t(input$matrix))) # Applying z-score normalization

package/utils/lowess.R

@@ -1,9 +1,9 @@
 library(jsonlite)
 
 # read in data
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 1) stop("input coordinates needed")
-infile <- args[1]
-data <- fromJSON(infile)
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+data <- fromJSON(json)
 result = lowess(data$X, data$Y)
 toJSON(result)

package/utils/regression.R

@@ -6,10 +6,10 @@
 # USAGE
 ###########
 
-# Usage: Rscript regression.R in.json > results
+# Usage: echo <in_json> | Rscript regression.R > <out_json>
 
-# Input data is in JSON format and is read in from <in.json> file.
-# Regression results are written in JSON format to stdout.
+#   in_json: [string] input data in JSON format. Streamed through stdin.
+#   out_json: [string] regression results in JSON format. Streamed to stdout.
 
 # Input JSON specifications:
 # {
@@ -77,20 +77,18 @@ suppressPackageStartupMessages({
   library(lmtest)
 })
 
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 1) stop("Usage: Rscript regression.R in.json > results")
-infile <- args[1]
-
 benchmark <- list()
 
-
 ################
 # PREPARE DATA #
 ################
 
-# read in json input
+# stream in json input
 stime <- Sys.time()
-input <- fromJSON(infile)
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+input <- fromJSON(json)
 etime <- Sys.time()
 dtime <- etime - stime
 benchmark[["read_json_input"]] <- unbox(paste(round(as.numeric(dtime), 4), attr(dtime, "units")))

package/utils/survival.R

@@ -6,10 +6,10 @@
 # Usage #
 #########
 
-# Usage: Rscript survival.R in.json > results
+# Usage: echo <in_json> | Rscript survival.R > <out_json>
 
-# Input data is in JSON format and is read in from <in.json> file.
-# Survival results are written in JSON format to stdout.
+#   in_json: [string] input data in JSON format. Streamed through stdin.
+#   out_json: [string] survival results in JSON format. Streamed to stdout.
 
 # Input JSON:
 # [
@@ -34,11 +34,11 @@
 library(jsonlite)
 library(survival)
 
-# read in data
-args <- commandArgs(trailingOnly = T)
-if (length(args) != 1) stop("one argument needed")
-infile <- args[1]
-dat <- fromJSON(infile)
+# stream in json input
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+dat <- fromJSON(json)
 
 # perform survival analysis
 dat$series <- as.factor(dat$series)

package/src/lines2R.js

@@ -1,62 +0,0 @@
-/*
-Stream JavaScript data into and out of R.
-
-Arguments:
-	- <Rscript>: [string] path to R script.
-	- <lines>: [array] data lines.
-	- <args>: [array] R script arguments.
-
-Given an R script and a JavaScript array of input data lines, the data lines are streamed into the standard input of the R script. The standard output of the R script is then returned as a JavaScript array of output data lines.
-*/
-
-import fs from 'fs'
-import path from 'path'
-import serverconfig from './serverconfig'
-import { spawn } from 'child_process'
-import { Readable } from 'stream'
-
-export default async function lines2R(Rscript, lines, args = []) {
-	try {
-		await fs.promises.stat(Rscript)
-	} catch (e) {
-		throw `${Rscript} does not exist`
-	}
-	const stdout = []
-	const stderr = []
-	return new Promise((resolve, reject) => {
-		const sp = spawn(serverconfig.Rscript, [Rscript, ...args])
-		if (lines && lines.length > 0) {
-			// if data lines are present, then data will be streamed into R
-			// otherwise, data will be read into R using an argument
-			try {
-				const table = lines.join('\n') + '\n'
-				Readable.from(table).pipe(sp.stdin)
-			} catch (error) {
-				sp.kill()
-				let errmsg = error
-				if (stderr.length > 0) errmsg += `\nR stderr: ${stderr.join('').trim()}`
-				reject(errmsg)
-			}
-		}
-		sp.stdout.on('data', data => stdout.push(data))
-		sp.stderr.on('data', data => stderr.push(data))
-		sp.on('error', err => reject(err))
-		sp.on('close', code => {
-			if (code !== 0) {
-				// handle non-zero exit status
-				let errmsg = `R process exited with non-zero status code=${code}`
-				if (stdout.length > 0) errmsg += `\nR stdout: ${stdout.join('').trim()}`
-				if (stderr.length > 0) errmsg += `\nR stderr: ${stderr.join('').trim()}`
-				reject(errmsg)
-			}
-			if (stderr.length > 0) {
-				// handle R stderr
-				const err = stderr.join('').trim()
-				const errmsg = `R process emitted standard error\nR stderr: ${err}`
-				reject(errmsg)
-			}
-			const out = stdout.join('').trim().split('\n')
-			resolve(out)
-		})
-	})
-}