getPatientSetID

DESCRIPTION

@@ -3,7 +3,7 @@ Type: Package
 Title: R Client for accessing the tranSMART RESTful API
 Version: 0.3.2
 Date: 2016-07-18
-Depends: httr, jsonlite, plyr, RProtoBuf, hash, reshape
+Depends: httr, jsonlite, plyr, RProtoBuf, hash, reshape, XML
 Author: Tim Dorscheidt, Jan Kanis, Rianne Jansen
 Maintainer: <support@thehyve.nl>
 Description: This package exposes tranSMART's RESTful API as a set of R functions. It uses tranSMART's OAuth authentication to access the data for which the user is authorized, and allows exploring and downloading the data.

R/RClientConnectionManager.R

@@ -22,6 +22,10 @@
 # You should have received a copy of the GNU General Public License along
 # with this program. If not, see <http://www.gnu.org/licenses/>.
 
+.message <- function(...) {
+    if(getOption("verbose")) message(...)
+}
+
 connectToTransmart <- 
 function (transmartDomain, use.authentication = TRUE, token = NULL, .access.token = NULL, ...) {
     if (!exists("transmartClientEnv") || transmartClientEnv$transmartDomain != transmartDomain) { 
@@ -171,7 +175,7 @@ function (oauthDomain = transmartClientEnv$transmartDomain, prefetched.request.t
             # Maybe we're talking to an older version of Transmart that uses the version 1 oauth plugin
             ping <- .transmartServerGetRequest("/oauth/verify", accept.type = "default", onlyContent = F)
         }
-        if (getOption("verbose")) { message(paste(ping$content, collapse = ": ")) }
+        .message(paste(ping$content, collapse = ": "))
 
         if(ping$status == 200) { return(TRUE) }
 
@@ -267,11 +271,12 @@ function (oauthDomain = transmartClientEnv$transmartDomain, prefetched.request.t
 
 # Wrap this in case we need to change json libraries again
 .fromJSON <- function(json) {
-	fromJSON(json, simplifyDataFrame=F, simplifyMatrix=F)
+    fromJSON(json, simplifyDataFrame=F, simplifyMatrix=F)
 }
 
 .serverMessageExchange <- 
-function(apiCall, httpHeaderFields, accept.type = "default", post.body = NULL, show.progress = (accept.type == 'binary') ) {
+function(apiCall, httpHeaderFields, accept.type = "default", post.body = NULL, post.content.type = 'form',
+         show.progress = (accept.type == 'binary') ) {
     if (any(accept.type == c("default", "hal"))) {
         if (accept.type == "hal") {
             httpHeaderFields <- c(httpHeaderFields, Accept = "application/hal+json;charset=UTF-8")
@@ -288,7 +293,8 @@ function(apiCall, httpHeaderFields, accept.type = "default", post.body = NULL, s
                         body = post.body,
                         add_headers(httpHeaderFields),
                         authenticate(transmartClientEnv$client_id, transmartClientEnv$client_secret),
-                        encode='form',
+                        encode = if(post.content.type == 'form') 'form' else NULL,
+                        if(post.content.type != 'form') content_type(post.content.type),
                         config(verbose = getOption("verbose")))
             if (getOption("verbose")) { message("POST body:\n", .list2string(post.body), "\n") }
         }
@@ -297,7 +303,7 @@ function(apiCall, httpHeaderFields, accept.type = "default", post.body = NULL, s
         result$headers <- headers(req)
         result$status <- req$status_code
         result$statusMessage <- http_status(req)$message
-    	switch(.contentType(result$headers),
+        switch(.contentType(result$headers),
                json = {
                    result$content <- .fromJSON(result$content)
                    result$JSON <- TRUE
@@ -323,7 +329,8 @@ function(apiCall, httpHeaderFields, accept.type = "default", post.body = NULL, s
                         add_headers(httpHeaderFields),
                         authenticate(transmartClientEnv$client_id, transmartClientEnv$client_secret),
                         if(show.progress) progress(),
-                        encode='form',
+                        encode = if(post.content.type == 'form') 'form' else 'raw',
+                        if(post.content.type != 'form') content_type(post.content.type),
                         config(verbose = getOption("verbose")))
         }
         if(show.progress) cat("\nDownload complete.\n")

R/getObservations.R

@@ -22,7 +22,8 @@
 # You should have received a copy of the GNU General Public License along
 # with this program. If not, see <http://www.gnu.org/licenses/>.
 
-getObservations <- function(study.name, concept.match = NULL, concept.links = NULL, as.data.frame = TRUE) {
+getObservations <- function(study.name, concept.match = NULL, concept.links = NULL, patient.set = NULL, 
+                            as.data.frame = TRUE) {
     .ensureTransmartConnection()
 
     if (is.null(concept.links)) {
@@ -39,7 +40,7 @@ getObservations <- function(study.name, concept.match = NULL, concept.links = NU
                 }
             }
         } else {
-            concept.links <- paste("/studies/", study.name, sep = "")
+            concept.links <- paste0("/studies/", study.name)
         }
     }
 
@@ -50,10 +51,31 @@ getObservations <- function(study.name, concept.match = NULL, concept.links = NU
 
     listOfObservations <- list()
 
-    for (oneLink in concept.links) {
+    if(is.null(patient.set)){
+      for (oneLink in concept.links) {
         serverResult <- .transmartGetJSON(paste(oneLink, "/observations", sep = "")) 
         listOfObservations <- c(listOfObservations, serverResult$observations)
+      }
+    }else{
+      if(length(patient.set) > 1) { stop("Only one patient.set ID allowed as input") }
+      if(!is.numeric(patient.set)) { stop("Patient.set ID should be a numeric value") }
+
+      if(length(concept.links) == 1 && concept.links[1] == paste0("/studies/", study.name)) {
+        tmpConceptPath<- studyConcepts$fullName[1]
+        fullConceptNames <- gsub(paste0(study.name,"\\\\.*"), paste0(study.name, "\\\\"), 
+                                 tmpConceptPath, ignore.case=T)
+      } else { 
+        fullConceptNames <- studyConcepts$fullName[match(concept.links, studyConcepts$api.link.self.href)]
+        }
+      for (oneName in fullConceptNames) {
+        serverResult <- .transmartGetJSON(
+          paste("/observations?patient_sets=", patient.set, 
+                "&concept_paths=", URLencode(oneName), 
+                sep=""))
+        listOfObservations <- c(listOfObservations, serverResult$observations)
+      }
     }
+
 
     if (as.data.frame) {
         dataFrameObservations <- .listToDataFrame(listOfObservations)

R/getPatientSets.R → R/getPatientSet.R

@@ -1,5 +1,4 @@
 # Copyright 2014, 2015 The Hyve B.V.
-# Copyright 2014 Janssen Research & Development, LLC.
 #
 # This file is part of tranSMART R Client: R package allowing access to
 # tranSMART's data via its RESTful API.
@@ -28,7 +27,7 @@ getPatientSet <- function(id) {
     }
     .ensureTransmartConnection()
 
-    patientSet <- .transmartGetJSON(paste("/patient_sets/", id, sep=''))
+    patientSet <- .transmartGetJSON(paste0("/patient_sets/", id))
 
     # Don't expose id, it should not be used and will be removed from a future version of rest-api
     # COMPAT: remove this block if support for the old rest-api is dropped.

R/getSubjects.R

@@ -31,6 +31,14 @@ getSubjects <- function(study.name, as.data.frame = TRUE) {
     subjectIDs <- sapply(listOfSubjects, FUN = function(x) { x$inTrialId })
     names(listOfSubjects) <- subjectIDs
 
+    # Don't expose id, it should not be used and will be removed from a future version of rest-api
+    # COMPAT: remove this block if support for the old rest-api is dropped.
+    if (length(listOfSubjects) && "id" %in% names(listOfSubjects[[1]])) {
+        for (i in seq_along(patientSet$patients)) {
+            listOfSubjects[[i]]$id <- NULL
+        }
+    }
+
     if (as.data.frame) return(.listToDataFrame(listOfSubjects))
     listOfSubjects
 }

bin/installCommands.R

@@ -25,9 +25,9 @@
 
 # Notes for first time installers:
 
-# The package transmartRClient depends on these packages: httr, jsonlite, RProtoBuf, plyr, hash, and reshape.
+# The package transmartRClient depends on these packages: httr, jsonlite, RProtoBuf, plyr, hash, reshape and XML.
 # You can install them as follows:
-install.packages(pkgs=c("httr", "jsonlite", "RProtoBuf", "plyr", "hash", "reshape"))
+install.packages(pkgs=c("httr", "jsonlite", "RProtoBuf", "plyr", "hash", "reshape", "XML"))
 
 # RProtoBuf depends on the system protobuf headers. For Ubuntu you will need to
 # install the libprotoc-dev and libprotobuf-dev packages.

inst/unittests/resources/gse8581concepts.txt

@@ -0,0 +1,38 @@
+name	fullName	type	api.link.self.href	endLeaf
+Afro American	\Public Studies\GSE8581\Subjects\Ethnicity\Afro American\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Ethnicity/Afro%20American	FALSE
+Age (year)	\Public Studies\GSE8581\Subjects\Age (year)\	NUMERIC	/studies/gse8581/concepts/Subjects/Age%20%28year%29	TRUE
+Biomarker_Data	\Public Studies\GSE8581\MRNA\Biomarker_Data\	UNKNOWN	/studies/gse8581/concepts/MRNA/Biomarker_Data	FALSE
+carcinoid	\Public Studies\GSE8581\Endpoints\Diagnosis\carcinoid\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/carcinoid	FALSE
+Caucasian	\Public Studies\GSE8581\Subjects\Ethnicity\Caucasian\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Ethnicity/Caucasian	FALSE
+chronic obstructive pulmonary disease	\Public Studies\GSE8581\Subjects\Lung Disease\chronic obstructive pulmonary disease\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Lung%20Disease/chronic%20obstructive%20pulmonary%20disease	FALSE
+control	\Public Studies\GSE8581\Subjects\Lung Disease\control\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Lung%20Disease/control	FALSE
+Diagnosis	\Public Studies\GSE8581\Endpoints\Diagnosis\	CATEGORICAL_NODE	/studies/gse8581/concepts/Endpoints/Diagnosis	TRUE
+emphysema	\Public Studies\GSE8581\Endpoints\Diagnosis\emphysema\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/emphysema	FALSE
+Endpoints	\Public Studies\GSE8581\Endpoints\	UNKNOWN	/studies/gse8581/concepts/Endpoints	FALSE
+Ethnicity	\Public Studies\GSE8581\Subjects\Ethnicity\	CATEGORICAL_NODE	/studies/gse8581/concepts/Subjects/Ethnicity	TRUE
+female	\Public Studies\GSE8581\Subjects\Sex\female\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Sex/female	FALSE
+FEV1	\Public Studies\GSE8581\Endpoints\FEV1\	NUMERIC	/studies/gse8581/concepts/Endpoints/FEV1	TRUE
+Forced Expiratory Volume Ratio	\Public Studies\GSE8581\Endpoints\Forced Expiratory Volume Ratio\	NUMERIC	/studies/gse8581/concepts/Endpoints/Forced%20Expiratory%20Volume%20Ratio	TRUE
+giant bullae	\Public Studies\GSE8581\Endpoints\Diagnosis\giant bullae\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/giant%20bullae	FALSE
+Giant Cell Tumor	\Public Studies\GSE8581\Endpoints\Diagnosis\Giant Cell Tumor\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/Giant%20Cell%20Tumor	FALSE
+GPL570_BOGUS	\Public Studies\GSE8581\MRNA\Biomarker_Data\GPL570_BOGUS\	UNKNOWN	/studies/gse8581/concepts/MRNA/Biomarker_Data/GPL570_BOGUS	FALSE
+Height (inch)	\Public Studies\GSE8581\Subjects\Height (inch)\	NUMERIC	/studies/gse8581/concepts/Subjects/Height%20%28inch%29	TRUE
+hematoma	\Public Studies\GSE8581\Endpoints\Diagnosis\hematoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/hematoma	FALSE
+Homo sapiens	\Public Studies\GSE8581\Subjects\Organism\Homo sapiens\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Organism/Homo%20sapiens	FALSE
+inflammation	\Public Studies\GSE8581\Endpoints\Diagnosis\inflammation\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/inflammation	FALSE
+Lung	\Public Studies\GSE8581\MRNA\Biomarker_Data\GPL570_BOGUS\Lung\	HIGH_DIMENSIONAL	/studies/gse8581/concepts/MRNA/Biomarker_Data/GPL570_BOGUS/Lung	TRUE
+Lung Disease	\Public Studies\GSE8581\Subjects\Lung Disease\	CATEGORICAL_NODE	/studies/gse8581/concepts/Subjects/Lung%20Disease	TRUE
+lymphoma	\Public Studies\GSE8581\Endpoints\Diagnosis\lymphoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/lymphoma	FALSE
+male	\Public Studies\GSE8581\Subjects\Sex\male\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Sex/male	FALSE
+metastatic non-small cell adenocarcinoma	\Public Studies\GSE8581\Endpoints\Diagnosis\metastatic non-small cell adenocarcinoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/metastatic%20non-small%20cell%20adenocarcinoma	FALSE
+metastatic renal cell carcinoma	\Public Studies\GSE8581\Endpoints\Diagnosis\metastatic renal cell carcinoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/metastatic%20renal%20cell%20carcinoma	FALSE
+MRNA	\Public Studies\GSE8581\MRNA\	UNKNOWN	/studies/gse8581/concepts/MRNA	FALSE
+no malignancy	\Public Studies\GSE8581\Endpoints\Diagnosis\no malignancy\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/no%20malignancy	FALSE
+non-small cell adenocarcinoma	\Public Studies\GSE8581\Endpoints\Diagnosis\non-small cell adenocarcinoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/non-small%20cell%20adenocarcinoma	FALSE
+non-small cell squamous cell carcinoma	\Public Studies\GSE8581\Endpoints\Diagnosis\non-small cell squamous cell carcinoma\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/non-small%20cell%20squamous%20cell%20carcinoma	FALSE
+not specified	\Public Studies\GSE8581\Subjects\Lung Disease\not specified\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Subjects/Lung%20Disease/not%20specified	FALSE
+NSC-Mixed	\Public Studies\GSE8581\Endpoints\Diagnosis\NSC-Mixed\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/NSC-Mixed	FALSE
+Organism	\Public Studies\GSE8581\Subjects\Organism\	CATEGORICAL_NODE	/studies/gse8581/concepts/Subjects/Organism	TRUE
+Sex	\Public Studies\GSE8581\Subjects\Sex\	CATEGORICAL_NODE	/studies/gse8581/concepts/Subjects/Sex	TRUE
+Subjects	\Public Studies\GSE8581\Subjects\	UNKNOWN	/studies/gse8581/concepts/Subjects	FALSE
+Unknown	\Public Studies\GSE8581\Endpoints\Diagnosis\Unknown\	CATEGORICAL_OPTION	/studies/gse8581/concepts/Endpoints/Diagnosis/Unknown	FALSE