Refactor/perf batch 11

R/ds.auc.R

@@ -11,19 +11,12 @@
 #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.
 #' @return returns the AUC and its standard error
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 ds.auc <- function(pred=NULL, y=NULL, datasources=NULL){
 
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- DSI::datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   # verify that 'pred' was set
   if(is.null(pred)){
@@ -35,10 +28,6 @@ ds.auc <- function(pred=NULL, y=NULL, datasources=NULL){
     stop("Please provide the name of the outcome variable", call.=FALSE)
   }
 
-  # check if the pred and y objects are defined in all the studies
-  defined.pred <- isDefined(datasources, pred)
-  defined.y <- isDefined(datasources, y)
-
   cally <- call('aucDS', pred, y)
   output <- DSI::datashield.aggregate(datasources, cally)
 

R/ds.bp_standards.R

@@ -26,20 +26,13 @@
 #' blood pressure in children and adolescents:
 #' https://www.nhlbi.nih.gov/sites/default/files/media/docs/hbp_ped.pdf
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @import data.table
 #' @export
 ds.bp_standards <- function(sex=NULL, age=NULL, height=NULL, bp=NULL, systolic=TRUE, 
                             newobj=NULL, datasources=NULL){
 
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- DSI::datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   # verify that 'sex' was set
   if(is.null(sex)){
@@ -61,12 +54,6 @@ ds.bp_standards <- function(sex=NULL, age=NULL, height=NULL, bp=NULL, systolic=T
     stop("Please provide the name of the blood pressure variable", call.=FALSE)
   }
 
-  # check if the input objects are defined in all the studies
-  defined.sex <- isDefined(datasources, sex)
-  defined.age <- isDefined(datasources, age)
-  defined.height <- isDefined(datasources, height)
-  defined.bp <- isDefined(datasources, bp)
-
   # if no output object specified then provide a default name
   if(is.null(newobj)){
     newobj <- "bp.newobj"

R/ds.exists.R

@@ -16,6 +16,7 @@
 #' @return \code{ds.exists} returns a logical object. 
 #' TRUE if the object is on the server-side and FALSE otherwise.
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @seealso \code{\link{ds.class}} to check the type of an object.
 #' @seealso \code{\link{ds.length}} to check the length of an object.
 #' @seealso \code{\link{ds.dim}} to check the dimension of an object.
@@ -61,15 +62,7 @@
 #'
 ds.exists <- function(x=NULL, datasources=NULL){
 
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   if(is.null(x)){
     stop("Please provide the name of the input object!", call.=FALSE)

R/ds.igb_standards.R

@@ -36,20 +36,13 @@
 #' }
 #' @return assigns the converted measurement as a new object on the server-side
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' 
 ds.igb_standards <- function(gagebrth=NULL, z=0, p=50, val=NULL, var=NULL, sex=NULL, 
                              fun='igb_value2zscore', newobj=NULL, datasources=NULL){
 
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   # check if user has provided the name of the input variables
   if(is.null(gagebrth)){
@@ -59,10 +52,6 @@ ds.igb_standards <- function(gagebrth=NULL, z=0, p=50, val=NULL, var=NULL, sex=N
     stop("Please provide the name of the sex variable", call.=FALSE)
   }
 
-  # check if the input objects are defined in all the studies
-  isDefined(datasources, gagebrth)
-  isDefined(datasources, sex)
-
   # check if the provided fun is valid
   if(!(fun %in% c("igb_centile2value","igb_zscore2value","igb_value2zscore","igb_value2centile"))){
     stop("Please provide a valid fun", call.=FALSE)
@@ -72,8 +61,6 @@ ds.igb_standards <- function(gagebrth=NULL, z=0, p=50, val=NULL, var=NULL, sex=N
   if(fun %in% c("igb_value2zscore","igb_value2centile")){
     if(is.null(val)){
       stop("Please provide the name of the val variable", call.=FALSE)
-    }else{
-      isDefined(datasources, val)
     }
   }
 

R/ds.listDisclosureSettings.R

@@ -57,6 +57,7 @@
 #' @return \code{ds.listDisclosureSettings} returns a list containing the current settings of the
 #' \code{nfilters} in each study specified. 
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' @examples
 #' \dontrun{
@@ -100,15 +101,7 @@
 #' }
 #'
 ds.listDisclosureSettings <- function(datasources=NULL){
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   # CALL THE MAIN SERVER SIDE FUNCTION
   calltext <- call("listDisclosureSettingsDS")

R/ds.mdPattern.R

@@ -46,6 +46,7 @@
 #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} objects obtained 
 #' after login. If the \code{datasources} argument is not specified, the default set of 
 #' connections will be used: see \code{\link[DSI]{datashield.connections_default}}.
+#' @template classConsistencyCheckTrue
 #' @return For type='split': A list with one element per study, each containing:
 #' \describe{
 #'   \item{pattern}{The missing data pattern matrix for that study}
@@ -60,6 +61,7 @@
 #'   \item{message}{A message describing the validity status}
 #' }
 #' @author Xavier Escribà montagut for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' @examples
 #' \dontrun{
@@ -107,17 +109,9 @@
 #'   datashield.logout(connections)
 #' }
 #'
-ds.mdPattern <- function(x = NULL, type = 'split', datasources = NULL){
+ds.mdPattern <- function(x = NULL, type = 'split', datasources = NULL, classConsistencyCheck = TRUE){
 
-  # Look for DS connections
-  if(is.null(datasources)){
-    datasources <- datashield.connections_find()
-  }
-
-  # Ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   if(is.null(x)){
     stop("Please provide the name of a data frame or matrix!", call.=FALSE)
@@ -130,10 +124,14 @@ ds.mdPattern <- function(x = NULL, type = 'split', datasources = NULL){
   cally <- call("mdPatternDS", x)
   results <- DSI::datashield.aggregate(datasources, cally)
 
+  if(classConsistencyCheck){
+    .checkClassConsistency(results)
+  }
+
   # Process results based on type
   if(type == "split"){
     # Return individual study results
-    return(results)
+    return(lapply(results, function(r) { r$class <- NULL; r }))
 
   } else if(type == "combine"){
     # Pool results across studies
@@ -172,7 +170,7 @@ ds.mdPattern <- function(x = NULL, type = 'split', datasources = NULL){
     }
 
     # Pool the patterns
-    pooled_pattern <- .pool_md_patterns(patterns_list, study_names)
+    pooled_pattern <- .poolMdPatterns(patterns_list, study_names)
 
     # Check validity of pooled results
     # Get threshold from first study's results or use a default check
@@ -213,8 +211,8 @@ ds.mdPattern <- function(x = NULL, type = 'split', datasources = NULL){
 #' @param patterns_list List of pattern matrices from each study
 #' @param study_names Names of the studies
 #' @return Pooled pattern matrix
-#' @keywords internal
-.pool_md_patterns <- function(patterns_list, study_names){
+#' @noRd
+.poolMdPatterns <- function(patterns_list, study_names){
 
   # Initialize with first study's pattern structure
   pooled <- patterns_list[[1]]

R/ds.rm.R

@@ -22,6 +22,7 @@
 #' is successful the message \code{"Object(s) '<x.names>' was deleted."} is returned
 #' to the client-side. 
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @examples
 #' \dontrun{
 #'
@@ -68,15 +69,7 @@
 
 ds.rm<-function(x.names=NULL, datasources=NULL){
 
-    # look for DS connections
-    if (is.null(datasources)) {
-        datasources <- datashield.connections_find()
-    }
-
-    # ensure datasources is a list of DSConnection-class
-    if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-        stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-    }
+    datasources <- .set_datasources(datasources)
 
     if (is.null(x.names)) {
         stop("Please provide the names of the objects to be deleted (eg 'object.name') as the x.names argument", call.=FALSE)

tests/testthat/test-arg-ds.auc.R

@@ -15,6 +15,8 @@
 
 # context("ds.auc::arg::setup")
 
+connect.studies.dataset.cnsim(list("LAB_TSC"))
+
 #
 # Tests
 #
@@ -33,4 +35,5 @@ test_that("ds.auc errors for null pred or y", {
 #
 
 # context("ds.auc::arg::shutdown")
+disconnect.studies.dataset.cnsim()
 # context("ds.auc::arg::done")